pastojs: fixed published field with anonymous array

compiler/packages/fcl-passrc/src/pasresolver.pp

@@ -2385,6 +2385,7 @@ type
       EvalLow: boolean; ErrorEl: TPasElement): TResEvalValue; virtual; // compute low() or high()
     function EvalTypeRange(Decl: TPasType; Flags: TResEvalFlags): TResEvalValue; virtual; // compute low() and high()
     function HasTypeInfo(El: TPasType): boolean; virtual;
+    function IsAnonymousElType(El: TPasType): boolean; virtual;
     function GetActualBaseType(bt: TResolverBaseType): TResolverBaseType; virtual;
     function GetCombinedBoolean(Bool1, Bool2: TResolverBaseType; ErrorEl: TPasElement): TResolverBaseType; virtual;
     function GetCombinedInt(const Int1, Int2: TPasResolverResult; ErrorEl: TPasElement): TResolverBaseType; virtual;
@@ -6233,15 +6234,26 @@ procedure TPasResolver.FinishSubElementType(Parent: TPasElement; El: TPasType);
     {$IFDEF CheckPasTreeRefCount};const aId: string{$ENDIF});
   var
     i: Integer;
-    p: TPasElement;
+    p, Prev: TPasElement;
   begin
     p:=El.Parent;
     if NewParent=p.Parent then
       begin
-      // e.g. a:array of longint; -> insert a$a in front of a
+      // e.g. m,n:array of longint; -> insert n$a in front of m
       i:=List.Count-1;
       while (i>=0) and (List[i]<>Pointer(p)) do
         dec(i);
+      if P is TPasVariable then
+        begin
+        while (i>0) do
+          begin
+          Prev:=TPasElement(List[i-1]);
+          if (Prev.ClassType=P.ClassType) and (TPasVariable(Prev).VarType=TPasVariable(P).VarType) then
+            dec(i) // e.g. m,n: array of longint
+          else
+            break;
+          end;
+        end;
       if i<0 then
         List.Add(El)
       else
@@ -29513,6 +29525,37 @@ begin
   Result:=true;
 end;
 
+function TPasResolver.IsAnonymousElType(El: TPasType): boolean;
+// e.g. b$a$a
+var
+  aName: String;
+  i, l: SizeInt;
+  j: Integer;
+begin
+  Result:=false;
+  if AnonymousElTypePostfix='' then exit;
+  aName:=El.Name;
+  l:=length(AnonymousElTypePostfix);
+  i:=length(aName);
+  repeat
+    dec(i,l);
+    if i>0 then
+      begin
+      j:=i;
+      while (j<=l) and (aName[i+j]=AnonymousElTypePostfix[j]) do inc(j);
+      if j>l then
+        begin
+        Result:=true;
+        continue;
+        end;
+      end;
+    if not Result then exit; // no postfix
+    // at least one anonymous eltype postfix
+    Result:=IsValidIdent(LeftStr(aName,i+l));
+    exit;
+  until false;
+end;
+
 function TPasResolver.GetActualBaseType(bt: TResolverBaseType
   ): TResolverBaseType;
 begin

compiler/packages/pastojs/src/fppas2js.pp

@@ -553,6 +553,7 @@ type
     pbifnArray_ConcatN,
     pbifnArray_Copy,
     pbifnArray_Equal,
+    pbifnArray_Insert,
     pbifnArray_Length,
     pbifnArray_Reference,
     pbifnArray_SetLength,
@@ -738,6 +739,7 @@ const
     'arrayConcatN', // rtl.arrayConcatN   pbifnArray_ConcatN
     'arrayCopy', // rtl.arrayCopy      pbifnArray_Copy
     'arrayEq', // rtl.arrayEq          pbifnArray_Equal
+    'arrayInsert', // rtl.arrayCopy      pbifnArray_Insert
     'length', // rtl.length    pbifnArray_Length
     'arrayRef', // rtl.arrayRef  pbifnArray_Reference
     'arraySetLength', // rtl.arraySetLength  pbifnArray_SetLength
@@ -2150,6 +2152,7 @@ type
     Function CreateRTTIMemberProperty(Members: TFPList; Index: integer;
       AContext: TConvertContext): TJSElement; virtual;
     Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual; // needed by precompiled files from 2.0.0
+    Function CreateRTTIAnonymousArray(El: TPasArrayType; AContext: TConvertContext): TJSCallExpression; virtual;
     Function CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements;
       FuncContext: TFunctionContext; MembersSrc: TJSSourceElements;
       MembersFuncContext: TFunctionContext; RTTIExpr: TJSElement;
