pastojs: fixed published field with anonymous array

git-svn-id: trunk@49076 -
(cherry picked from commit a3576453846bf5ebdad6fbcf9bc1b44853285396)

packages/fcl-passrc/src/pasresolver.pp

@@ -2387,6 +2387,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;
@@ -6236,15 +6237,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
@@ -29672,6 +29684,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

packages/pastojs/src/fppas2js.pp

@@ -2162,6 +2162,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;
@@ -16631,19 +16632,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;
@@ -16666,9 +16661,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
@@ -16766,7 +16758,7 @@ begin
       else
         Result:=ArraySt;
 
-      // store precompiled enum type in proc
+      // store precompiled array type in proc
       StorePrecompiledJS(ArraySt);
 
       ArraySt:=nil;
@@ -16778,52 +16770,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
@@ -20132,6 +20084,7 @@ begin
 
   JSTypeInfo:=CreateTypeInfoRef(VarType,AContext,V);
   OptionsEl:=nil;
+
   // Note: create JSTypeInfo first, it may raise an exception
   Call:=CreateCallExpression(V);
   try
@@ -20477,6 +20430,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;
@@ -20532,35 +20559,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

packages/pastojs/tests/tcmodules.pas

@@ -829,6 +829,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;
@@ -29679,9 +29680,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;',
@@ -29713,6 +29711,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"]);',
     '});',
@@ -29982,6 +29983,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;
@@ -30747,9 +30785,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 = [];',
@@ -30765,6 +30800,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"]);',
     '});',