pastojs: delay RTTI init of dynamic and static array specializations

git-svn-id: trunk@46749 -

packages/fcl-passrc/src/pparser.pp

@@ -14,26 +14,10 @@
 
  **********************************************************************}
 
-{$mode objfpc}
-{$h+}
-
-{$ifdef fpc}
-  {$define UsePChar}
-  {$define UseAnsiStrings}
-  {$define HasStreams}
-  {$IF FPC_FULLVERSION<30101}
-    {$define EmulateArrayInsert}
-  {$endif}
-  {$define HasFS}
-{$endif}
-
-{$IFDEF NODEJS}
-  {$define HasFS}
-{$ENDIF}
-
-
 unit PParser;
 
+{$i fcl-passrc.inc}
+
 interface
 
 uses

packages/pastojs/src/fppas2js.pp

@@ -15531,6 +15531,9 @@ var
   end;
 
 var
+  aResolver: TPas2JSResolver;
+  Scope: TPasArrayScope;
+  SpecializeNeedsDelay: Boolean;
   AssignSt: TJSSimpleAssignStatement;
   CallName, ArrName: String;
   Obj: TJSObjectLiteral;
@@ -15538,7 +15541,7 @@ var
   ArrLit: TJSArrayLiteral;
   Arr: TPasArrayType;
   Index: Integer;
-  ElType: TPasType;
+  ElTypeHi, ElTypeLo: TPasType;
   RangeEl: TPasExpr;
   Call: TJSCallExpression;
   RgLen, RangeEnd: TMaxPrecInt;
@@ -15552,7 +15555,6 @@ var
   BracketEx: TJSBracketMemberExpression;
   ArraySt, CloneEl: TJSElement;
   ReturnSt: TJSReturnStatement;
-  aResolver: TPas2JSResolver;
 begin
   Result:=nil;
   aResolver:=AContext.Resolver;
@@ -15564,6 +15566,10 @@ begin
   writeln('TPasToJSConverter.ConvertArrayType ',GetObjName(El));
   {$ENDIF}
 
+  Scope:=El.CustomData as TPasArrayScope;
+  SpecializeNeedsDelay:=(Scope<>nil)
+           and (aResolver.SpecializeNeedsDelay(Scope.SpecializedFromItem)<>nil);
+
   ProcScope:=nil;
   Src:=nil;
   if AContext.JSElement is TJSSourceElements then
@@ -15615,20 +15621,20 @@ begin
       BracketEx.MExpr:=CreatePrimitiveDotExpr(CloneArrName,El);
       BracketEx.Name:=CreatePrimitiveDotExpr(CloneRunName,El);
       // clone a[i]
-      ElType:=aResolver.ResolveAliasType(El.ElType);
+      ElTypeLo:=aResolver.ResolveAliasType(El.ElType);
       CloneEl:=nil;
-      if ElType is TPasArrayType then
+      if ElTypeLo is TPasArrayType then
         begin
-        if length(TPasArrayType(ElType).Ranges)=0 then
-          RaiseNotSupported(El,AContext,20180218223414,GetObjName(ElType));
-        CloneEl:=CreateCloneStaticArray(El,TPasArrayType(ElType),BracketEx,AContext);
+        if length(TPasArrayType(ElTypeLo).Ranges)=0 then
+          RaiseNotSupported(El,AContext,20180218223414,GetObjName(ElTypeLo));
+        CloneEl:=CreateCloneStaticArray(El,TPasArrayType(ElTypeLo),BracketEx,AContext);
         end
-      else if ElType is TPasRecordType then
-        CloneEl:=CreateRecordCallClone(El,TPasRecordType(ElType),BracketEx,AContext)
-      else if ElType is TPasSetType then
+      else if ElTypeLo is TPasRecordType then
+        CloneEl:=CreateRecordCallClone(El,TPasRecordType(ElTypeLo),BracketEx,AContext)
+      else if ElTypeLo is TPasSetType then
         CloneEl:=CreateReferencedSet(El,BracketEx)
       else
-        RaiseNotSupported(El,AContext,20180218223618,GetObjName(ElType));
+        RaiseNotSupported(El,AContext,20180218223618,GetObjName(ElTypeLo));
       Call.AddArg(CloneEl);
       BracketEx:=nil;
       // return r;
@@ -15679,7 +15685,8 @@ begin
       CallName:=GetBIName(pbifnRTTINewDynArray);
     Call:=CreateRTTINewType(El,CallName,false,AContext,Obj);
     try
-      ElType:=aResolver.ResolveAliasType(El.ElType);
+      ElTypeHi:=aResolver.ResolveAliasType(El.ElType,false);
+      ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
       if length(El.Ranges)>0 then
         begin
         // static array
@@ -15697,20 +15704,24 @@ begin
           inc(Index);
           if Index=length(Arr.Ranges) then
             begin
-            if ElType.ClassType<>TPasArrayType then
+            if ElTypeLo.ClassType<>TPasArrayType then
               break;
