pastojs: shortrefglobals: unit initialization and empty implementation

git-svn-id: trunk@47649 -

packages/pastojs/src/fppas2js.pp

@@ -1788,7 +1788,7 @@ type
     ImplContext: TSectionContext;
     ImplHeaderStatements: TFPList;
     ImplSrcElements: TJSSourceElements;
-    ImplHeaderIndex: integer; // index in TJSSourceElements(JSElement).Statements
+    ImplHeaderIndex: integer; // index in ImplSrcElements.Statements
     destructor Destroy; override;
     procedure AddImplHeaderStatement(JS: TJSElement);
   end;
@@ -8113,31 +8113,34 @@ begin
           AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx));
 
         ImplFunc:=CreateImplementationSection(El,IntfSecCtx);
-        if ImplFunc=nil then
+        // add $mod.$implcode = ImplFunc;
+        AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+        AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
+        AssignSt.Expr:=ImplFunc;
+        AddToSourceElements(Src,AssignSt);
+
+        // append initialization section
+        CreateInitSection(El,Src,IntfSecCtx);
+
+        if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then
           begin
+          // empty implementation
+
           // remove unneeded $impl from interface
           RemoveFromSourceElements(Src,ImplVarSt);
-          if IntfSecCtx.HeaderIndex>0 then
-            dec(IntfSecCtx.HeaderIndex);
-          if IntfSecCtx.ImplHeaderIndex>0 then
-            dec(IntfSecCtx.ImplHeaderIndex);
+          // remove unneeded $mod.$implcode = function(){}
+          RemoveFromSourceElements(Src,AssignSt);
           HasImplUsesClause:=length(El.ImplementationSection.UsesClause)>0;
           end
         else
           begin
-          // add $mod.$implcode = ImplFunc;
-          AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
-          AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
-          AssignSt.Expr:=ImplFunc;
-          AddToSourceElements(Src,AssignSt);
           HasImplUsesClause:=true;
           end;
+
         if HasImplUsesClause then
           // add implementation uses list: [<implementation uses1>,<uses2>, ...]
           ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
 
-        CreateInitSection(El,Src,IntfSecCtx);
-
         end;
 
       if (ModScope<>nil) and (coStoreImplJS in Options) then
@@ -17494,14 +17497,15 @@ begin
     if ImplDecl<>nil then
       RaiseInconsistency(20170910175032,El); // elements should have been added directly
     IntfContext.ImplHeaderIndex:=ImplContext.HeaderIndex;
-    if Src.Statements.Count=0 then
-      exit; // no implementation
     Result:=FunDecl;
   finally
     IntfContext.ImplContext:=nil;
     ImplContext.Free;
     if Result=nil then
+      begin
       FunDecl.Free;
+      IntfContext.ImplSrcElements:=nil;
+      end;
   end;
 end;
 

packages/pastojs/src/pas2jsfiler.pp

@@ -1000,6 +1000,7 @@ type
     FElementRefsArray: TPCUFilerElementRefArray; // TPCUFilerElementRef by Id
     FJSON: TJSONObject;
     FPendingIdentifierScopes: TObjectList; // list of TPCUReaderPendingIdentifierScope
+    FIntfSectionObj: TJSONObject;
     procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
     procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject);
