pas2js: fixed delay init specializations after loading impl sections

compiler/packages/pastojs/src/fppas2js.pp

@@ -2072,8 +2072,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: TPasProgram; 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
@@ -8142,7 +8142,7 @@ Var
   ModuleName, ModVarName: String;
   IntfContext: TSectionContext;
   ImplVarSt: TJSVariableStatement;
-  HasImplUsesClause, ok, NeedRTLCheckVersion: Boolean;
+  HasImplCode, ok, NeedRTLCheckVersion: Boolean;
   Prg: TPasProgram;
   Lib: TPasLibrary;
   AssignSt: TJSSimpleAssignStatement;
@@ -8223,7 +8223,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
@@ -8231,7 +8231,7 @@ begin
         Lib:=TPasLibrary(El);
         if Assigned(Lib.LibrarySection) then
           AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
-        // ToDo AddDelayedInits(Lib,Src,IntfContext);
+        HasImplCode:=AddDelayedInits(Lib,Src,IntfContext);
         CreateInitSection(Lib,Src,IntfContext);
         end
       else
@@ -8262,20 +8262,19 @@ begin
         if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then
           begin
           // empty implementation
-
           // remove unneeded $impl from interface
           RemoveFromSourceElements(Src,ImplVarSt);
           // remove unneeded $mod.$implcode = function(){}
           RemoveFromSourceElements(Src,AssignSt);
-          HasImplUsesClause:=(El.ImplementationSection<>nil)
+          HasImplCode:=(El.ImplementationSection<>nil)
                          and (length(El.ImplementationSection.UsesClause)>0);
           end
         else
           begin
-          HasImplUsesClause:=true;
+          HasImplCode:=true;
           end;
 
-        if HasImplUsesClause then
+        if HasImplCode then
           // add implementation uses list: [<implementation uses1>,<uses2>, ...]
           ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
 
@@ -8286,7 +8285,6 @@ begin
     finally
       IntfContext.Free;
     end;
-
     // add implementation function
     if ImplVarSt<>nil then
       begin
@@ -17783,13 +17781,18 @@ begin
   IntfSec.AddImplHeaderStatement(JS);
 end;
 
-procedure TPasToJSConverter.AddDelayedInits(El: TPasProgram;
-  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 ;
@@ -17797,12 +17800,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;
@@ -17813,6 +17833,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');
@@ -17826,7 +17847,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
@@ -17838,7 +17859,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
@@ -17865,7 +17886,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);

compiler/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
     '']));