-            Arr:=TPasArrayType(ElType);
+            Arr:=TPasArrayType(ElTypeLo);
             if length(Arr.Ranges)=0 then
               RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array');
-            ElType:=aResolver.ResolveAliasType(Arr.ElType);
+            ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
+            ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
             Index:=0;
             end;
         until false;
         end;
       // eltype: ref
-      Prop:=Obj.Elements.AddElement;
-      Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType));
-      Prop.Expr:=CreateTypeInfoRef(ElType,AContext,El);
+      if not SpecializeNeedsDelay then
+        begin
+        Prop:=Obj.Elements.AddElement;
+        Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType));
+        Prop.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
+        end;
 
       if Src<>nil then
         begin
@@ -16729,6 +16740,10 @@ var
   Path: String;
   Call: TJSCallExpression;
   DotExpr: TJSDotMemberExpression;
+  AssignSt: TJSSimpleAssignStatement;
+  Arr: TPasArrayType;
+  ElTypeHi, ElTypeLo: TPasType;
+  aResolver: TPas2JSResolver;
 begin
   if not IsElementUsed(El) then exit;
   C:=El.ClassType;
@@ -16753,6 +16768,31 @@ begin
     Call.Expr:=DotExpr;
     AddToSourceElements(Src,Call);
     end
+  else if (C=TPasArrayType) then
+    begin
+    // pas.unitname.$rtti.TArr.eltype=$mod.$rtti.TBird;
+    aResolver:=AContext.Resolver;
+    Arr:=TPasArrayType(El);
+    ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
+    ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
+    if length(Arr.Ranges)>0 then
+      begin
+      // static array
+      while ElTypeLo.ClassType=TPasArrayType do
+        begin
+        Arr:=TPasArrayType(ElTypeLo);
+        if length(Arr.Ranges)=0 then
+          RaiseNotSupported(Arr,AContext,20200902155418,'static array of anonymous array');
+        ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
+        ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
+        end;
+      end;
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    AssignSt.LHS:=CreateDotNameExpr(El,CreateTypeInfoRef(El,AContext,El),
+                                   TJSString(GetBIName(pbivnRTTIArray_ElType)));
+    AssignSt.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
+    AddToSourceElements(Src,AssignSt);
+    end
   else
     RaiseNotSupported(El,AContext,20200831115251);
 end;

packages/pastojs/tests/tcgenerics.pas

@@ -76,7 +76,7 @@ type
     procedure TestGenMethod_ObjFPC;
 
     // generic array
-    // procedure TestGen_ArrayOfUnitImplRec;  ToDo dynamic + static + RTTI
+    procedure TestGen_ArrayOfUnitImplRec;
 
     // generic procedure type
     procedure TestGen_ProcType_ParamUnitImpl;
@@ -1974,6 +1974,76 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ArrayOfUnitImplRec;
+begin
+  WithTypeInfo:=true;
+  StartProgram(true,[supTObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+  'type',
+  '  generic TDyn<T> = array of T;',
+  '  generic TStatic<T> = array[1..2] of T;',
+  '']),
+  LinesToStr([
+  'type',
+  '  TBird = record',
+  '    b: word;',
+  '  end;',
+  'var',
+  '  d: specialize TDyn<TBird>;',
+  '  s: specialize TStatic<TBird>;',
+  'begin',
+  '  d[0].b:=s[1].b;',
+  '']));
+  Add([
+  'uses UnitA;',
+  'begin',
+  'end.']);
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  $mod.$rtti.$DynArray("TDyn$G1", {});',
+    '  this.TStatic$G1$clone = function (a) {',
+    '    var r = [];',
+    '    for (var i = 0; i < 2; i++) r.push($impl.TBird.$clone(a[i]));',
+    '    return r;',
+    '  };',
+    '  $mod.$rtti.$StaticArray("TStatic$G1", {',
+    '    dims: [2]',
+    '  });',
+    '  $mod.$init = function () {',
+    '    $impl.d[0].b = $impl.s[0].b;',
+    '  };',
+    '}, null, function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  rtl.recNewT($impl, "TBird", function () {',
+    '    this.b = 0;',
+    '    this.$eq = function (b) {',
+    '      return this.b === b.b;',
+    '    };',
+    '    this.$assign = function (s) {',
+    '      this.b = s.b;',
+    '      return this;',
+    '    };',
+    '    var $r = $mod.$rtti.$Record("TBird", {});',
+    '    $r.addField("b", rtl.word);',
+    '  });',
+    '  $impl.d = [];',
+    '  $impl.s = rtl.arraySetLength(null, $impl.TBird, 2);',
+    '});']));
+  CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
+    LinesToStr([ // statements
+    'pas.UnitA.$rtti["TDyn$G1"].eltype = pas.UnitA.$rtti["TBird"];',
+    'pas.UnitA.$rtti["TStatic$G1"].eltype = pas.UnitA.$rtti["TBird"];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ProcType_ParamUnitImpl;
 begin
   WithTypeInfo:=true;