pas2js: fixed delay init specializations after loading impl sections

git-svn-id: trunk@49226 -
(cherry picked from commit 1861dc83d971ab4e0c5135bf97e1d29dfd503726)

packages/pastojs/src/fppas2js.pp

@@ -2082,8 +2082,8 @@ type
     Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
     Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
     Procedure AddImplHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
-    Procedure AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
-    Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual;
+    function AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext): boolean; virtual;
+    function CreateDelaySpecializeInit(El: TPasGenericType; AContext: TConvertContext): TJSElement; virtual;
     // enum and sets
     Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
     // record
@@ -8199,7 +8199,7 @@ Var
   ModuleName, ModVarName: String;
   IntfContext: TSectionContext;
   ImplVarSt: TJSVariableStatement;
-  HasImplUsesClause, ok, NeedRTLCheckVersion: Boolean;
+  HasImplCode, ok, NeedRTLCheckVersion: Boolean;
   Prg: TPasProgram;
   Lib: TPasLibrary;
   ImplFuncAssignSt: TJSSimpleAssignStatement;
@@ -8280,7 +8280,7 @@ begin
       Prg:=TPasProgram(El);
       if Assigned(Prg.ProgramSection) then
         AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext));
-      AddDelayedInits(Prg,Src,IntfContext);
+      HasImplCode:=AddDelayedInits(Prg,Src,IntfContext);
       CreateInitSection(Prg,Src,IntfContext);
       end
     else if El is TPasLibrary then
@@ -8288,7 +8288,7 @@ begin
       Lib:=TPasLibrary(El);
       if Assigned(Lib.LibrarySection) then
         AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
-      AddDelayedInits(Lib,Src,IntfContext);
+      HasImplCode:=AddDelayedInits(Lib,Src,IntfContext);
       CreateInitSection(Lib,Src,IntfContext);
       // ToDo: append exports
       end
@@ -8317,7 +8317,9 @@ begin
       // append initialization section
       CreateInitSection(El,Src,IntfSecCtx);
 
-      if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then
+      if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count>0 then
+        HasImplCode:=true
+      else
         begin
         // empty implementation
 
@@ -8325,18 +8327,14 @@ begin
         RemoveFromSourceElements(Src,ImplVarSt);
         // remove unneeded $mod.$implcode = function(){}
         RemoveFromSourceElements(Src,ImplFuncAssignSt);
-        HasImplUsesClause:=(El.ImplementationSection<>nil)
+        // keep impl uses section
+        HasImplCode:=(El.ImplementationSection<>nil)
                        and (length(El.ImplementationSection.UsesClause)>0);
-        end
-      else
-        begin
-        HasImplUsesClause:=true;
         end;
 
-      if HasImplUsesClause then
+      if HasImplCode then
         // add implementation uses list: [<implementation uses1>,<uses2>, ...]
         ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
-
       end; // end unit
 
     if (ModScope<>nil) and (coStoreImplJS in Options) then
@@ -17846,13 +17844,18 @@ begin
   IntfSec.AddImplHeaderStatement(JS);
 end;
 
-procedure TPasToJSConverter.AddDelayedInits(El: TPasModule;
-  Src: TJSSourceElements; AContext: TConvertContext);
+function TPasToJSConverter.AddDelayedInits(El: TPasModule;
+  Src: TJSSourceElements; AContext: TConvertContext): boolean;
 var
   aResolver: TPas2JSResolver;
   Hub: TPas2JSResolverHub;
   i: Integer;
+  JS: TJSElement;
+  AssignSt: TJSSimpleAssignStatement;
+  FunDecl: TJSFunctionDeclarationStatement;
+  ImplSrc: TJSSourceElements;
 begin
+  Result:=false;
   aResolver:=AContext.Resolver;
   if aResolver=nil then exit;
   if El=nil then ;
@@ -17860,12 +17863,29 @@ begin
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.AddDelayedInits Hub.JSDelaySpecializeCount=',Hub.JSDelaySpecializeCount);
   {$ENDIF}
+  ImplSrc:=nil;
   for i:=0 to Hub.JSDelaySpecializeCount-1 do
