pastojs: extended rtti for methods and properties

packages/fcl-passrc/src/pastree.pp

@@ -776,6 +776,19 @@ type
         Methods: TRTTIVisibilitySections;
         Properties: TRTTIVisibilitySections;
       end;
+    const
+      VisibilityToExtRTTI: array[TPasMemberVisibility] of TRTTIVisibilitySection = (
+        vcPublic, // visDefault,
+        vcPrivate, // visPrivate,
+        vcProtected, // visProtected,
+        vcPublic, // visPublic,
+        vcPublished, // visPublished,
+        vcPublic, // visAutomated,
+        vcPrivate, // visStrictPrivate,
+        vcProtected, // visStrictProtected,
+        vcPublic, // visRequired,
+        vcPublic // visOptional
+        );
   public
     PackMode: TPackMode;
     Members: TFPList;
@@ -787,6 +800,7 @@ type
     Function IsBitPacked : Boolean; inline;
     Procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
+    Function HasExtRTTI(El: TPasElement): boolean; virtual;
   end;
 
   { TPasRecordType }
@@ -4598,6 +4612,31 @@ begin
     ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
 end;
 
+function TPasMembersType.HasExtRTTI(El: TPasElement): boolean;
+var
+  C: TClass;
+begin
+  if El.Visibility=visPublished then
+    exit(true);
+  C:=El.ClassType;
+  if C=TPasVariable then
+    begin
+    if VisibilityToExtRTTI[El.Visibility] in RTTIVisibility.Fields then
+      exit(true);
+    end
+  else if C=TPasProperty then
+    begin
+    if VisibilityToExtRTTI[El.Visibility] in RTTIVisibility.Properties then
+      exit(true);
+    end
+  else if C.InheritsFrom(TPasProcedure) then
+    begin
+    if VisibilityToExtRTTI[El.Visibility] in RTTIVisibility.Methods then
+      exit(true);
+    end;
+  Result:=false;
+end;
+
 { TPasRecordType }
 
 procedure TPasRecordType.GetMembers(S: TStrings);

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1223,7 +1223,6 @@ begin
     UseSubEl(TPasArgument(El).ArgType)
   else if C=TPasProperty then
     begin
-    // published property
     Prop:=TPasProperty(El);
     Args:=Resolver.GetPasPropertyArgs(Prop);
     for i:=0 to Args.Count-1 do
@@ -1232,7 +1231,7 @@ begin
     UseElement(Resolver.GetPasPropertyGetter(Prop),rraRead,false);
     UseElement(Resolver.GetPasPropertySetter(Prop),rraRead,false);
     UseElement(Resolver.GetPasPropertyIndex(Prop),rraRead,false);
-    // stored and defaultvalue are only used when published -> mark as used
+    // stored and defaultvalue are only used with typeinfo -> mark as used
     UseElement(Resolver.GetPasPropertyStoredExpr(Prop),rraRead,false);
     UseElement(Resolver.GetPasPropertyDefaultExpr(Prop),rraRead,false);
     end
@@ -1279,7 +1278,7 @@ begin
   else if C=TPasClassOfType then
   else if C=TPasRecordType then
     begin
-    // published record: use all members (except generic)
+    // record: use all members (except generic)
     Rec:=TPasRecordType(El);
     if CanSkipGenericType(Rec) then exit;
     Members:=Rec.Members;
@@ -2266,6 +2265,7 @@ var
   Map: TPasClassIntfMap;
   ImplProc, IntfProc, Proc: TPasProcedure;
   aClass: TPasClassType;
+  C: TClass;
 begin
   FirstTime:=true;
   case Mode of
@@ -2347,7 +2347,8 @@ begin
   for i:=0 to El.Members.Count-1 do
     begin
     Member:=TPasElement(El.Members[i]);
-    if FirstTime and (Member is TPasProcedure) then
+    C:=Member.ClassType;
+    if FirstTime and C.InheritsFrom(TPasProcedure) then
       begin
       Proc:=TPasProcedure(Member);
       ProcScope:=Member.CustomData as TPasProcedureScope;
@@ -2398,10 +2399,11 @@ begin
         continue;
         end;
       end
-    else if Member.ClassType=TPasAttributes then
+    else if C=TPasAttributes then
       continue; // attributes are never used directly
 
-    if AllPublished and (Member.Visibility=visPublished) then
+    if AllPublished
+        and ((Member.Visibility=visPublished) or El.HasExtRTTI(Member)) then
       begin
       // include published
       if not FirstTime then continue;
@@ -2418,12 +2420,12 @@ begin
       continue
     else if (Mode=paumAllPasUsable) and FirstTime then
       begin
-      if Member.ClassType=TPasProperty then
+      if C=TPasProperty then
         begin
         // non private property can be used by typeinfo by descendants in other units
         UseTypeInfo(Member);
         end
-      else if Member is TPasType then
+      else if C.InheritsFrom(TPasType) then
         begin
         // non private type can be used by descendants in other units
         UseType(TPasType(Member),Mode);

packages/fcl-passrc/src/pparser.pp

@@ -111,7 +111,7 @@ const
   nFileSystemsNotSupported = 2057;
   nInvalidMessageType = 2058;
   nErrCompilationAborted = 2059; // FPC = 1018;
-  nErrInvalidCompilerDirectiveRTTI = 2060;
+  nErrInvalidParamsForDirectiveX = 2060;
 
 // resourcestring patterns of messages
 resourcestring
@@ -175,7 +175,7 @@ resourcestring
   SErrFileSystemNotSupported = 'No support for filesystems enabled';
   SErrInvalidMessageType = 'Invalid message type: string or integer expression expected';
   SErrCompilationAborted = 'Compilation aborted';