@@ -14328,6 +14331,8 @@ end;
 
 function TPasToJSConverter.ConvertBuiltIn_CopyArray(El: TParamsExpr;
   AContext: TConvertContext): TJSElement;
+// convert  copy(Arr,Start,Count)
+//   ->  rtl.arrayCopy(type,Arr,Start,Count)
 var
   Param: TPasExpr;
   ParamResolved, ElTypeResolved: TPasResolverResult;
@@ -14396,25 +14401,32 @@ end;
 
 function TPasToJSConverter.ConvertBuiltIn_InsertArray(El: TParamsExpr;
   AContext: TConvertContext): TJSElement;
-// procedure insert(item,var array,const position)
-// ->  array.splice(position,0,item);
+// procedure insert(item,var AnArray,const position)
+// ->  AnArray=rtl.arrayInsert(item,AnArray,position);
 var
-  ArrEl: TJSElement;
   Call: TJSCallExpression;
+  AssignSt: TJSSimpleAssignStatement;
 begin
   Result:=nil;
-  Call:=nil;
+  AssignSt:=nil;
   try
+    // AnArray=
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+    AssignSt.LHS:=ConvertExpression(El.Params[1],AContext);
     Call:=CreateCallExpression(El);
-    ArrEl:=ConvertExpression(El.Params[1],AContext);
-    Call.Expr:=CreateDotNameExpr(El,ArrEl,'splice');
-    Call.AddArg(ConvertExpression(El.Params[2],AContext));
-    Call.AddArg(CreateLiteralNumber(El,0));
+    AssignSt.Expr:=Call;
+    // rtl.arrayInsert
+    Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnArray_Insert)]);
+    // param: item
     Call.AddArg(ConvertExpression(El.Params[0],AContext));
-    Result:=Call;
+    // param: AnArray
+    Call.AddArg(ConvertExpression(El.Params[1],AContext));
+    // param: position
+    Call.AddArg(ConvertExpression(El.Params[2],AContext));
+    Result:=AssignSt;
   finally
     if Result=nil then
-      Call.Free;
+      AssignSt.Free;
   end;
 end;
 
@@ -16567,19 +16579,13 @@ var
 
 var
   aResolver: TPas2JSResolver;
-  Scope: TPas2JSArrayScope;
-  SpecializeDelay: Boolean;
   AssignSt: TJSSimpleAssignStatement;
-  CallName, ArrName: String;
-  Obj: TJSObjectLiteral;
-  Prop: TJSObjectLiteralElement;
-  ArrLit: TJSArrayLiteral;
-  Arr: TPasArrayType;
+  ArrName: String;
   Index: Integer;
-  ElTypeHi, ElTypeLo: TPasType;
+  ElTypeLo: TPasType;
   RangeEl: TPasExpr;
   Call: TJSCallExpression;
-  RgLen, RangeEnd: TMaxPrecInt;
+  RangeEnd: TMaxPrecInt;
   List: TJSStatementList;
   Func: TJSFunctionDeclarationStatement;
   BodySrc: TJSSourceElements;
@@ -16602,9 +16608,6 @@ begin
   writeln('TPasToJSConverter.ConvertArrayType ',GetObjName(El));
   {$ENDIF}
 
-  Scope:=El.CustomData as TPas2JSArrayScope;
-  SpecializeDelay:=(Scope<>nil) and (SpecializeNeedsDelay(El,AContext));
-
   ProcScope:=nil;
   Src:=nil;
   if AContext.JSElement is TJSSourceElements then
@@ -16702,7 +16705,7 @@ begin
       else
         Result:=ArraySt;
 
-      // store precompiled enum type in proc
+      // store precompiled array type in proc
       StorePrecompiledJS(ArraySt);
 
       ArraySt:=nil;
@@ -16714,52 +16717,12 @@ begin
     end;
     end;
 
-  if HasTypeInfo(El,AContext) then
+  if (not (AContext.PasElement is TPasMembersType)) // rtti of members is added separate
+      and HasTypeInfo(El,AContext) then
     begin
-    // module.$rtti.$DynArray("name",{...})
-    if length(El.Ranges)>0 then
-      CallName:=GetBIName(pbifnRTTINewStaticArray)
-    else
-      CallName:=GetBIName(pbifnRTTINewDynArray);
-    Call:=CreateRTTINewType(El,CallName,false,AContext,Obj);
+    Call:=nil;
     try