-    AddDelaySpecializeInit(Hub.JSDelaySpecializes[i],Src,AContext);
+    begin
+    JS:=CreateDelaySpecializeInit(Hub.JSDelaySpecializes[i],AContext);
+    if JS=nil then continue;
+    if ImplSrc=nil then
+      begin
+      // create  "$mod.$implcode = function(){ }"
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AddToSourceElements(Src,AssignSt);
+      AssignSt.LHS:=CreateMemberExpression([GetBIName(pbivnModule),GetBIName(pbivnImplCode)]);
+      // create function(){}
+      FunDecl:=CreateFunctionSt(El,true,true);
+      AssignSt.Expr:=FunDecl;
+      ImplSrc:=TJSSourceElements(FunDecl.AFunction.Body.A);
+      end;
+    AddToSourceElements(ImplSrc,JS);
+    Result:=true;
+    end;
 end;
 
-procedure TPasToJSConverter.AddDelaySpecializeInit(El: TPasGenericType;
-  Src: TJSSourceElements; AContext: TConvertContext);
+function TPasToJSConverter.CreateDelaySpecializeInit(El: TPasGenericType;
+  AContext: TConvertContext): TJSElement;
 var
   C: TClass;
   Path: String;
@@ -17876,6 +17896,7 @@ var
   ElTypeHi, ElTypeLo: TPasType;
   aResolver: TPas2JSResolver;
 begin
+  Result:=nil;
   if not IsElementUsed(El) then exit;
   if not AContext.Resolver.IsFullySpecialized(El) then
     RaiseNotSupported(El,AContext,20201202145045,'not fully specialized, probably a bug in the analyzer');
@@ -17889,7 +17910,7 @@ begin
     Path:=CreateReferencePath(El,AContext,rpkPathAndName)+'.'+GetBIName(pbifnClassInitSpecialize);
     Call:=CreateCallExpression(El);
     Call.Expr:=CreatePrimitiveDotExpr(Path,El);
-    AddToSourceElements(Src,Call);
+    Result:=Call;
     end
   else if (C=TPasProcedureType) or (C=TPasFunctionType) then
     begin
@@ -17901,7 +17922,7 @@ begin
     DotExpr.Name:=TJSString(GetBIName(pbivnRTTIProc_InitSpec));
     Call:=CreateCallExpression(El);
     Call.Expr:=DotExpr;
-    AddToSourceElements(Src,Call);
+    Result:=Call;
     end
   else if (C=TPasArrayType) then
     begin
@@ -17928,7 +17949,7 @@ begin
     AssignSt.LHS:=CreateDotNameExpr(El,CreateTypeInfoRef(El,AContext,El),
                                    TJSString(GetBIName(pbivnRTTIArray_ElType)));
     AssignSt.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
-    AddToSourceElements(Src,AssignSt);
+    Result:=AssignSt;
     end
   else
     RaiseNotSupported(El,AContext,20200831115251);

packages/pastojs/tests/tcgenerics.pas

@@ -20,7 +20,7 @@ type
     Procedure TestGen_Record_ClassVarRecord_Program;
     Procedure TestGen_Record_ClassVarRecord_UnitImpl;
     Procedure TestGen_Record_RTTI_UnitImpl;
-    // ToDo: delay RTTI with anonymous array  a:array of T, array[1..2] of T
+    procedure TestGen_Record_Delay_UsedByImplUses;
     // ToDo: type alias type as parameter, TBird = type word;
 
     // generic class
@@ -288,7 +288,9 @@ begin
     '}, []);']));
   CheckSource('TestGen_Record_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
-    'pas.UnitA.TAnt$G1.$initSpec();',
+    '$mod.$implcode = function () {',
+    '  pas.UnitA.TAnt$G1.$initSpec();',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
     '']));