-  SErrInvalidCompilerDirectiveX = 'Invalid compiler directive %s';
+  SErrInvalidParamsForDirectiveX = 'Invalid parameters for compiler directive %s';
 
 type
   TPasScopeType = (
@@ -5144,7 +5144,7 @@ begin
   if not (po_CheckDirectiveRTTI in Options) then exit;
   Handled:=true;
   if not ParseRTTIDirective(Param,NewVisibility) then
-    ParseExc(nErrInvalidCompilerDirectiveRTTI,SErrInvalidCompilerDirectiveX,[Directive]);
+    ParseExc(nErrInvalidParamsForDirectiveX,SErrInvalidParamsForDirectiveX,[Directive]);
   RTTIVisibility:=NewVisibility;
 end;
 

packages/pastojs/src/fppas2js.pp

@@ -559,9 +559,15 @@ resourcestring
 
 const
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
-  IsExtModePasClassInstance = 1;
-  IsExtModePasClass = 2;
+  IsExtModePasClassInstance = 1; // rtl.isExt param for is-class-instance
+  IsExtModePasClass = 2; // rtl.isExt param for is-class
   LocalVarHide = '-';
+  ExtRTTIVisPrivate = 0;
+  ExtRTTIVisProtected = 1;
+  ExtRTTIVisPublic = 2;
+  ExtRTTIVisPublished = 3;
+  ExtRTTIVisPublicPublished = 4; // in source published, in RTTI public
+  ExtRTTIVisDefault = ExtRTTIVisPublic;
 
 type
   TPas2JSBuiltInName = (
@@ -1374,7 +1380,8 @@ const
     po_ResolveStandardTypes,
     po_ExtConstWithoutExpr,
     po_StopOnUnitInterface,
-    po_AsyncProcs];
+    po_AsyncProcs,
+    po_CheckDirectiveRTTI];
 
   btAllJSBaseTypes = [
     btChar,
@@ -1699,6 +1706,7 @@ type
     function GetBaseDescription(const R: TPasResolverResult; AddPath: boolean=
       false): string; override;
     function HasTypeInfo(El: TPasType): boolean; override;
+    function HasExtRTTI(El: TPasMembersType): boolean; virtual;
     function ProcHasImplElements(Proc: TPasProcedure): boolean; override;
     function HasAnonymousFunctions(El: TPasImplElement): boolean;
     function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope;
@@ -2200,11 +2208,12 @@ type
     Function CreateRTTINewType(El: TPasType; const CallFuncName: string;
       IsForward: boolean; AContext: TConvertContext; out ObjLit: TJSObjectLiteral): TJSCallExpression; virtual;
     Function CreateRTTIAttributes(const Attr: TPasExprArray; PosEl: TPasElement; aContext: TConvertContext): TJSElement; virtual;
-    Function CreateRTTIMemberField(Members: TFPList; Index: integer;
+    Function GetExtRTTIVisibilityParam(El: TPasElement; const Vis: TPasMembersType.TRTTIVisibilitySections): word; virtual;
+    Function CreateRTTIMemberField(ParentEl: TPasMembersType; Members: TFPList; Index: integer;
       AContext: TConvertContext): TJSElement; virtual;
-    Function CreateRTTIMemberMethod(Members: TFPList; Index: integer;
+    Function CreateRTTIMemberMethod(ParentEl: TPasMembersType; Members: TFPList; Index: integer;
       AContext: TConvertContext): TJSElement; virtual;
-    Function CreateRTTIMemberProperty(Members: TFPList; Index: integer;
+    Function CreateRTTIMemberProperty(ParentEl: TPasMembersType; 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;
@@ -3394,7 +3403,7 @@ begin
     if TPasProcedure(El).IsOverride then
       exit(true); // using name of overridden
     if El.Visibility=visPublished then
-      exit(false);
+      exit(false); // published elements are always using the pascal identifier
 
     // Note: external proc pollutes the name space
     ProcScope:=TPasProcedureScope(El.CustomData);
@@ -4312,6 +4321,12 @@ begin
     if El.ExternalName='' then
       RaiseMsg(20170321151109,nMissingExternalName,sMissingExternalName,[],El);
     AddExternalPath(El.ExternalName,El);
+    if El.RTTIVisibility.Fields<>[] then
+      RaiseNotYetImplemented(20250103153804,El,'RTTI for external class');
+    if El.RTTIVisibility.Methods<>[] then
+      RaiseNotYetImplemented(20250103153905,El,'RTTI for external class');
+    if El.RTTIVisibility.Properties<>[] then
+      RaiseNotYetImplemented(20250103153913,El,'RTTI for external class');
     end;
   if El.IsPacked then
     RaiseMsg(20180326155616,nPasElementNotSupported,sPasElementNotSupported,
@@ -7406,6 +7421,28 @@ begin
     Result:=false;
 end;
 
+function TPas2JSResolver.HasExtRTTI(El: TPasMembersType): boolean;
+var
+  Members: TFPList;
+  i: Integer;
+  ChildEl: TPasElement;
+  V: TPasMembersType.TRTTIVisibility;
+begin
+  Result:=false;
+  V:=El.RTTIVisibility;
+  if (V.Fields=[])
+      and (V.Methods=[])
+      and (V.Properties=[]) then exit;
+
+  Members:=El.Members;
+  for i:=0 to Members.Count-1 do
+    begin
+    ChildEl:=TPasElement(Members[i]);
+    if El.HasExtRTTI(ChildEl) then
+      exit(true);
+    end;
+end;
+
 function TPas2JSResolver.ProcHasImplElements(Proc: TPasProcedure): boolean;
 var
   Scope: TPas2JSProcedureScope;
@@ -16100,7 +16137,8 @@ begin
       end;
 
     NeedInitFunction:=true;
-    NeedTypeInfo:=(pcsfPublished in Scope.Flags) or HasTypeInfo(El,AContext);
+    NeedTypeInfo:=(pcsfPublished in Scope.Flags) or HasTypeInfo(El,AContext)
+                  or aResolver.HasExtRTTI(El);
     IntfKind:='';
     if El.ObjKind=okInterface then
       begin
@@ -20715,7 +20753,25 @@ begin
   end;
 end;
 
-function TPasToJSConverter.CreateRTTIMemberField(Members: TFPList;
+function TPasToJSConverter.GetExtRTTIVisibilityParam(El: TPasElement; const Vis: TPasMembersType.
+  TRTTIVisibilitySections): word;
+var
+  ExtVis: TPasMembersType.TRTTIVisibilitySection;
+begin
+  ExtVis:=TPasMembersType.VisibilityToExtRTTI[El.Visibility];
+  case ExtVis of
+    vcPrivate: Result:=ExtRTTIVisPrivate;
+    vcProtected: Result:=ExtRTTIVisProtected;
+    vcPublic: Result:=ExtRTTIVisPublic;
+    vcPublished:
+      if not (vcPublished in Vis) then
+        Result:=ExtRTTIVisPublicPublished
+      else
+        Result:=ExtRTTIVisPublished;
+  end;
+end;
+
+function TPasToJSConverter.CreateRTTIMemberField(ParentEl: TPasMembersType; Members: TFPList;
   Index: integer; AContext: TConvertContext): TJSElement;
 // create $r.addField("varname",typeinfo);
 // create $r.addField("varname",typeinfo,options);
@@ -20723,6 +20779,12 @@ var
   V: TPasVariable;
   Call: TJSCallExpression;
   OptionsEl: TJSObjectLiteral;
+  ExtVis: word;
+
+  procedure AddExtRTTIVisibility;
+  begin
+    Call.AddArg(CreateLiteralNumber(V,ExtVis));
+  end;
 
   procedure AddOption(const aName: String; JS: TJSElement);
   var
@@ -20731,6 +20793,8 @@ var
     if JS=nil then exit;
     if OptionsEl=nil then
       begin
+      if ExtVis=ExtRTTIVisDefault then
+        AddExtRTTIVisibility;
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,V));
       Call.AddArg(OptionsEl);
       end;
@@ -20775,6 +20839,7 @@ begin
 
   JSTypeInfo:=CreateTypeInfoRef(VarType,AContext,V);
   OptionsEl:=nil;
+  ExtVis:=GetExtRTTIVisibilityParam(V,ParentEl.RTTIVisibility.Fields);
 
   // Note: create JSTypeInfo first, it may raise an exception
   Call:=CreateCallExpression(V);
@@ -20786,6 +20851,9 @@ begin
     Call.AddArg(CreateLiteralString(V,aName));
     // param typeinfo
     Call.AddArg(JSTypeInfo);
+    // extended RTTI
+    if ExtVis<>ExtRTTIVisDefault then
+      AddExtRTTIVisibility;
 
     // param options if needed as {}
     // option: attributes
@@ -20801,7 +20869,7 @@ begin
   end;
 end;
 
-function TPasToJSConverter.CreateRTTIMemberMethod(Members: TFPList;
+function TPasToJSConverter.CreateRTTIMemberMethod(ParentEl: TPasMembersType; Members: TFPList;
   Index: integer; AContext: TConvertContext): TJSElement;
 // create $r.addMethod("funcname",methodkind,params,resulttype,options)
 var
@@ -20810,6 +20878,12 @@ var
   ResultTypeInfo: TJSElement;
   Call: TJSCallExpression;
   Flags: Integer;
+  ExtVis: word;
+
+  procedure AddExtRTTIVisibility;
+  begin
+    Call.AddArg(CreateLiteralNumber(Proc,ExtVis));
+  end;
 
   procedure AddOption(const aName: String; JS: TJSElement);
   var
@@ -20818,6 +20892,8 @@ var
     if JS=nil then exit;
     if OptionsEl=nil then
       begin
+      if ExtVis=ExtRTTIVisDefault then
+        AddExtRTTIVisibility;
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Proc));
       Call.AddArg(OptionsEl);
       end;
@@ -20887,6 +20963,11 @@ begin
     // param params as []
     Call.AddArg(CreateRTTIArgList(Proc,Proc.ProcType.Args,AContext));
 
+    // add visibility
+    ExtVis:=GetExtRTTIVisibilityParam(Proc,ParentEl.RTTIVisibility.Fields);
+    if ExtVis<>ExtRTTIVisDefault then
+      AddExtRTTIVisibility;
+
     // optional params:
     ResultTypeInfo:=nil;
     Flags:=0;
@@ -20927,7 +21008,7 @@ begin
   end;
 end;
 
-function TPasToJSConverter.CreateRTTIMemberProperty(Members: TFPList;
+function TPasToJSConverter.CreateRTTIMemberProperty(ParentEl: TPasMembersType; Members: TFPList;
   Index: integer; AContext: TConvertContext): TJSElement;
 // create  $r.addProperty("propname",flags,proptype,"getter","setter",{options})
 var
@@ -20935,6 +21016,13 @@ var
   Call: TJSCallExpression;
   OptionsEl: TJSObjectLiteral;
 
+  ExtVis: word;
+
+  procedure AddExtRTTIVisibility;
+  begin
+    Call.AddArg(CreateLiteralNumber(Prop,ExtVis));
+  end;
+
   function GetAccessorName(Decl: TPasElement): String;
   begin
     Result:=TransformElToJSName(Decl,AContext);
@@ -20947,6 +21035,8 @@ var
     if JS=nil then exit;
     if OptionsEl=nil then
       begin
+      if ExtVis=ExtRTTIVisDefault then
+        AddExtRTTIVisibility;
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Prop));
       Call.AddArg(OptionsEl);
       end;
@@ -21048,6 +21138,11 @@ begin
     else
       Call.AddArg(CreateLiteralString(Prop,GetAccessorName(SetterPas)));
 
+    // add visibility
+    ExtVis:=GetExtRTTIVisibilityParam(Prop,ParentEl.RTTIVisibility.Fields);
+    if ExtVis<>ExtRTTIVisDefault then
+      AddExtRTTIVisibility;
+
     // add option "index"
     IndexExpr:=aResolver.GetPasPropertyIndex(Prop);
     if IndexExpr<>nil then
@@ -21279,35 +21374,35 @@ begin
       mtClass:
         if (P.Visibility=visPublished) then
           // published member
-        else if (P is TPasConstructor) and (P.Visibility = visPublic)
-            and (pcsfPublished in TPas2JSClassScope(El.CustomData).Flags) then
-          // this class supports published members -> add public constructor to RTTI
-          // workaround til extended RTTI
-          // see issue #37752
+        else if El.HasExtRTTI(P) then
+          // extended RTTI
         else
           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
+          begin
+          if not El.HasExtRTTI(P) then
+            continue;
+          end
         else if P.ClassType=TPasConst then
           continue;
       end;
       if not IsElementUsed(P) then continue;
 
       if C=TPasVariable then
-        NewEl:=CreateRTTIMemberField(Members,i,MembersFuncContext)
+        NewEl:=CreateRTTIMemberField(El,Members,i,MembersFuncContext)
       else if C.InheritsFrom(TPasProcedure) then
         begin
         if aResolver.GetProcTemplateTypes(TPasProcedure(P))<>nil then
           continue; // parametrized functions cannot be published
         if (P.CustomData as TPas2JSProcedureScope).SpecializedFromItem<>nil then
           continue; // specialized function cannot be published
-        NewEl:=CreateRTTIMemberMethod(Members,i,MembersFuncContext);
+        NewEl:=CreateRTTIMemberMethod(El,Members,i,MembersFuncContext);
         end
       else if C=TPasProperty then
-        NewEl:=CreateRTTIMemberProperty(Members,i,MembersFuncContext)
+        NewEl:=CreateRTTIMemberProperty(El,Members,i,MembersFuncContext)
       else if C.InheritsFrom(TPasType)
           or (C=TPasAttributes) then
       else

packages/pastojs/tests/tcgenerics.pas

@@ -680,7 +680,7 @@ begin
     '    this.m = 0;',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addField("m", rtl.word);',
+    '  $r.addField("m", rtl.word, 4);',
     '}, "TBird<System.Word>");',
     'this.b = null;',
     'this.p = null;',
@@ -1145,7 +1145,7 @@ begin
     '    $mod.TPersistent.$final.call(this);',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addField("f", $mod.$rtti["TFish<System.Word>"]);',
+    '  $r.addField("f", $mod.$rtti["TFish<System.Word>"], 4);',
     '}, "TAnt<System.Word>");',
     'rtl.createClass(this, "TFish$G2", this.TPersistent, function () {',
     '  this.$init = function () {',
@@ -1157,7 +1157,7 @@ begin
     '    $mod.TPersistent.$final.call(this);',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addField("a", $mod.$rtti["TAnt<System.Word>"]);',
+    '  $r.addField("a", $mod.$rtti["TAnt<System.Word>"], 4);',
     '}, "TFish<System.Word>");',
     'this.WordFish = null;',
     'this.p = null;',
@@ -1206,7 +1206,7 @@ begin
     '        this.Size = false;',
     '      };',
     '      var $r = this.$rtti;',
-    '      $r.addField("Size", rtl.boolean);',
+    '      $r.addField("Size", rtl.boolean, 4);',
     '    }, "TAnt<System.Boolean>.TLeg");',
     '  }, "TAnt<System.Boolean>");',
     '});']));