-      ElTypeHi:=aResolver.ResolveAliasType(El.ElType,false);
-      ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
-      if length(El.Ranges)>0 then
-        begin
-        // static array
-        // dims: [dimsize1,dimsize2,...]
-        Prop:=Obj.Elements.AddElement;
-        Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_Dims));
-        ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
-        Prop.Expr:=ArrLit;
-        Arr:=El;
-        Index:=0;
-        repeat
-          RangeEl:=Arr.Ranges[Index];
-          RgLen:=aResolver.GetRangeLength(RangeEl);
-          ArrLit.AddElement(CreateLiteralNumber(RangeEl,RgLen));
-          inc(Index);
-          if Index=length(Arr.Ranges) then
-            begin
-            if ElTypeLo.ClassType<>TPasArrayType then
-              break;
-            Arr:=TPasArrayType(ElTypeLo);
-            if length(Arr.Ranges)=0 then
-              RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array');
-            ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
-            ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
-            Index:=0;
-            end;
-        until false;
-        end;
-      // eltype: ref
-      if not SpecializeDelay then
-        begin
-        Prop:=Obj.Elements.AddElement;
-        Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType));
-        Prop.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
-        end;
+      Call:=CreateRTTIAnonymousArray(El,AContext);
 
       if Src<>nil then
         begin
@@ -20058,6 +20021,7 @@ begin
 
   JSTypeInfo:=CreateTypeInfoRef(VarType,AContext,V);
   OptionsEl:=nil;
+
   // Note: create JSTypeInfo first, it may raise an exception
   Call:=CreateCallExpression(V);
   try
@@ -20403,6 +20367,80 @@ begin
     end;
 end;
 