@@ -355,6 +357,53 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_Record_Delay_UsedByImplUses;
+begin
+  WithTypeInfo:=true;
+  StartProgram(true,[supTObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    '{$modeswitch AdvancedRecords}',
+    'type',
+    '  generic TBird<T> = record',
+    '    class var a: T;',
+    '  end;',
+    '']),
+  LinesToStr([
+    '']));
+  AddModuleWithIntfImplSrc('UnitB.pas',
+  LinesToStr([
+    'procedure Fly;',
+    '']),
+  LinesToStr([
+    'uses UnitA;',
+    'type',
+    '  TFox = record',
+    '    B: word;',
+    '  end;',
+    'procedure Fly;',
+    'var Bird: specialize TBird<TFox>;',
+    'begin',
+    '  if typeinfo(Bird)<>nil then ;',
+    '  Bird.a:=Bird.a;',
+    'end;',
+    '']));
+  Add([
+  'uses UnitB;',
+  'begin',
+  '  Fly;']);
+  ConvertProgram;
+  CheckSource('TestGen_Record_Delay_UsedByImplUses',
+    LinesToStr([ // statements
+    '$mod.$implcode = function () {',
+    '  pas.UnitA.TBird$G1.$initSpec();',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    'pas.UnitB.Fly();'
+    ]));
+end;
+
 procedure TTestGenerics.TestGen_ClassEmpty;
 begin
   StartProgram(false);
@@ -1201,7 +1250,9 @@ begin
     '']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
-    'pas.UnitA.TAnt$G1.$initSpec();',
+    '$mod.$implcode = function () {',
+    '  pas.UnitA.TAnt$G1.$initSpec();',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
     '']));
@@ -1453,7 +1504,6 @@ begin
     '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
-    //'pas.UnitA.TAnt$G1.$initSpec();',
     '']),
     LinesToStr([ // $mod.$main
     '']));
@@ -1706,7 +1756,9 @@ begin
     '  rtl.addIntf(this, pas.system.IUnknown);',
     '});',
     'this.i = null;',
-    'pas.UnitA.TAnt$G1.$initSpec();',
+    '$mod.$implcode = function () {',
+    '  pas.UnitA.TAnt$G1.$initSpec();',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
     'rtl.setIntfP($mod, "i", rtl.queryIntfT($mod.TBird.$create("Create"), pas.UnitA.TAnt$G1), true);',
@@ -2424,7 +2476,9 @@ begin
     '});']));
   CheckSource('TestGen_Array_OtherUnit',
     LinesToStr([ // statements
-    'pas.UnitA.$rtti["TDyn<UnitB.TAnt>"].eltype = pas.UnitB.$rtti["TAnt"];',
+    '$mod.$implcode = function () {',
+    '  pas.UnitA.$rtti["TDyn<UnitB.TAnt>"].eltype = pas.UnitB.$rtti["TAnt"];',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
     '  pas.UnitB.Run();',
@@ -2504,9 +2558,11 @@ begin
     '}, []);']));
   CheckSource('TestGen_ArrayOfUnitImplRec',
     LinesToStr([ // statements
-    'pas.UnitA.$rtti["TDyn<UnitA.TAnt>"].eltype = pas.UnitA.$rtti["TAnt"];',
-    'pas.UnitA.$rtti["TDyn<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
-    'pas.UnitA.$rtti["TStatic<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
+    '$mod.$implcode = function () {',
+    '  pas.UnitA.$rtti["TDyn<UnitA.TAnt>"].eltype = pas.UnitA.$rtti["TAnt"];',
+    '  pas.UnitA.$rtti["TDyn<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
+    '  pas.UnitA.$rtti["TStatic<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
     '']));
@@ -2673,7 +2729,9 @@ begin
     '}, []);']));
   CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
     LinesToStr([ // statements
-    'pas.UnitA.$rtti["TAnt<UnitA.TBird>"].init();',
+    '$mod.$implcode = function () {',
+    '  pas.UnitA.$rtti["TAnt<UnitA.TBird>"].init();',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
     '']));

packages/pastojs/tests/testpas2js.pp

@@ -21,7 +21,7 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, consoletestrunner, tcconverter, TCModules, TCSrcMap,
-  TCFiler, TCUnitSearch, TCOptimizations, TCGenerics, TCPrecompile;
+  TCFiler, TCUnitSearch, TCOptimizations, TCGenerics, TCPrecompile, unit2;
 
 type