packages/pastojs/tests/tcmodules.pas

@@ -879,10 +879,13 @@ type
     Procedure TestRTTI_PublishedClassFieldFail;
     Procedure TestRTTI_PublishedFieldExternalFail;
     Procedure TestRTTI_Class_Field;
+    Procedure TestRTTI_Class_FieldPrivate;
     Procedure TestRTTI_Class_Method;
     Procedure TestRTTI_Class_MethodArgFlags;
+    Procedure TestRTTI_Class_MethodPrivate;
     Procedure TestRTTI_Class_Property;
     Procedure TestRTTI_Class_PropertyParams;
+    Procedure TestRTTI_Class_PropertyPrivate;
     Procedure TestRTTI_Class_OtherUnit_TypeAlias;
     Procedure TestRTTI_Class_OmitRTTI;
     Procedure TestRTTI_Class_Field_AnonymousArrayOfSelfClass;
@@ -19120,7 +19123,7 @@ begin
     '    this.FSwiper = undefined;',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addProperty("Swiper", 0, $mod.$rtti["JSwiper"], "FSwiper", "FSwiper");',
+    '  $r.addProperty("Swiper", 0, $mod.$rtti["JSwiper"], "FSwiper", "FSwiper", 4);',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -19217,9 +19220,9 @@ begin
     '  this.$final = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addField("FDate", rtl.string);',