@@ -1097,6 +1098,7 @@ type
     procedure ReadSpecialization(Obj: TJSONObject; GenEl: TPasGenericType; ParamIDs: TJSONArray); virtual;
     procedure ReadExternalReferences(Obj: TJSONObject; El: TPasElement); virtual;
     procedure ReadUsedUnitsInit(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
+    procedure ReadIndirectUsedUnits(Obj: TJSONObject; Section: TPasSection; aComplete: boolean); virtual;
     procedure ReadUsedUnitsFinish(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
     procedure ReadSectionScope(Obj: TJSONObject; Scope: TPas2JSSectionScope; aContext: TPCUReaderContext); virtual;
     procedure ReadSection(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
@@ -2590,7 +2592,7 @@ procedure TPCUWriter.WriteModule(Obj: TJSONObject; aModule: TPasModule;
     if Section=nil then exit;
     if Section.Parent<>aModule then
       RaiseMsg(20180205153912,aModule,PropName);
-    aContext.Section:=Section; // set Section before calling virtual method
+    aContext.Section:=Section; // set Section before calling virtual WriteSection
     aContext.SectionObj:=nil;
     aContext.IndirectUsesArr:=nil;
     WriteSection(Obj,Section,PropName,aContext);
@@ -5533,7 +5535,8 @@ begin
       RaiseMsg(20200531101105,PendSpec.GenericEl,PendSpec.SpecName);// nothing uses this specialize
     end;
   if PendSpec.GenericEl=nil then
-    RaiseMsg(20200531101333,RefEl,PendSpec.SpecName);
+    // not yet ready
+    exit;
   Obj:=PendSpec.Obj;
   if Obj=nil then
     RaiseMsg(20200531101128,PendSpec.GenericEl,PendSpec.SpecName); // specialize missing in JSON
@@ -6815,6 +6818,50 @@ begin
   if aContext=nil then ;
 end;
 
+procedure TPCUReader.ReadIndirectUsedUnits(Obj: TJSONObject;
+  Section: TPasSection; aComplete: boolean);
+// read external refs from indirectly used units
+var
+  i: Integer;
+  Arr: TJSONArray;
+  Data: TJSONData;
+  UsesObj: TJSONObject;
+  Name: string;
+  Module: TPasModule;
+  UsedScope: TPas2JSSectionScope;
+begin
+  if ReadArray(Obj,'IndirectUses',Arr,Section) then
+    begin
+    for i:=0 to Arr.Count-1 do
+      begin
+      Data:=Arr[i];
+      if not (Data is TJSONObject) then
+        RaiseMsg(20180314155716,Section,GetObjName(Data));
+      UsesObj:=TJSONObject(Data);
+      if not ReadString(UsesObj,'Name',Name,Section) then
+        RaiseMsg(20180314155756,Section);
+      if not IsValidIdent(Name,true,true) then
+        RaiseMsg(20180314155800,Section,Name);
+      Module:=Resolver.FindModule(Name,nil,nil);
+      if Module=nil then
+        RaiseMsg(20180314155840,Section,Name);
+      if Module.InterfaceSection=nil then
+        begin
+        if not aComplete then
+          continue;
+        {$IF defined(VerbosePCUFiler) or defined(VerbosePJUFiler)}
+        writeln('TPCUReader.ReadUsedUnitsFinish Resolver.RootElement=',GetObjPath(Resolver.RootElement),' Section=',GetObjPath(Section));
+        {$ENDIF}
+        RaiseMsg(20180314155953,Section,'indirect unit "'+Name+'"');
+        end;
+      UsedScope:=Module.InterfaceSection.CustomData as TPas2JSSectionScope;
+      if not UsedScope.Finished then
+        RaiseMsg(20180314155954,Section,'indirect unit "'+Name+'"');
+      ReadExternalReferences(UsesObj,Module);
+      end;
+    end;
+end;
+
 procedure TPCUReader.ReadUsedUnitsFinish(Obj: TJSONObject;
   Section: TPasSection; aContext: TPCUReaderContext);
 var
@@ -6825,10 +6872,9 @@ var
   Module: TPasModule;
   Data: TJSONData;
   UsesObj, ModuleObj: TJSONObject;
-  Name: string;
 begin
   Scope:=Section.CustomData as TPas2JSSectionScope;
-  // read external refs from used units
+  // read external refs from directly used units
   if ReadArray(Obj,'Uses',Arr,Section) then
     begin
     Scope:=Section.CustomData as TPas2JSSectionScope;
@@ -6855,29 +6901,15 @@ begin
     end;
 
   // read external refs from indirectly used units
-  if ReadArray(Obj,'IndirectUses',Arr,Section) then
+  if Section.ClassType=TInterfaceSection then
+    FIntfSectionObj:=Obj
+  else if Section.ClassType=TImplementationSection then
     begin
-    for i:=0 to Arr.Count-1 do
-      begin
-      Data:=Arr[i];
-      if not (Data is TJSONObject) then
-        RaiseMsg(20180314155716,Section,GetObjName(Data));
-      UsesObj:=TJSONObject(Data);
-      if not ReadString(UsesObj,'Name',Name,Section) then
-        RaiseMsg(20180314155756,Section);
-      if not IsValidIdent(Name,true,true) then
-        RaiseMsg(20180314155800,Section,Name);
-      Module:=Resolver.FindModule(Name,nil,nil);
-      if Module=nil then
-        RaiseMsg(20180314155840,Section,Name);
-      if Module.InterfaceSection=nil then
-        RaiseMsg(20180314155953,Section,'indirect unit "'+Name+'"');
-      UsedScope:=Module.InterfaceSection.CustomData as TPas2JSSectionScope;
-      if not UsedScope.Finished then
-        RaiseMsg(20180314155954,Section,'indirect unit "'+Name+'"');
-      ReadExternalReferences(UsesObj,Module);
-      end;
-    end;
+    ReadIndirectUsedUnits(FIntfSectionObj,Section,true);
+    ReadIndirectUsedUnits(Obj,Section,true);
+    end
+  else
+    ReadIndirectUsedUnits(Obj,Section,true);
 
   Scope.UsesFinished:=true;
 

packages/pastojs/tests/tcoptimizations.pas

@@ -72,6 +72,7 @@ type
     procedure TestOptShortRefGlobals_SameUnit_EnumType;
     procedure TestOptShortRefGlobals_SameUnit_ClassType;
     procedure TestOptShortRefGlobals_SameUnit_RecordType;
+    procedure TestOptShortRefGlobals_Unit_InitNoImpl;
 
     // Whole Program Optimization
     procedure TestWPO_OmitLocalVar;
@@ -1485,6 +1486,43 @@ begin
     '']));
 end;
 
+procedure TTestOptimizations.TestOptShortRefGlobals_Unit_InitNoImpl;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'var a: word;',
+    'procedure Run(w: word);',
+    '']),
+  LinesToStr([
+    'procedure Run(w: word);',
+    'begin',
+    'end;',
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'implementation',
+  'uses UnitA;', // empty implementation function
+  'begin',
+  '  Run(a);',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_Unit_InitNoImpl',
+    LinesToStr([
+    'var $impl = $mod.$impl;',
+    'var $lm = null;',
+    'var $lp = null;',
+    '']),
+    LinesToStr([
+    '$lp($lm.a);',
+    '']),
+    LinesToStr([
+    '$lm = pas.UnitA;',
+    '$lp = $lm.Run;',
+    '']));
+end;
+
 procedure TTestOptimizations.TestWPO_OmitLocalVar;
 begin
   StartProgram(false);