+function TPasToJSConverter.CreateRTTIAnonymousArray(El: TPasArrayType;
+  AContext: TConvertContext): TJSCallExpression;
+var
+  Scope: TPas2JSArrayScope;
+  SpecializeDelay: Boolean;
+  CallName: String;
+  Call: TJSCallExpression;
+  Obj: TJSObjectLiteral;
+  aResolver: TPas2JSResolver;
+  ElTypeHi, ElTypeLo: TPasType;
+  Prop: TJSObjectLiteralElement;
+  ArrLit: TJSArrayLiteral;
+  Arr: TPasArrayType;
+  Index: Integer;
+  RangeEl: TPasExpr;
+  RgLen: TMaxPrecInt;
+begin
+  Result:=nil;
+  aResolver:=AContext.Resolver;
+
+  Scope:=El.CustomData as TPas2JSArrayScope;
+  SpecializeDelay:=(Scope<>nil) and (SpecializeNeedsDelay(El,AContext));
+
+  // module.$rtti.$DynArray("name",{...})
+  if length(El.Ranges)>0 then
+    CallName:=GetBIName(pbifnRTTINewStaticArray)
+  else
+    CallName:=GetBIName(pbifnRTTINewDynArray);
+  Call:=CreateRTTINewType(El,CallName,false,AContext,Obj);
+  try
+    ElTypeHi:=aResolver.ResolveAliasType(El.ElType,false);
+    ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
+    if length(El.Ranges)>0 then
+      begin
+      // static array
+      // dims: [dimsize1,dimsize2,...]
+      Prop:=Obj.Elements.AddElement;
+      Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_Dims));
+      ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+      Prop.Expr:=ArrLit;
+      Arr:=El;
+      Index:=0;
+      repeat
+        RangeEl:=Arr.Ranges[Index];
+        RgLen:=aResolver.GetRangeLength(RangeEl);
+        ArrLit.AddElement(CreateLiteralNumber(RangeEl,RgLen));
+        inc(Index);
+        if Index=length(Arr.Ranges) then
+          begin
+          if ElTypeLo.ClassType<>TPasArrayType then
+            break;
+          Arr:=TPasArrayType(ElTypeLo);
+          if length(Arr.Ranges)=0 then
+            RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array');
+          ElTypeHi:=aResolver.ResolveAliasType(Arr.ElType,false);
+          ElTypeLo:=aResolver.ResolveAliasType(ElTypeHi);
+          Index:=0;
+          end;
+      until false;
+      end;
+    // eltype: ref
+    if not SpecializeDelay then
+      begin
+      Prop:=Obj.Elements.AddElement;
+      Prop.Name:=TJSString(GetBIName(pbivnRTTIArray_ElType));
+      Prop.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
+      end;
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
+end;
+
 function TPasToJSConverter.CreateRTTIMembers(El: TPasMembersType;
   Src: TJSSourceElements; FuncContext: TFunctionContext;
   MembersSrc: TJSSourceElements; MembersFuncContext: TFunctionContext;
@@ -20458,35 +20496,51 @@ begin
   Members:=El.Members;
   For i:=0 to Members.Count-1 do
     begin
+    NewEl:=nil;
     P:=TPasElement(Members[i]);
     C:=P.ClassType;
-    // check visibility
-    case mt of
-    mtClass:
-      if P.Visibility<>visPublished then continue;
-    mtInterface: ; // all members of an interface are published
-    mtRecord:
-      // a published record publishes all non private members
-      if P.Visibility in [visPrivate,visStrictPrivate] then
-        continue;
-    end;
-    if not IsElementUsed(P) then continue;
-
-    NewEl:=nil;
-    if C=TPasVariable then
-      NewEl:=CreateRTTIMemberField(Members,i,MembersFuncContext)
-    else if C.InheritsFrom(TPasProcedure) then
+    writeln('AAA1 TPasToJSConverter.CreateRTTIMembers ',GetObjPath(P));
+    if C.InheritsFrom(TPasType) and HasTypeInfo(TPasType(P),MembersFuncContext) then
       begin
-      if aResolver.GetProcTemplateTypes(TPasProcedure(P))<>nil then
-        continue; // parametrized functions cannot be published
-      NewEl:=CreateRTTIMemberMethod(Members,i,MembersFuncContext);
+        writeln('AAA2 TPasToJSConverter.CreateRTTIMembers ',GetObjPath(P));
+      // published subtype
+      if aResolver.IsAnonymousElType(TPasType(P)) then
+        begin
+        // published anonymous eltype
+          writeln('AAA3 TPasToJSConverter.CreateRTTIMembers ',GetObjPath(P));
+        if C.InheritsFrom(TPasArrayType) then
+          NewEl:=CreateRTTIAnonymousArray(TPasArrayType(P),MembersFuncContext);
+        end;
       end
-    else if C=TPasProperty then
-      NewEl:=CreateRTTIMemberProperty(Members,i,MembersFuncContext)
-    else if C.InheritsFrom(TPasType)
-        or (C=TPasAttributes) then
     else
-      DoError(20190105142236,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
+      begin
+      // check visibility
+      case mt of
+      mtClass:
+        if P.Visibility<>visPublished then continue;
+      mtInterface: ; // all members of an interface are published
+      mtRecord:
+        // a published record publishes all non private members
+        if P.Visibility in [visPrivate,visStrictPrivate] then
+          continue;
+      end;
+      if not IsElementUsed(P) then continue;
+
+      if C=TPasVariable then
+        NewEl:=CreateRTTIMemberField(Members,i,MembersFuncContext)
+      else if C.InheritsFrom(TPasProcedure) then
+        begin
+        if aResolver.GetProcTemplateTypes(TPasProcedure(P))<>nil then
+          continue; // parametrized functions cannot be published
+        NewEl:=CreateRTTIMemberMethod(Members,i,MembersFuncContext);
+        end
+      else if C=TPasProperty then
+        NewEl:=CreateRTTIMemberProperty(Members,i,MembersFuncContext)
+      else if C.InheritsFrom(TPasType)
+          or (C=TPasAttributes) then
+      else
+        DoError(20190105142236,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
+      end;
     if NewEl=nil then
       continue; // e.g. abstract or external proc
     // add RTTI element

compiler/packages/pastojs/tests/tcgenerics.pas

@@ -486,7 +486,7 @@ begin
     '  };',
     '  this.Alter = function (w) {',
     '    this.FItems = rtl.arraySetLength(this.FItems, 0, rtl.length(this.FItems) + 1);',
-    '    this.FItems.splice(2, 0, w);',
+    '    this.FItems = rtl.arrayInsert(w, this.FItems, 2);',
     '    this.FItems.splice(2, 3);',
     '  };',
     '}, "TList<System.Word>");',

compiler/packages/pastojs/tests/tcmodules.pas

@@ -824,6 +824,7 @@ type
     Procedure TestRTTI_Class_PropertyParams;
     Procedure TestRTTI_Class_OtherUnit_TypeAlias;
     Procedure TestRTTI_Class_OmitRTTI;
+    Procedure TestRTTI_Class_Field_AnonymousArrayOfSelfClass;
     Procedure TestRTTI_IndexModifier;
     Procedure TestRTTI_StoredModifier;
     Procedure TestRTTI_DefaultValue;
@@ -10486,13 +10487,13 @@ begin
     'this.ArrArrInt = [];',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.ArrInt.splice(2, 0, 1);',
-    '$mod.ArrInt.splice(4, 0, $mod.ArrInt[3]);',
-    '$mod.ArrRec.splice(6, 0, $mod.ArrRec[5]);',
-    '$mod.ArrSet.splice(7, 0, $mod.ArrSet[7]);',
-    '$mod.ArrJSValue.splice(9, 0, $mod.ArrJSValue[8]);',
-    '$mod.ArrJSValue.splice(11, 0, 10);',
-    '$mod.ArrArrInt.splice(22, 0, [23]);',
+    '$mod.ArrInt = rtl.arrayInsert(1, $mod.ArrInt, 2);',
+    '$mod.ArrInt = rtl.arrayInsert($mod.ArrInt[3], $mod.ArrInt, 4);',
+    '$mod.ArrRec = rtl.arrayInsert($mod.ArrRec[5], $mod.ArrRec, 6);',
+    '$mod.ArrSet = rtl.arrayInsert($mod.ArrSet[7], $mod.ArrSet, 7);',
+    '$mod.ArrJSValue = rtl.arrayInsert($mod.ArrJSValue[8], $mod.ArrJSValue, 9);',
+    '$mod.ArrJSValue = rtl.arrayInsert(10, $mod.ArrJSValue, 11);',
+    '$mod.ArrArrInt = rtl.arrayInsert([23], $mod.ArrArrInt, 22);',
     '$mod.ArrInt.splice(12, 13);',
     '$mod.ArrRec.splice(14, 15);',
     '$mod.ArrSet.splice(17, 18);',
@@ -29632,9 +29633,6 @@ begin
   CheckSource('TestRTTI_Class_Field',
     LinesToStr([ // statements
     'rtl.createClass(this, "TObject", null, function () {',
-    '  $mod.$rtti.$DynArray("TObject.ArrB$a", {',
-    '    eltype: rtl.byte',
-    '  });',
     '  this.$init = function () {',
     '    this.FPropA = "";',
     '    this.VarLI = 0;',
@@ -29666,6 +29664,9 @@ begin
     '  $r.addField("VarShI", rtl.shortint);',
     '  $r.addField("VarBy", rtl.byte);',
     '  $r.addField("VarExt", rtl.longint);',
+    '  $mod.$rtti.$DynArray("TObject.ArrB$a", {',
+    '    eltype: rtl.byte',
+    '  });',
     '  $r.addField("ArrA", $mod.$rtti["TObject.ArrB$a"]);',
     '  $r.addField("ArrB", $mod.$rtti["TObject.ArrB$a"]);',
     '});',
@@ -29935,6 +29936,43 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRTTI_Class_Field_AnonymousArrayOfSelfClass;
+begin
+  WithTypeInfo:=true;
+  StartUnit(true,[supTObject]);
+  Add([
+  'interface',
+  'type',
+  '  {$M+1}',
+  '  TBird = class',
+  '  published',
+  '    Swarm: array of TBird;',
+  '  end;',
+  'implementation',
+  '']);
+  ConvertUnit;
+  CheckSource('TestRTTI_Class_Field_AnonymousArrayOfSelfClass',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TBird", pas.system.TObject, function () {',
+    '  this.$init = function () {',
+    '    pas.system.TObject.$init.call(this);',
+    '    this.Swarm = [];',
+    '  };',
+    '  this.$final = function () {',
+    '    this.Swarm = undefined;',
+    '    pas.system.TObject.$final.call(this);',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $mod.$rtti.$DynArray("TBird.Swarm$a", {',
+    '    eltype: $r',
+    '  });',
+    '  $r.addField("Swarm", $mod.$rtti["TBird.Swarm$a"]);',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_IndexModifier;
 begin
   WithTypeInfo:=true;
@@ -30700,9 +30738,6 @@ begin
   CheckSource('TestRTTI_Record',
     LinesToStr([ // statements
     'rtl.recNewT(this, "TFloatRec", function () {',
-    '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',
-    '    eltype: rtl.char',
-    '  });',
     '  this.$new = function () {',
     '    var r = Object.create(this);',
     '    r.c = [];',
@@ -30718,6 +30753,9 @@ begin
     '    return this;',
     '  };',
     '  var $r = $mod.$rtti.$Record("TFloatRec", {});',
+    '  $mod.$rtti.$DynArray("TFloatRec.d$a", {',
+    '    eltype: rtl.char',
+    '  });',
     '  $r.addField("c", $mod.$rtti["TFloatRec.d$a"]);',
     '  $r.addField("d", $mod.$rtti["TFloatRec.d$a"]);',
     '});',

compiler/utils/pas2js/dist/rtl.js

@@ -1040,6 +1040,14 @@ var rtl = {
     }
   },
 
+  arrayInsert: function(item, arr, index){
+    if (arr){
+      return arr.splice(index,0,item);
+    } else {
+      return [item];
+    }
+  },
+
   setCharAt: function(s,index,c){
     return s.substr(0,index)+c+s.substr(index+1);
   },