-    '  $r.addProperty("Date", 0, rtl.string, "FDate", "FDate");',
-    '  $r.addProperty("ExtA", 0, rtl.string, "FDate", "FDate");',
+    '  $r.addField("FDate", rtl.string, 4);',
+    '  $r.addProperty("Date", 0, rtl.string, "FDate", "FDate", 4);',
+    '  $r.addProperty("ExtA", 0, rtl.string, "FDate", "FDate", 4);',
     '});',
     'this.B = null;',
     'this.o = null;',
@@ -29616,7 +29619,7 @@ begin
   'procedure DoIt(p: ^longint); begin end;',
   'begin',
   '']);
-  SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
+  SetExpectedParserError('Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block. at token "^" in file test1.pp at line 3 column 19',nParserParamsOrResultTypesNoLocalTypeDefs);
   ConvertProgram;
 end;
 
@@ -29638,7 +29641,7 @@ begin
   'function DoIt: ^longint; begin end;',
   'begin',
   '']);
-  SetExpectedPasResolverError('Not supported: pointer',nNotSupportedX);
+  SetExpectedParserError('Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block. at token "^" in file test1.pp at line 3 column 16',nParserParamsOrResultTypesNoLocalTypeDefs);
   ConvertProgram;
 end;
 
@@ -31560,13 +31563,13 @@ begin
     '  this.Fly = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addMethod("Fly", 0, []);',
+    '  $r.addMethod("Fly", 0, [], 4);',
     '});',
     'rtl.createClass(this, "TEagle", this.TBird, function () {',
     '  this.Fly = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addMethod("Fly", 0, []);',
+    '  $r.addMethod("Fly", 0, [], 4);',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -31689,22 +31692,22 @@ begin
     '    this.ArrB = undefined;',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addField("VarLI", rtl.longint);',
-    '  $r.addField("VarC", rtl.char);',
-    '  $r.addField("VarS", rtl.string);',
-    '  $r.addField("VarD", rtl.double);',
-    '  $r.addField("VarB", rtl.boolean);',
-    '  $r.addField("VarLW", rtl.longword);',
-    '  $r.addField("VarSmI", rtl.smallint);',
-    '  $r.addField("VarW", rtl.word);',
-    '  $r.addField("VarShI", rtl.shortint);',
-    '  $r.addField("VarBy", rtl.byte);',
-    '  $r.addField("VarExt", rtl.longint);',
+    '  $r.addField("VarLI", rtl.longint, 4);',
+    '  $r.addField("VarC", rtl.char, 4);',
+    '  $r.addField("VarS", rtl.string, 4);',
+    '  $r.addField("VarD", rtl.double, 4);',
+    '  $r.addField("VarB", rtl.boolean, 4);',
+    '  $r.addField("VarLW", rtl.longword, 4);',
+    '  $r.addField("VarSmI", rtl.smallint, 4);',
+    '  $r.addField("VarW", rtl.word, 4);',
+    '  $r.addField("VarShI", rtl.shortint, 4);',
+    '  $r.addField("VarBy", rtl.byte, 4);',
+    '  $r.addField("VarExt", rtl.longint, 4);',
     '  $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"]);',
+    '  $r.addField("ArrA", $mod.$rtti["TObject.ArrB$a"], 4);',
+    '  $r.addField("ArrB", $mod.$rtti["TObject.ArrB$a"], 4);',
     '});',
     'this.p = null;',
     'this.Obj = null;',
@@ -31716,6 +31719,48 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRTTI_Class_FieldPrivate;
+begin
+  WithTypeInfo:=true;
+  StartProgram(false);
+  Add('type');
+  Add('{$RTTI explicit fields([vcPrivate,vcProtected,vcPublic,vcPublished])}');
+  Add('  TObject = class');
+  Add('  private');
+  Add('    A: word;');
+  Add('  protected');
+  Add('    B1, B2: word;');
+  Add('  public');
+  Add('    C: word;');
+  Add('  published');
+  Add('    D: word;');
+  Add('  end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_Class_FieldPrivate',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.A = 0;',
+    '    this.B1 = 0;',
+    '    this.B2 = 0;',
+    '    this.C = 0;',
+    '    this.D = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("A", rtl.word, 0);',
+    '  $r.addField("B1", rtl.word, 1);',
+    '  $r.addField("B2", rtl.word, 1);',
+    '  $r.addField("C", rtl.word);',
+    '  $r.addField("D", rtl.word, 3);',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_Class_Method;
 begin
   WithTypeInfo:=true;
@@ -31742,11 +31787,11 @@ begin
     '  this.$final = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addMethod("Click", 0, []);',
-    '  $r.addMethod("Notify", 0, [["Sender", $r]]);',
-    '  $r.addMethod("GetNotify", 1, [], rtl.boolean, 4);',
-    '  $r.addMethod("Println", 0, [["a", rtl.longint], ["b", rtl.longint]], null, 2);',
-    '  $r.addMethod("Fetch", 1, [["URL", rtl.string]], rtl.word, 20);',
+    '  $r.addMethod("Click", 0, [], 4);',
+    '  $r.addMethod("Notify", 0, [["Sender", $r]], 4);',
+    '  $r.addMethod("GetNotify", 1, [], 4, rtl.boolean, 4);',
+    '  $r.addMethod("Println", 0, [["a", rtl.longint], ["b", rtl.longint]], 4, null, 2);',
+    '  $r.addMethod("Fetch", 1, [["URL", rtl.string]], 4, rtl.word, 20);',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -31774,9 +31819,60 @@ begin
     '  this.$final = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '$r.addMethod("OpenArray", 0, [["Args", rtl.string, 10]]);',
-    '$r.addMethod("ByRef", 0, [["Value", rtl.longint, 1], ["Item", rtl.longint, 4]]);',
-    '$r.addMethod("Untyped", 0, [["Value", null, 1], ["Item", null, 4]]);',
+    '$r.addMethod("OpenArray", 0, [["Args", rtl.string, 10]], 4);',
+    '$r.addMethod("ByRef", 0, [["Value", rtl.longint, 1], ["Item", rtl.longint, 4]], 4);',
+    '$r.addMethod("Untyped", 0, [["Value", null, 1], ["Item", null, 4]], 4);',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_Class_MethodPrivate;
+begin
+  WithTypeInfo:=true;
+  StartProgram(false);
+  Add('type');
+  Add('{$RTTI explicit methods([vcPrivate,vcProtected,vcPublic,vcPublished])}');
+  Add('  TObject = class');
+  Add('  private');
+  Add('    procedure PrivateProc(a: word); virtual; abstract;');
+  Add('  protected');
+  Add('    class function ProtectedFunc: word; virtual; abstract;');
+  Add('  public');
+  Add('    class procedure PublicProc; virtual; abstract;');
+  Add('    constructor Create;');
+  Add('    destructor Destroy;');
+  Add('  published');
+  Add('    function PublishedProc: word; virtual; abstract;');
+  Add('  end;');
+  Add('constructor TObject.Create;');
+  Add('begin');
+  Add('end;');
+  Add('destructor TObject.Destroy;');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_Class_MethodPrivate',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '    return this;',
+    '  };',
+    '  this.Destroy = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addMethod("PrivateProc", 0, [["a", rtl.word]], 0);',
+    '  $r.addMethod("ProtectedFunc", 5, [], 1, rtl.word);',
+    '  $r.addMethod("PublicProc", 4, []);',
+    '  $r.addMethod("Create", 2, []);',
+    '  $r.addMethod("Destroy", 3, []);',
+    '  $r.addMethod("PublishedProc", 1, [], 4, rtl.word);',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -31822,26 +31918,28 @@ begin
     '  this.$final = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addProperty("ColorA", 0, rtl.longint, "FColor", "");',
-    '  $r.addProperty("ColorB", 0, rtl.longint, "", "FColor");',
-    '  $r.addProperty("ColorC", 3, rtl.longint, "GetColor", "SetColor");',
+    '  $r.addProperty("ColorA", 0, rtl.longint, "FColor", "", 4);',
+    '  $r.addProperty("ColorB", 0, rtl.longint, "", "FColor", 4);',
+    '  $r.addProperty("ColorC", 3, rtl.longint, "GetColor", "SetColor", 4);',
     '  $r.addProperty(',
     '    "ColorD",',
     '    8,',
     '    rtl.longint,',
     '    "FColor",',
     '    "FColor",',
+    '    4,',
     '    {',
     '      stored: "FColorStored"',
     '    }',
     '  );',
-    '  $r.addProperty("ExtSizeA", 0, rtl.longint, "$extSize", "$extSize");',
+    '  $r.addProperty("ExtSizeA", 0, rtl.longint, "$extSize", "$extSize", 4);',
     '  $r.addProperty(',
     '    "ExtSizeB",',
     '    11,',
     '    rtl.longint,',
     '    "$getSize",',
     '    "$setSize",',
+    '    4,',
     '    {',
     '      stored: "$extSizeStored"',
     '    }',
@@ -31852,6 +31950,7 @@ begin
     '    rtl.longint,',
     '    "$extSize",',
     '    "$extSize",',
+    '    4,',
     '    {',
     '      stored: "$getExtSizeStored"',
     '    }',
@@ -31889,8 +31988,69 @@ begin
     '  this.$final = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addProperty("Items", 3, $r, "GetItems", "SetItems");',
-    '  $r.addProperty("Values", 3, rtl.char, "GetValues", "SetValues");',
+    '  $r.addProperty("Items", 3, $r, "GetItems", "SetItems", 4);',
+    '  $r.addProperty("Values", 3, rtl.char, "GetValues", "SetValues", 4);',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestRTTI_Class_PropertyPrivate;
+begin
+  WithTypeInfo:=true;
+  StartProgram(false);
+  Add('type');
+  Add('{$RTTI explicit properties([vcPrivate,vcProtected,vcPublic,vcPublished])}');
+  Add('  TObject = class');
+  Add('  private');
+  Add('    FWord: word;');
+  Add('    function GetWord: word; virtual; abstract;');
+  Add('    procedure SetWord(Value: word); virtual; abstract;');
+  Add('    property PrivateWord: word read FWord write FWord;');
+  Add('  protected');
+  Add('    property ProtectedWord: word read FWord write SetWord;');
+  Add('  public');
+  Add('    property PublicWord: word read GetWord;');
+  Add('  published');
+  Add('    property PublishedWord: word read FWord;');
+  Add('  end;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestRTTI_Class_PropertyPrivate',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FWord = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addProperty(',
+    '    "PrivateWord",',
+    '    0,',
+    '    rtl.word,',
+    '    "FWord",',
+    '    "FWord",',
+    '    0',
+    '  );',
+    '  $r.addProperty(',
+    '    "ProtectedWord",',
+    '    2,',
+    '    rtl.word,',
+    '    "FWord",',
+    '    "SetWord",',
+    '    1',
+    '  );',
+    '  $r.addProperty("PublicWord", 1, rtl.word, "GetWord", "");',
+    '  $r.addProperty(',
+    '    "PublishedWord",',
+    '    0,',
+    '    rtl.word,',
+    '    "FWord",',
+    '    "",',
+    '    4',
+    '  );',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -31935,9 +32095,9 @@ begin
     '  this.$final = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addProperty("Color", 0, pas.unit1.$rtti["TColor"], "fColor", "");',
-    '  $r.addProperty("Alias", 0, pas.unit1.$rtti["TColor"], "fAlias", "");',
-    '  $r.addProperty("TypeAlias", 0, $mod.$rtti["TColorTypeAlias"], "fTypeAlias", "");',
+    '  $r.addProperty("Color", 0, pas.unit1.$rtti["TColor"], "fColor", "", 4);',
+    '  $r.addProperty("Alias", 0, pas.unit1.$rtti["TColor"], "fAlias", "", 4);',
+    '  $r.addProperty("TypeAlias", 0, $mod.$rtti["TColorTypeAlias"], "fTypeAlias", "", 4);',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -32003,7 +32163,7 @@ begin
     '  $mod.$rtti.$DynArray("TBird.Swarm$a", {',
     '    eltype: $r',
     '  });',
-    '  $r.addField("Swarm", $mod.$rtti["TBird.Swarm$a"]);',
+    '  $r.addField("Swarm", $mod.$rtti["TBird.Swarm$a"], 4);',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -32059,6 +32219,7 @@ begin
     '    rtl.boolean,',
     '    "FB",',
     '    "SetIntBool",',
+    '    4,',
     '    {',
     '      index: 1',
     '    }',
@@ -32069,6 +32230,7 @@ begin
     '    rtl.boolean,',
     '    "GetEnumBool",',
     '    "FB",',
+    '    4,',
     '    {',
     '      index: $mod.TEnum.blue',
     '    }',
@@ -32079,6 +32241,7 @@ begin
     '    rtl.boolean,',
     '    "GetStrIntBool",',
     '    "SetStrIntBool",',
+    '    4,',
     '    {',
     '      index: 2',
     '    }',
@@ -32120,25 +32283,27 @@ begin
     '  this.$final = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addProperty("BoolA", 0, rtl.boolean, "FB", "");',
-    '  $r.addProperty("BoolB", 4, rtl.boolean, "FB", "");',
+    '  $r.addProperty("BoolA", 0, rtl.boolean, "FB", "", 4);',
+    '  $r.addProperty("BoolB", 4, rtl.boolean, "FB", "", 4);',
     '  $r.addProperty(',
     '    "BoolC",',
     '    8,',
     '    rtl.boolean,',
     '    "FB",',
     '    "",',
+    '    4,',
     '    {',
     '      stored: "FB"',
     '    }',
     '  );',
-    '  $r.addProperty("BoolD", 0, rtl.boolean, "FB", "");',
+    '  $r.addProperty("BoolD", 0, rtl.boolean, "FB", "", 4);',
     '  $r.addProperty(',
     '    "BoolE",',
     '    12,',
     '    rtl.boolean,',
     '    "FB",',
     '    "",',
+    '    4,',
     '    {',
     '      stored: "IsBStored"',
     '    }',
@@ -32206,6 +32371,7 @@ begin
     '    rtl.boolean,',
     '    "FB",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: true',
     '    }',
@@ -32216,6 +32382,7 @@ begin
     '    rtl.boolean,',
     '    "FB",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: true',
     '    }',
@@ -32226,6 +32393,7 @@ begin
     '    rtl.boolean,',
     '    "FB",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: true',
     '    }',
@@ -32236,6 +32404,7 @@ begin
     '    rtl.longint,',
     '    "FI",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: 2',
     '    }',
@@ -32246,6 +32415,7 @@ begin
     '    rtl.longint,',
     '    "FI",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: 3',
     '    }',
@@ -32256,6 +32426,7 @@ begin
     '    $mod.$rtti["TEnum"],',
     '    "FE",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: $mod.TEnum.red',
     '    }',
@@ -32266,6 +32437,7 @@ begin
     '    $mod.$rtti["TEnum"],',
     '    "FE",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: $mod.TEnum.blue',
     '    }',
@@ -32329,6 +32501,7 @@ begin
     '    $mod.$rtti["TSet"],',
     '    "FSet",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: {}',
     '    }',
@@ -32339,6 +32512,7 @@ begin
     '    $mod.$rtti["TSet"],',
     '    "FSet",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: rtl.createSet($mod.TEnum.red)',
     '    }',
@@ -32349,6 +32523,7 @@ begin
     '    $mod.$rtti["TSet"],',
     '    "FSet",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)',
     '    }',
@@ -32359,6 +32534,7 @@ begin
     '    $mod.$rtti["TSet"],',
     '    "FSet",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: $mod.CSet',
     '    }',
@@ -32409,6 +32585,7 @@ begin
     '    $mod.$rtti["TRg"],',
     '    "FV",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: -1',
     '    }',
@@ -32455,11 +32632,12 @@ begin
     '    rtl.byte,',
     '    "FA",',
     '    "",',
+    '    4,',
     '    {',
     '      Default: 1',
     '    }',
     '  );',
-    '  $r.addProperty("B", 0, rtl.byte, "FB", "");',
+    '  $r.addProperty("B", 0, rtl.byte, "FB", "", 4);',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -32490,7 +32668,7 @@ begin
     '  this.$final = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addMethod("DoIt", 0, []);',
+    '  $r.addMethod("DoIt", 0, [], 4);',
     '});',
     'rtl.createClass(this, "TSky", this.TObject, function () {',
     '  this.DoIt = function () {',
@@ -32532,14 +32710,14 @@ begin
     '  this.DoIt = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addMethod("DoIt", 0, []);',
+    '  $r.addMethod("DoIt", 0, [], 4);',
     '});',
     'rtl.createClass(this, "TSky", this.TObject, function () {',
     '  this.DoIt = function () {',
     '    $mod.TObject.DoIt.call(this);',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addMethod("DoIt", 0, []);',
+    '  $r.addMethod("DoIt", 0, [], 4);',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -32572,11 +32750,11 @@ begin
     '  this.$final = function () {',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addProperty("Flag", 0, rtl.longint, "FFlag", "");',
+    '  $r.addProperty("Flag", 0, rtl.longint, "FFlag", "", 4);',
     '});',
     'rtl.createClass(this, "TSky", this.TObject, function () {',
     '  var $r = this.$rtti;',
-    '  $r.addProperty("Flag", 0, rtl.longint, "", "FFlag");',
+    '  $r.addProperty("Flag", 0, rtl.longint, "", "FFlag", 4);',
     '});',
     '']),
     LinesToStr([ // $mod.$main
@@ -32628,9 +32806,9 @@ begin
     '    $mod.TObject.$final.call(this);',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addField("FBridge", $mod.$rtti["TBridge"]);',
-    '  $r.addMethod("SetBridge", 0, [["Value", $mod.$rtti["TBridge"]]]);',
-    '  $r.addProperty("Bridge", 2, $mod.$rtti["TBridge"], "FBridge", "SetBridge");',
+    '  $r.addField("FBridge", $mod.$rtti["TBridge"], 4);',
+    '  $r.addMethod("SetBridge", 0, [["Value", $mod.$rtti["TBridge"]]], 4);',
+    '  $r.addProperty("Bridge", 2, $mod.$rtti["TBridge"], "FBridge", "SetBridge", 4);',
     '});',
     'rtl.createClass(this, "TBridge", this.TObject, function () {',
     '  this.$init = function () {',
@@ -32689,7 +32867,7 @@ begin
     '    this.C = undefined;',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addField("C", $mod.$rtti["TClass"]);',
+    '  $r.addField("C", $mod.$rtti["TClass"], 4);',
     '});',
     'this.$rtti.$Class("TFox");',
     'rtl.createClass(this, "TBird", this.TObject, function () {',
@@ -33571,8 +33749,8 @@ begin
     '    return Result;',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addMethod("GetItem", 1, [], rtl.longint);',
-    '  $r.addProperty("Item", 1, rtl.longint, "GetItem", "");',
+    '  $r.addMethod("GetItem", 1, [], 4, rtl.longint);',
+    '  $r.addProperty("Item", 1, rtl.longint, "GetItem", "", 4);',
     '});',
     'this.t = null;',
     '']),
@@ -33824,6 +34002,8 @@ begin
   '  TRec = record',
   '    [Tcustom,tcustom(14)]',
   '    Size: word;',
+  '    [Tcustom(15)]',
+  '    Width, Height: word;',
   '  end;',
   'constructor TObject.Create; begin end;',
   'constructor TCustomAttribute.Create(Id: word); begin end;',
@@ -33852,7 +34032,7 @@ begin
     '    this.FField = 0;',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addField("FField", rtl.word, {',
+    '  $r.addField("FField", rtl.word, 4, {',
     '    attr: [$mod.TCustomAttribute, "Create"]',
     '  });',
     '  $r.addProperty(',
@@ -33861,25 +34041,37 @@ begin
     '    rtl.word,',
     '    "FField",',
     '    "",',
+    '    4,',
     '    {',
     '      attr: [$mod.TCustomAttribute, "Create$1", [14]]',
     '    }',
     '  );',
-    '  $r.addMethod("Fly", 0, [], null, 0, {',
+    '  $r.addMethod(',
+    '    "Fly",',
+    '    0,',
+    '    [],',
+    '    4,',
+    '    null,',
+    '    0,',
+    '    {',
     '    attr: [$mod.TCustomAttribute, "Create$1", [15]]',
     '  });',
     '});',
     'rtl.recNewT(this, "TRec", function () {',
     '  this.Size = 0;',
+    '  this.Width = 0;',
+    '  this.Height = 0;',
     '  this.$eq = function (b) {',
-    '    return this.Size === b.Size;',
+    '    return (this.Size === b.Size) && (this.Width === b.Width) && (this.Height === b.Height);',
     '  };',
     '  this.$assign = function (s) {',
     '    this.Size = s.Size;',
+    '    this.Width = s.Width;',
+    '    this.Height = s.Height;',
     '    return this;',
     '  };',
     '  var $r = $mod.$rtti.$Record("TRec", {});',
-    '  $r.addField("Size", rtl.word, {',
+    '  $r.addField("Size", rtl.word, 2, {',
     '    attr: [',
     '        $mod.TCustomAttribute,',
     '        "Create",',
@@ -33888,6 +34080,10 @@ begin
     '        [14]',
     '      ]',
     '  });',
+    '  $r.addField("Width", rtl.word, 2, {',
+    '    attr: [$mod.TCustomAttribute, "Create$1", [15]]',
+    '  });',
+    '  $r.addField("Height", rtl.word);',
     '});',
     '']),
     LinesToStr([ // $mod.$main

packages/pastojs/tests/tcoptimizations.pas

@@ -108,6 +108,7 @@ type
     procedure TestWPO_ConstructorDefaultValueConst;
     procedure TestWPO_RTTI_PublishedField;
     procedure TestWPO_RTTI_TypeInfo;
+    procedure TestWPO_RTTI_PrivateField;
   end;
 
 implementation
@@ -1434,7 +1435,7 @@ begin
     '    $lt3.$create("Create");',
     '  };',
     '  var $r = this.$rtti;',
-    '  $r.addField("Bird", $mod.$rtti["TBird"]);',
+    '  $r.addField("Bird", $mod.$rtti["TBird"], 4);',
     '});',
     'rtl.createClass(this, "TBird", $lt4, function () {',
     '  $lt2 = this;',
@@ -2567,7 +2568,7 @@ begin
     '      this.PublishedB = undefined;',
     '    };',
     '    var $r = this.$rtti;',
-    '    $r.addField("PublishedB", $mod.$rtti["TArrB"]);',
+    '    $r.addField("PublishedB", $mod.$rtti["TArrB"], 4);',
     '  });',
     '  this.C = null;',
     '  $mod.$main = function () {',
@@ -2615,6 +2616,63 @@ begin
   CheckDiff('TestWPO_RTTI_TypeInfo',ExpectedSrc,ActualSrc);
 end;
 
+procedure TTestOptimizations.TestWPO_RTTI_PrivateField;
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  WithTypeInfo:=true;
+  StartProgram(true);
+  Add([
+  'type',
+  '  TArrA = array of char;',
+  '  TArrB = array of string;',
+  '  TArrC = array of word;',
+  '  {$RTTI explicit Fields([vcPrivate,vcProtected])}',
+  '  TObject = class',
+  '  private',
+  '    PrivateA: TArrA;',
+  '  protected',
+  '    ProtectedB: TArrB;',
+  '  public',
+  '    PublicC: TArrC;',
+  '  end;',
+  'var',
+  '  C: TObject;',
+  'begin',
+  '  if typeinfo(TObject)=nil then ;',
+  '']);
+  ConvertProgram;
+  ActualSrc:=ConvertJSModuleToString(JSModule);
+  ExpectedSrc:=LinesToStr([
+    'rtl.module("program", ["system"], function () {',
+    '  var $mod = this;',
+    '  this.$rtti.$DynArray("TArrA", {',
+    '    eltype: rtl.char',
+    '  });',
+    '  this.$rtti.$DynArray("TArrB", {',
+    '    eltype: rtl.string',
+    '  });',
+    '  rtl.createClass(this, "TObject", null, function () {',
+    '    this.$init = function () {',
+    '      this.PrivateA = [];',
+    '      this.ProtectedB = [];',
+    '    };',
+    '    this.$final = function () {',
+    '      this.PrivateA = undefined;',
+    '      this.ProtectedB = undefined;',
+    '    };',
+    '    var $r = this.$rtti;',
+    '    $r.addField("PrivateA", $mod.$rtti["TArrA"], 0);',
+    '    $r.addField("ProtectedB", $mod.$rtti["TArrB"], 1);',
+    '  });',
+    '  $mod.$main = function () {',
+    '    if ($mod.$rtti["TObject"] === null) ;',
+    '  };',
+    '});',
+    '']);
+  CheckDiff('TestWPO_RTTI_PrivateField',ExpectedSrc,ActualSrc);
+end;
+
 Initialization
   RegisterTests([TTestOptimizations]);
 end.

utils/pas2js/dist/rtl.js

@@ -1383,7 +1383,7 @@ var rtl = {
 
     // tTypeInfoStruct - base object for tTypeInfoClass, tTypeInfoRecord, tTypeInfoInterface
     var tis = newBaseTI("tTypeInfoStruct",0);
-    tis.$addMember = function(name,ancestor,options){
+    tis.$addMember = function(name,ancestor,vis,options){
       if (rtl.debug_rtti){
         if (!rtl.hasString(name) || (name.charAt()==='$')) throw 'invalid member "'+name+'", this="'+this.name+'"';
         if (!rtl.is(ancestor,rtl.tTypeMember)) throw 'invalid ancestor "'+ancestor+':'+ancestor.name+'", "'+this.name+'.'+name+'"';
@@ -1393,13 +1393,14 @@ var rtl = {
       t.name = name;
       this.members[name] = t;
       this.names.push(name);
+      t.visibility = vis?vis:2;
       if (rtl.isObject(options)){
         for (var key in options) if (options.hasOwnProperty(key)) t[key] = options[key];
       };
       return t;
     };
-    tis.addField = function(name,type,options){
-      var t = this.$addMember(name,rtl.tTypeMemberField,options);
+    tis.addField = function(name,type,vis,options){
+      var t = this.$addMember(name,rtl.tTypeMemberField,vis,options);
       if (rtl.debug_rtti){
         if (!rtl.is(type,rtl.tTypeInfo)) throw 'invalid type "'+type+'", "'+this.name+'.'+name+'"';
       };
@@ -1419,15 +1420,15 @@ var rtl = {
         };
       };
     };
-    tis.addMethod = function(name,methodkind,params,result,flags,options){
-      var t = this.$addMember(name,rtl.tTypeMemberMethod,options);
+    tis.addMethod = function(name,methodkind,params,vis,result,flags,options){
+      var t = this.$addMember(name,rtl.tTypeMemberMethod,vis,options);
       t.methodkind = methodkind;
       t.procsig = rtl.newTIProcSig(params,result,flags);
       this.methods.push(name);
       return t;
     };
-    tis.addProperty = function(name,flags,result,getter,setter,options){
-      var t = this.$addMember(name,rtl.tTypeMemberProperty,options);
+    tis.addProperty = function(name,flags,result,getter,setter,vis,options){
+      var t = this.$addMember(name,rtl.tTypeMemberProperty,vis,options);
       t.flags = flags;
       t.typeinfo = result;
       t.getter = getter;