Browse Source

pastojs: attributes

git-svn-id: trunk@41427 -
Mattias Gaertner 6 years ago
parent
commit
a532d1d8fb

+ 347 - 150
packages/pastojs/src/fppas2js.pp

@@ -681,6 +681,7 @@ type
     pbivnRTTIInt_MinValue,
     pbivnRTTIInt_MinValue,
     pbivnRTTIInt_OrdType,
     pbivnRTTIInt_OrdType,
     pbivnRTTILocal, // $r
     pbivnRTTILocal, // $r
+    pbivnRTTIMemberAttributes,
     pbivnRTTIMethodKind, // tTypeInfoMethodVar has methodkind
     pbivnRTTIMethodKind, // tTypeInfoMethodVar has methodkind
     pbivnRTTIPointer_RefType,
     pbivnRTTIPointer_RefType,
     pbivnRTTIProcFlags,
     pbivnRTTIProcFlags,
@@ -689,6 +690,7 @@ type
     pbivnRTTIPropIndex,
     pbivnRTTIPropIndex,
     pbivnRTTIPropStored,
     pbivnRTTIPropStored,
     pbivnRTTISet_CompType,
     pbivnRTTISet_CompType,
+    pbivnRTTITypeAttributes,
     pbivnSelf,
     pbivnSelf,
     pbivnTObjectDestroy,
     pbivnTObjectDestroy,
     pbivnWith,
     pbivnWith,
@@ -714,10 +716,10 @@ type
 
 
 const
 const
   Pas2JSBuiltInNames: array[TPas2JSBuiltInName] of string = (
   Pas2JSBuiltInNames: array[TPas2JSBuiltInName] of string = (
-    'arrayConcat', // rtl.arrayConcat
-    'arrayConcatN', // rtl.arrayConcatN
-    'arrayCopy', // rtl.arrayCopy
-    'arrayEq', // rtl.arrayEq
+    'arrayConcat', // rtl.arrayConcat    pbifnArray_Concat
+    'arrayConcatN', // rtl.arrayConcatN   pbifnArray_ConcatN
+    'arrayCopy', // rtl.arrayCopy      pbifnArray_Copy
+    'arrayEq', // rtl.arrayEq          pbifnArray_Equal
     'length', // rtl.length
     'length', // rtl.length
     'arraySetLength', // rtl.arraySetLength
     'arraySetLength', // rtl.arraySetLength
     '$clone',
     '$clone',
@@ -836,37 +838,39 @@ const
     'enumtype',
     'enumtype',
     'maxvalue',
     'maxvalue',
     'minvalue',
     'minvalue',
-    'ordtype',
-    '$r',
-    'methodkind',
-    'reftype',
-    'flags',
-    'procsig',
-    'Default',
-    'index',
-    'stored',
-    'comptype',
-    '$Self',
-    'tObjectDestroy', // rtl.tObjectDestroy
-    '$with',
-    '$a',
-    'NativeInt',
-    'tTypeInfo', // rtl.
-    'tTypeInfoClass', // rtl.
-    'tTypeInfoClassRef', // rtl.
-    'tTypeInfoDynArray', // rtl.
-    'tTypeInfoEnum', // rtl.
-    'tTypeInfoHelper', // rtl.
-    'tTypeInfoInteger', // rtl.
-    'tTypeInfoInterface', // rtl.
-    'tTypeInfoMethodVar', // rtl.
-    'tTypeInfoPointer', // rtl.
-    'tTypeInfoProcVar', // rtl.
-    'tTypeInfoRecord', // rtl.
-    'tTypeInfoRefToProcVar', // rtl.
-    'tTypeInfoSet', // rtl.
-    'tTypeInfoStaticArray', // rtl.
-    'NativeUInt'
+    'ordtype', // pbivnRTTIInt_OrdType
+    '$r', // pbivnRTTILocal
+    'attr', // pbivnRTTIMemberAttributes
+    'methodkind', // pbivnRTTIMethodKind
+    'reftype', // pbivnRTTIPointer_RefType
+    'flags', // pbivnRTTIProcFlags
+    'procsig', // pbivnRTTIProcVar_ProcSig
+    'Default', // pbivnRTTIPropDefault
+    'index', // pbivnRTTIPropIndex
+    'stored', // pbivnRTTIPropStored
+    'comptype', // pbivnRTTISet_CompType
+    'attr', // pbivnRTTITypeAttributes
+    '$Self', // pbivnSelf
+    'tObjectDestroy', // rtl.tObjectDestroy  pbivnTObjectDestroy
+    '$with', // pbivnWith
+    '$a', // pbitnAnonymousPostfix
+    'NativeInt', // pbitnIntDouble
+    'tTypeInfo', // pbitnTI
+    'tTypeInfoClass', // pbitnTIClass
+    'tTypeInfoClassRef', // pbitnTIClassRef
+    'tTypeInfoDynArray', // pbitnTIDynArray
+    'tTypeInfoEnum', // pbitnTIEnum
+    'tTypeInfoHelper', // pbitnTIHelper
+    'tTypeInfoInteger', // pbitnTIInteger
+    'tTypeInfoInterface', // pbitnTIInterface
+    'tTypeInfoMethodVar', // pbitnTIMethodVar
+    'tTypeInfoPointer', // pbitnTIPointer
+    'tTypeInfoProcVar', // pbitnTIProcVar
+    'tTypeInfoRecord', // pbitnTIRecord
+    'tTypeInfoRefToProcVar', // pbitnTIRefToProcVar
+    'tTypeInfoSet', // pbitnTISet
+    'tTypeInfoStaticArray', // pbitnTIStaticArray
+    'NativeUInt' // pbitnUIntDouble
     );
     );
 
 
   // reserved words, not usable as identifiers, not even as sub identifiers
   // reserved words, not usable as identifiers, not even as sub identifiers
@@ -1161,7 +1165,7 @@ const
     msExternalClass,
     msExternalClass,
     msTypeHelpers,
     msTypeHelpers,
     msArrayOperators,
     msArrayOperators,
-    msIgnoreAttributes,
+    msPrefixedAttributes,
     msOmitRTTI,
     msOmitRTTI,
     msMultipleScopeHelpers];
     msMultipleScopeHelpers];
 
 
@@ -1824,10 +1828,16 @@ type
       AContext: TConvertContext); virtual;
       AContext: TConvertContext); virtual;
     Function CreateRTTINewType(El: TPasType; const CallFuncName: string;
     Function CreateRTTINewType(El: TPasType; const CallFuncName: string;
       IsForward: boolean; AContext: TConvertContext; out ObjLit: TJSObjectLiteral): TJSCallExpression; virtual;
       IsForward: boolean; AContext: TConvertContext; out ObjLit: TJSObjectLiteral): TJSCallExpression; virtual;
-    Function CreateRTTIMemberField(V: TPasVariable; AContext: TConvertContext): TJSElement; virtual;
-    Function CreateRTTIMemberMethod(Proc: TPasProcedure; AContext: TConvertContext): TJSElement; virtual;
-    Function CreateRTTIMemberProperty(Prop: TPasProperty; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIAttributes(const Attr: TPasExprArray; PosEl: TPasElement; aContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIMemberField(Members: TFPList; Index: integer;
+      AContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIMemberMethod(Members: TFPList; Index: integer;
+      AContext: TConvertContext): TJSElement; virtual;
+    Function CreateRTTIMemberProperty(Members: TFPList; Index: integer;
+      AContext: TConvertContext): TJSElement; virtual;
     Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual;
     Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext); virtual;
+    Function CreateRTTIMembers(El: TPasMembersType; Src: TJSSourceElements;
+      FuncContext: TFunctionContext; RTTIExpr: TJSElement; NeedLocalVar: boolean): boolean; virtual;
     // create elements for interfaces
     // create elements for interfaces
     Procedure AddIntfDelegations(ClassEl: TPasElement; Prop: TPasProperty;
     Procedure AddIntfDelegations(ClassEl: TPasElement; Prop: TPasProperty;
       FinishedGUIDs: TStringList; ObjLit: TJSObjectLiteral; aContext: TFunctionContext);
       FinishedGUIDs: TStringList; ObjLit: TJSObjectLiteral; aContext: TFunctionContext);
@@ -12621,6 +12631,8 @@ begin
         AddResourceString(TPasResString(P));
         AddResourceString(TPasResString(P));
         continue;
         continue;
         end
         end
+      else if C=TPasAttributes then
+        // ToDo
       else
       else
         RaiseNotSupported(P as TPasElement,AContext,20161024191434);
         RaiseNotSupported(P as TPasElement,AContext,20161024191434);
       Add(E,P);
       Add(E,P);
@@ -12886,6 +12898,9 @@ begin
             continue
             continue
           else if C=TPasMethodResolution then
           else if C=TPasMethodResolution then
             continue
             continue
+          else if C=TPasAttributes then
+            // ToDo
+            continue
           else
           else
             RaiseNotSupported(P,FuncContext,20161221233338);
             RaiseNotSupported(P,FuncContext,20161221233338);
           if NewEl<>nil then
           if NewEl<>nil then
@@ -14969,65 +14984,24 @@ procedure TPasToJSConverter.CreateRecordRTTI(El: TPasRecordType;
 var
 var
   ObjLit: TJSObjectLiteral;
   ObjLit: TJSObjectLiteral;
   Call: TJSCallExpression;
   Call: TJSCallExpression;
-  ok: Boolean;
-  i: Integer;
-  P: TPasElement;
-  VarSt: TJSVariableStatement;
-  NewEl: TJSElement;
-  C: TClass;
+  HasRTTIMembers: Boolean;
 begin
 begin
-  ok:=false;
   Call:=nil;
   Call:=nil;
-  VarSt:=nil;
   try
   try
     // module.$rtti.$Record("typename",{});
     // module.$rtti.$Record("typename",{});
     Call:=CreateRTTINewType(El,GetBIName(pbifnRTTINewRecord),false,FuncContext,ObjLit);
     Call:=CreateRTTINewType(El,GetBIName(pbifnRTTINewRecord),false,FuncContext,ObjLit);
     if ObjLit=nil then
     if ObjLit=nil then
       RaiseInconsistency(20190105141430,El);
       RaiseInconsistency(20190105141430,El);
 
 
-    // add $r to local vars, to avoid name clashes and for nicer debugging
-    FuncContext.AddLocalVar(GetBIName(pbivnRTTILocal),nil);
-
-    For i:=0 to El.Members.Count-1 do
-      begin
-      P:=TPasElement(El.Members[i]);
-      if P.Visibility in [visPrivate,visStrictPrivate] then
-        continue;
-      if not IsElementUsed(P) then continue;
-      NewEl:=nil;
-      C:=P.ClassType;
-      if C=TPasVariable then
-        NewEl:=CreateRTTIMemberField(TPasVariable(P),FuncContext)
-      else if C.InheritsFrom(TPasProcedure) then
-        NewEl:=CreateRTTIMemberMethod(TPasProcedure(P),FuncContext)
-      else if C=TPasProperty then
-        NewEl:=CreateRTTIMemberProperty(TPasProperty(P),FuncContext)
-      else if C.InheritsFrom(TPasType) then
-        continue
-      else
-        DoError(20190105142236,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
-      if NewEl=nil then
-        continue; // e.g. abstract or external proc
-      // add RTTI element
-      if VarSt=nil then
-        begin
-        // add "var $r = module.$rtti.$Record..."
-        VarSt:=CreateVarStatement(GetBIName(pbivnRTTILocal),Call,El);
-        Call:=nil;
-        AddToSourceElements(Src,VarSt);
-        end;
-      AddToSourceElements(Src,NewEl);
-      end;
-    if Call<>nil then
+    HasRTTIMembers:=CreateRTTIMembers(El,Src,FuncContext,Call,false);
+    if not HasRTTIMembers then
       begin
       begin
       // no published members, add "module.$rtti.$Record..."
       // no published members, add "module.$rtti.$Record..."
       AddToSourceElements(Src,Call);
       AddToSourceElements(Src,Call);
-      Call:=nil;
       end;
       end;
 
 
-    ok:=true;
+    Call:=nil;
   finally
   finally
-    if not ok then
       Call.Free;
       Call.Free;
   end;
   end;
 end;
 end;
@@ -15620,61 +15594,37 @@ end;
 
 
 procedure TPasToJSConverter.AddClassRTTI(El: TPasClassType;
 procedure TPasToJSConverter.AddClassRTTI(El: TPasClassType;
   Src: TJSSourceElements; FuncContext: TFunctionContext);
   Src: TJSSourceElements; FuncContext: TFunctionContext);
-
-  function IsMemberNeeded(aMember: TPasElement): boolean;
-  begin
-    Result:=IsElementUsed(aMember);
-  end;
-
 var
 var
-  HasRTTIMembers: Boolean;
-  i: Integer;
-  P: TPasElement;
-  NewEl: TJSElement;
-  VarSt: TJSVariableStatement;
-  C: TClass;
+  HasRTTIMembers, NeedLocalVar: Boolean;
+  RTTIExpr, AttrJS: TJSElement;
+  Attr: TPasExprArray;
+  AssignSt: TJSAssignStatement;
 begin
 begin
-  // add $r to local vars, to avoid name clashes and for nicer debugging
-  FuncContext.AddLocalVar(GetBIName(pbivnRTTILocal),nil);
+  AttrJS:=nil;
+  // this.$rtti
+  RTTIExpr:=CreateMemberExpression(['this',GetBIName(pbivnRTTI)]);
+  try
+    Attr:=FuncContext.Resolver.GetAttributeCallsEl(El);
+    AttrJS:=CreateRTTIAttributes(Attr,El,FuncContext);
+    NeedLocalVar:=AttrJS<>nil;
 
 
-  HasRTTIMembers:=false;
-  For i:=0 to El.Members.Count-1 do
-    begin
-    P:=TPasElement(El.Members[i]);
-    //writeln('TPasToJSConverter.ConvertClassType RTTI El[',i,']=',GetObjName(P));
-    if El.ObjKind=okInterface then
-      // all interface methods are published
-    else if P.Visibility<>visPublished then
-      continue;
-    if not IsMemberNeeded(P) then continue;
-    NewEl:=nil;
-    C:=P.ClassType;
-    if C=TPasVariable then
-      NewEl:=CreateRTTIMemberField(TPasVariable(P),FuncContext)
-    else if C.InheritsFrom(TPasProcedure) then
-      NewEl:=CreateRTTIMemberMethod(TPasProcedure(P),FuncContext)
-    else if C=TPasProperty then
-      NewEl:=CreateRTTIMemberProperty(TPasProperty(P),FuncContext)
-    else if C.InheritsFrom(TPasType) then
-      continue
-    else if C=TPasMethodResolution then
-      continue
-    else
-      DoError(20170409202315,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
-    if NewEl=nil then
-      continue; // e.g. abstract or external proc
-    // add RTTI element
-    if not HasRTTIMembers then
-      begin
-      // add "var $r = this.$rtti"
-      VarSt:=CreateVarStatement(GetBIName(pbivnRTTILocal),
-        CreateMemberExpression(['this',GetBIName(pbivnRTTI)]),El);
-      AddToSourceElements(Src,VarSt);
+    HasRTTIMembers:=CreateRTTIMembers(El,Src,FuncContext,RTTIExpr,NeedLocalVar);
+    if HasRTTIMembers then
+      RTTIExpr:=nil;
 
 
-      HasRTTIMembers:=true;
+    if AttrJS<>nil then
+      begin
+      // $r.attr = [];
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      AddToSourceElements(Src,AssignSt);
+      AssignSt.LHS:=CreateMemberExpression([GetBIName(pbivnRTTILocal),GetBIName(pbivnRTTITypeAttributes)]);
+      AssignSt.Expr:=AttrJS;
+      AttrJS:=nil;
       end;
       end;
-    AddToSourceElements(Src,NewEl);
-    end;
+  finally
+    AttrJS.Free;
+    RTTIExpr.Free;
+  end;
 end;
 end;
 
 
 procedure TPasToJSConverter.AddClassConstructors(FuncContext: TFunctionContext;
 procedure TPasToJSConverter.AddClassConstructors(FuncContext: TFunctionContext;
@@ -16402,9 +16352,15 @@ var
   RttiPath, TypeName: String;
   RttiPath, TypeName: String;
   Call: TJSCallExpression;
   Call: TJSCallExpression;
   aModule: TPasModule;
   aModule: TPasModule;
+  aResolver: TPas2JSResolver;
+  Attr: TPasExprArray;
+  AttrJS: TJSElement;
+  ObjLitEl: TJSObjectLiteralElement;
 begin
 begin
   Result:=nil;
   Result:=nil;
   ObjLit:=nil;
   ObjLit:=nil;
+
+  aResolver:=AContext.Resolver;
   // get module path
   // get module path
   aModule:=El.GetModule;
   aModule:=El.GetModule;
   if aModule=nil then
   if aModule=nil then
@@ -16430,7 +16386,18 @@ begin
       // add {}
       // add {}
       ObjLit:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
       ObjLit:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
       Call.AddArg(ObjLit);
       Call.AddArg(ObjLit);
+
+      Attr:=aResolver.GetAttributeCallsEl(El);
+      AttrJS:=CreateRTTIAttributes(Attr,El,AContext);
+      if AttrJS<>nil then
+        begin
+        // attr: [...]
+        ObjLitEl:=ObjLit.Elements.AddElement;
+        ObjLitEl.Name:=TJSString(GetBIName(pbivnRTTITypeAttributes));
+        ObjLitEl.Expr:=AttrJS;
+        end;
       end;
       end;
+
     Result:=Call;
     Result:=Call;
   finally
   finally
     if Result=nil then
     if Result=nil then
@@ -16438,36 +16405,164 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TPasToJSConverter.CreateRTTIMemberField(V: TPasVariable;
-  AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.CreateRTTIAttributes(const Attr: TPasExprArray;
+  PosEl: TPasElement; aContext: TConvertContext): TJSElement;
+// create [Attr1Class,'Attr1ProcName',[Attr1Params],...]
+var
+  AttrArrayLit, ParamsArrayLit: TJSArrayLiteral;
+  i, j: Integer;
+  Expr, ParamExpr: TPasExpr;
+  aResolver: TPas2JSResolver;
+  Ref: TResolvedReference;
+  AttrClass, ConstrParent: TPasClassType;
+  aConstructor: TPasConstructor;
+  aName: String;
+  Params: TPasExprArray;
+  Value: TResEvalValue;
+  JSExpr: TJSElement;
+begin
+  Result:=nil;
+  aResolver:=aContext.Resolver;
+  AttrArrayLit:=nil;
+  try
+    for i:=0 to length(Attr)-1 do
+      begin
+      Expr:=Attr[i];
+      if Expr is TParamsExpr then
+        Expr:=TParamsExpr(Expr).Value;
+      if (Expr is TBinaryExpr) and (TBinaryExpr(Expr).OpCode=eopSubIdent) then
+        Expr:=TBinaryExpr(Expr).right;
+      if not aResolver.IsNameExpr(Expr) then
+        RaiseNotSupported(Expr,aContext,20190222182742,GetObjName(Expr));
+      // attribute class
+      Ref:=Expr.CustomData as TResolvedReference;
+      if Ref=nil then
+        // unknown attribute -> silently skip (delphi 10.3 compatible)
+        continue;
+      AttrClass:=Ref.Declaration as TPasClassType;
+      if AttrClass.IsAbstract then
+        continue; // silently skip abstract class (Delphi 10.3 compatible)
+      // attribute constructor name as string
+      if not (Ref.Context is TResolvedRefCtxAttrProc) then
+        RaiseNotSupported(Expr,aContext,20190223085831,GetObjName(Expr));
+      aConstructor:=TResolvedRefCtxAttrProc(Ref.Context).Proc;
+      if aConstructor.IsAbstract then
+        continue; // silently skip abstract method (Delphi 10.3 compatible)
+      ConstrParent:=aConstructor.Parent as TPasClassType;
+      if ConstrParent.HelperForType<>nil then
+        aResolver.RaiseMsg(20190223220134,nXExpectedButYFound,sXExpectedButYFound,
+          ['class method','helper method'],Expr);
+      aName:=TransformVariableName(aConstructor,aContext);
+
+      if AttrArrayLit=nil then
+        AttrArrayLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,PosEl));
+
+      // add class reference  pas.system.TCustomAttribute
+      AttrArrayLit.AddElement(CreateReferencePathExpr(AttrClass,aContext));
+      // add constructor name 'Create$1'
+      AttrArrayLit.AddElement(CreateLiteralString(PosEl,aName));
+      // add attribute params as [] if needed
+      ParamsArrayLit:=nil;
+      Expr:=Attr[i];
+      if Expr is TParamsExpr then
+        begin
+        Params:=TParamsExpr(Expr).Params;
+        for j:=0 to length(Params)-1 do
+          begin
+          ParamExpr:=Params[j];
+          Value:=aResolver.Eval(ParamExpr,[]);
+          if Value<>nil then
+            try
+              JSExpr:=ConvertConstValue(Value,aContext,PosEl);
+            finally
+              ReleaseEvalValue(Value);
+            end
+          else
+            JSExpr:=ConvertExpression(ParamExpr,aContext);
+          if ParamsArrayLit=nil then
+            begin
+            ParamsArrayLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,PosEl));
+            AttrArrayLit.AddElement(ParamsArrayLit);
+            end;
+          ParamsArrayLit.AddElement(JSExpr);
+          end;
+        end;
+      end;
+    Result:=AttrArrayLit;
+  finally
+    if Result=nil then
+      AttrArrayLit.Free;
+  end;
+end;
+
+function TPasToJSConverter.CreateRTTIMemberField(Members: TFPList;
+  Index: integer; AContext: TConvertContext): TJSElement;
 // create $r.addField("varname",typeinfo);
 // create $r.addField("varname",typeinfo);
+// create $r.addField("varname",typeinfo,options);
 var
 var
+  V: TPasVariable;
   Call: TJSCallExpression;
   Call: TJSCallExpression;
+  OptionsEl: TJSObjectLiteral;
+
+  procedure AddOption(const aName: String; JS: TJSElement);
+  var
+    ObjLit: TJSObjectLiteralElement;
+  begin
+    if JS=nil then exit;
+    if OptionsEl=nil then
+      begin
+      OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,V));
+      Call.AddArg(OptionsEl);
+      end;
+    ObjLit:=OptionsEl.Elements.AddElement;
+    ObjLit.Name:=TJSString(aName);
+    ObjLit.Expr:=JS;
+  end;
+
 var
 var
   JSTypeInfo: TJSElement;
   JSTypeInfo: TJSElement;
   aName: String;
   aName: String;
+  aResolver: TPas2JSResolver;
+  Attr: TPasExprArray;
 begin
 begin
   Result:=nil;
   Result:=nil;
+  aResolver:=AContext.Resolver;
+  V:=TPasVariable(Members[Index]);
   if (V.VarType<>nil) and (V.VarType.Name='') then
   if (V.VarType<>nil) and (V.VarType.Name='') then
     CreateRTTIAnonymous(V.VarType,AContext);
     CreateRTTIAnonymous(V.VarType,AContext);
 
 
   JSTypeInfo:=CreateTypeInfoRef(V.VarType,AContext,V);
   JSTypeInfo:=CreateTypeInfoRef(V.VarType,AContext,V);
+  OptionsEl:=nil;
   // Note: create JSTypeInfo first, it may raise an exception
   // Note: create JSTypeInfo first, it may raise an exception
   Call:=CreateCallExpression(V);
   Call:=CreateCallExpression(V);
-  // $r.addField
-  Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTTILocal),GetBIName(pbifnRTTIAddField)]);
-  // param "varname"
-  aName:=TransformVariableName(V,AContext);
-  Call.AddArg(CreateLiteralString(V,aName));
-  // param typeinfo
-  Call.AddArg(JSTypeInfo);
-  Result:=Call;
+  try
+    // $r.addField
+    Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTTILocal),GetBIName(pbifnRTTIAddField)]);
+    // param "varname"
+    aName:=TransformVariableName(V,AContext);
+    Call.AddArg(CreateLiteralString(V,aName));
+    // param typeinfo
+    Call.AddArg(JSTypeInfo);
+
+    // param options if needed as {}
+    // option: attributes
+    Attr:=aResolver.GetAttributeCalls(Members,Index);
+    if length(Attr)>0 then
+      AddOption(GetBIName(pbivnRTTIMemberAttributes),
+                CreateRTTIAttributes(Attr,V,AContext));
+
+    Result:=Call;
+    Call:=nil;
+  finally
+    Call.Free;
+  end;
 end;
 end;
 
 
-function TPasToJSConverter.CreateRTTIMemberMethod(Proc: TPasProcedure;
-  AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.CreateRTTIMemberMethod(Members: TFPList;
+  Index: integer; AContext: TConvertContext): TJSElement;
 // create $r.addMethod("funcname",methodkind,params,resulttype,options)
 // create $r.addMethod("funcname",methodkind,params,resulttype,options)
 var
 var
+  Proc: TPasProcedure;
   OptionsEl: TJSObjectLiteral;
   OptionsEl: TJSObjectLiteral;
   ResultTypeInfo: TJSElement;
   ResultTypeInfo: TJSElement;
   Call: TJSCallExpression;
   Call: TJSCallExpression;
@@ -16476,6 +16571,7 @@ var
   var
   var
     ObjLit: TJSObjectLiteralElement;
     ObjLit: TJSObjectLiteralElement;
   begin
   begin
+    if JS=nil then exit;
     if OptionsEl=nil then
     if OptionsEl=nil then
       begin
       begin
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Proc));
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Proc));
@@ -16495,8 +16591,12 @@ var
   ResultEl: TPasResultElement;
   ResultEl: TPasResultElement;
   ProcScope, OverriddenProcScope: TPasProcedureScope;
   ProcScope, OverriddenProcScope: TPasProcedureScope;
   OverriddenClass: TPasClassType;
   OverriddenClass: TPasClassType;
+  aResolver: TPas2JSResolver;
+  Attr: TPasExprArray;
 begin
 begin
   Result:=nil;
   Result:=nil;
+  Proc:=TPasProcedure(Members[Index]);
+  aResolver:=AContext.Resolver;
   if Proc.IsOverride then
   if Proc.IsOverride then
     begin
     begin
     ProcScope:=Proc.CustomData as TPasProcedureScope;
     ProcScope:=Proc.CustomData as TPasProcedureScope;
@@ -16564,6 +16664,10 @@ begin
       inc(Flags,pfExternal);
       inc(Flags,pfExternal);
     if Flags>0 then
     if Flags>0 then
       AddOption(GetBIName(pbivnRTTIProcFlags),CreateLiteralNumber(Proc,Flags));
       AddOption(GetBIName(pbivnRTTIProcFlags),CreateLiteralNumber(Proc,Flags));
+    Attr:=aResolver.GetAttributeCalls(Members,Index);
+    if length(Attr)>0 then
+      AddOption(GetBIName(pbivnRTTIMemberAttributes),
+                CreateRTTIAttributes(Attr,Proc,AContext));
 
 
     Result:=Call;
     Result:=Call;
   finally
   finally
@@ -16572,10 +16676,11 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TPasToJSConverter.CreateRTTIMemberProperty(Prop: TPasProperty;
-  AContext: TConvertContext): TJSElement;
+function TPasToJSConverter.CreateRTTIMemberProperty(Members: TFPList;
+  Index: integer; AContext: TConvertContext): TJSElement;
 // create  $r.addProperty("propname",flags,result,"getter","setter",{options})
 // create  $r.addProperty("propname",flags,result,"getter","setter",{options})
 var
 var
+  Prop: TPasProperty;
   Call: TJSCallExpression;
   Call: TJSCallExpression;
   OptionsEl: TJSObjectLiteral;
   OptionsEl: TJSObjectLiteral;
 
 
@@ -16588,6 +16693,7 @@ var
   var
   var
     ObjLit: TJSObjectLiteralElement;
     ObjLit: TJSObjectLiteralElement;
   begin
   begin
+    if JS=nil then exit;
     if OptionsEl=nil then
     if OptionsEl=nil then
       begin
       begin
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Prop));
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Prop));
@@ -16608,8 +16714,10 @@ var
   StoredResolved, VarTypeResolved: TPasResolverResult;
   StoredResolved, VarTypeResolved: TPasResolverResult;
   StoredValue, PasValue, IndexValue: TResEvalValue;
   StoredValue, PasValue, IndexValue: TResEvalValue;
   aResolver: TPas2JSResolver;
   aResolver: TPas2JSResolver;
+  Attr: TPasExprArray;
 begin
 begin
   Result:=nil;
   Result:=nil;
+  Prop:=TPasProperty(Members[Index]);
   aResolver:=AContext.Resolver;
   aResolver:=AContext.Resolver;
   OptionsEl:=nil;
   OptionsEl:=nil;
   try
   try
@@ -16726,6 +16834,12 @@ begin
       end;
       end;
       end;
       end;
 
 
+    // add option "attr"
+    Attr:=aResolver.GetAttributeCalls(Members,Index);
+    if length(Attr)>0 then
+      AddOption(GetBIName(pbivnRTTIMemberAttributes),
+        CreateRTTIAttributes(Attr,Prop,AContext));
+
     Result:=Call;
     Result:=Call;
   finally
   finally
     if Result=nil then
     if Result=nil then
@@ -16764,6 +16878,89 @@ begin
     end;
     end;
 end;
 end;
 
 
+function TPasToJSConverter.CreateRTTIMembers(El: TPasMembersType;
+  Src: TJSSourceElements; FuncContext: TFunctionContext; RTTIExpr: TJSElement;
+  NeedLocalVar: boolean): boolean;
+type
+  TMemberType = (
+    mtClass,
+    mtInterface,
+    mtRecord
+    );
+
+  procedure CreateLocalvar;
+  var
+    VarSt: TJSVariableStatement;
+  begin
+    if Result then exit;
+    // add "var $r = module.$rtti.$Record..."
+    Result:=true;
+    VarSt:=CreateVarStatement(GetBIName(pbivnRTTILocal),RTTIExpr,El);
+    AddToSourceElements(Src,VarSt);
+  end;
+
+var
+  mt: TMemberType;
+  i: integer;
+  P: TPasElement;
+  C: TClass;
+  NewEl: TJSElement;
+  Members: TFPList;
+begin
+  Result:=false;
+  if El.ClassType=TPasRecordType then
+    mt:=mtRecord
+  else if El.ClassType=TPasClassType then
+    case TPasClassType(El).ObjKind of
+    okInterface: mt:=mtInterface;
+    else mt:=mtClass;
+    end
+  else
+    RaiseNotSupported(El,FuncContext,20190223211808,GetObjName(El));
+
+  // add $r to local vars, to avoid name clashes and for nicer debugging
+  FuncContext.AddLocalVar(GetBIName(pbivnRTTILocal),nil);
+
+  if NeedLocalVar then
+    CreateLocalvar;
+
+  Members:=El.Members;
+  For i:=0 to Members.Count-1 do
+    begin
+    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,FuncContext)
+    else if C.InheritsFrom(TPasProcedure) then
+      NewEl:=CreateRTTIMemberMethod(Members,i,FuncContext)
+    else if C=TPasProperty then
+      NewEl:=CreateRTTIMemberProperty(Members,i,FuncContext)
+    else if C.InheritsFrom(TPasType)
+        or (C=TPasAttributes) then
+    else
+      DoError(20190105142236,nSymbolCannotBePublished,sSymbolCannotBePublished,[],P);
+    if NewEl=nil then
+      continue; // e.g. abstract or external proc
+    // add RTTI element
+    if not Result then
+      CreateLocalvar;
+    AddToSourceElements(Src,NewEl);
+    end;
+end;
+
 procedure TPasToJSConverter.AddIntfDelegations(ClassEl: TPasElement;
 procedure TPasToJSConverter.AddIntfDelegations(ClassEl: TPasElement;
   Prop: TPasProperty; FinishedGUIDs: TStringList; ObjLit: TJSObjectLiteral;
   Prop: TPasProperty; FinishedGUIDs: TStringList; ObjLit: TJSObjectLiteral;
   aContext: TFunctionContext);
   aContext: TFunctionContext);
@@ -17395,7 +17592,6 @@ var
     List: TJSStatementList;
     List: TJSStatementList;
   begin
   begin
     RgCheck:=nil;
     RgCheck:=nil;
-    writeln('AAA1 CreateRefObj SetExpr=',GetObjName(SetExpr),' SetterArgName=',SetterArgName,' ',bsRangeChecks in AContext.ScannerBoolSwitches);
     if (SetExpr is TJSSimpleAssignStatement)
     if (SetExpr is TJSSimpleAssignStatement)
         and (SetterArgName<>'')
         and (SetterArgName<>'')
         and (bsRangeChecks in AContext.ScannerBoolSwitches) then
         and (bsRangeChecks in AContext.ScannerBoolSwitches) then
@@ -22044,8 +22240,9 @@ begin
                 and not aResolver.MethodIsStatic(TPasProcedure(P))) then
                 and not aResolver.MethodIsStatic(TPasProcedure(P))) then
             IsFull:=true; // needs $record
             IsFull:=true; // needs $record
           end;
           end;
-        continue;
         end
         end
+      else if C=TPasAttributes then
+        // ToDo
       else
       else
         RaiseNotSupported(P,FuncContext,20190105105436);
         RaiseNotSupported(P,FuncContext,20190105105436);
       if NewEl<>nil then
       if NewEl<>nil then

+ 88 - 6
packages/pastojs/src/pas2jsfiler.pp

@@ -71,7 +71,7 @@ uses
 
 
 const
 const
   PCUMagic = 'Pas2JSCache';
   PCUMagic = 'Pas2JSCache';
-  PCUVersion = 4;
+  PCUVersion = 5;
   { Version Changes:
   { Version Changes:
     1: initial version
     1: initial version
     2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
     2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
@@ -80,6 +80,7 @@ const
     3: changed records from function to objects (pas2js 1.3)
     3: changed records from function to objects (pas2js 1.3)
     4: precompiled JS of initialization section now only contains the statements,
     4: precompiled JS of initialization section now only contains the statements,
        not the whole $init function (pas2js 1.5)
        not the whole $init function (pas2js 1.5)
+    5: removed modeswitch ignoreattributes
   }
   }
 
 
   BuiltInNodeName = 'BuiltIn';
   BuiltInNodeName = 'BuiltIn';
@@ -170,10 +171,9 @@ const
     'ArrayOperators',
     'ArrayOperators',
     'ExternalClass',
     'ExternalClass',
     'PrefixedAttributes',
     'PrefixedAttributes',
-    'IgnoreAttributes',
     'OmitRTTI',
     'OmitRTTI',
     'MultipleScopeHelpers'
     'MultipleScopeHelpers'
-    );
+    ); // Dont forget to update ModeSwitchToInt !
 
 
   PCUDefaultBoolSwitches: TBoolSwitches = [
   PCUDefaultBoolSwitches: TBoolSwitches = [
     bsHints,
     bsHints,
@@ -780,6 +780,7 @@ type
     procedure WriteProcedureScope(Obj: TJSONObject; Scope: TPas2JSProcedureScope; aContext: TPCUWriterContext); virtual;
     procedure WriteProcedureScope(Obj: TJSONObject; Scope: TPas2JSProcedureScope; aContext: TPCUWriterContext); virtual;
     procedure WriteProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUWriterContext); virtual;
     procedure WriteProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUWriterContext); virtual;
     procedure WriteOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUWriterContext); virtual;
     procedure WriteOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUWriterContext); virtual;
+    procedure WriteAttributes(Obj: TJSONObject; El: TPasAttributes; aContext: TPCUWriterContext); virtual;
     procedure WriteExtRefSignature(Ref: TPCUFilerElementRef; aContext: TPCUWriterContext); virtual;
     procedure WriteExtRefSignature(Ref: TPCUFilerElementRef; aContext: TPCUWriterContext); virtual;
     function WriteExternalReference(El: TPasElement; aContext: TPCUWriterContext): TPCUFilerElementRef; virtual;
     function WriteExternalReference(El: TPasElement; aContext: TPCUWriterContext): TPCUFilerElementRef; virtual;
     procedure WriteExternalReferences(aContext: TPCUWriterContext); virtual;
     procedure WriteExternalReferences(aContext: TPCUWriterContext); virtual;
@@ -869,6 +870,8 @@ type
     procedure Set_ProcedureScope_ImplProc(RefEl: TPasElement; Data: TObject);
     procedure Set_ProcedureScope_ImplProc(RefEl: TPasElement; Data: TObject);
     procedure Set_ProcedureScope_Overridden(RefEl: TPasElement; Data: TObject);
     procedure Set_ProcedureScope_Overridden(RefEl: TPasElement; Data: TObject);
     procedure Set_ResolvedReference_Declaration(RefEl: TPasElement; Data: TObject);
     procedure Set_ResolvedReference_Declaration(RefEl: TPasElement; Data: TObject);
+    procedure Set_ResolvedReference_CtxConstructor(RefEl: TPasElement; Data: TObject);
+    procedure Set_ResolvedReference_CtxAttrProc(RefEl: TPasElement; Data: TObject);
   protected
   protected
     procedure RaiseMsg(Id: int64; const Msg: string = ''); overload; override;
     procedure RaiseMsg(Id: int64; const Msg: string = ''); overload; override;
     function CheckJSONArray(Data: TJSONData; El: TPasElement; const PropName: string): TJSONArray;
     function CheckJSONArray(Data: TJSONData; El: TPasElement; const PropName: string): TJSONArray;
@@ -994,6 +997,7 @@ type
     procedure ReadProcedureBody(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
     procedure ReadProcedureBody(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
     procedure ReadProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
     procedure ReadProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
     procedure ReadOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUReaderContext); virtual;
     procedure ReadOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUReaderContext); virtual;
+    procedure ReadAttributes(Obj: TJSONObject; El: TPasAttributes; aContext: TPCUReaderContext); virtual;
     procedure ResolvePending; virtual;
     procedure ResolvePending; virtual;
     procedure ReadBuiltInSymbols(Obj: TJSONObject; ErrorEl: TPasElement); virtual;
     procedure ReadBuiltInSymbols(Obj: TJSONObject; ErrorEl: TPasElement); virtual;
   public
   public
@@ -1388,7 +1392,9 @@ begin
     msExternalClass: Result:=44;
     msExternalClass: Result:=44;
     msPrefixedAttributes: Result:=45;
     msPrefixedAttributes: Result:=45;
     // msIgnoreInterfaces: Result:=46;
     // msIgnoreInterfaces: Result:=46;
-    msIgnoreAttributes: Result:=47;
+    // msIgnoreAttributes: Result:=47;
+    msOmitRTTI: Result:=48;
+    msMultipleScopeHelpers: Result:=49;
   end;
   end;
 end;
 end;
 
 
@@ -2790,6 +2796,8 @@ begin
     pekArrayParams: Obj.Add('Type','A[]');
     pekArrayParams: Obj.Add('Type','A[]');
     pekFuncParams: Obj.Add('Type','F()');
     pekFuncParams: Obj.Add('Type','F()');
     pekSet: Obj.Add('Type','[]');
     pekSet: Obj.Add('Type','[]');
+    else
+      RaiseMsg(20190222012727,El,ExprKindNames[TParamsExpr(El).Kind]);
     end;
     end;
     WriteParamsExpr(Obj,TParamsExpr(El),aContext);
     WriteParamsExpr(Obj,TParamsExpr(El),aContext);
     end
     end
@@ -2966,6 +2974,11 @@ begin
       RaiseMsg(20180210130202,El);
       RaiseMsg(20180210130202,El);
     WriteProcedure(Obj,TPasProcedure(El),aContext);
     WriteProcedure(Obj,TPasProcedure(El),aContext);
     end
     end
+  else if C=TPasAttributes then
+    begin
+    Obj.Add('Type','Attributes');
+    WriteAttributes(Obj,TPasAttributes(El),aContext);
+    end
   else
   else
     begin
     begin
     {$IFDEF VerbosePCUFiler}
     {$IFDEF VerbosePCUFiler}
@@ -3019,6 +3032,8 @@ end;
 
 
 procedure TPCUWriter.WriteResolvedReference(Obj: TJSONObject;
 procedure TPCUWriter.WriteResolvedReference(Obj: TJSONObject;
   Ref: TResolvedReference; ErrorEl: TPasElement);
   Ref: TResolvedReference; ErrorEl: TPasElement);
+var
+  Ctx: TResolvedRefContext;
 begin
 begin
   WriteResolvedRefFlags(Obj,'RefFlags',Ref.Flags,[]);
   WriteResolvedRefFlags(Obj,'RefFlags',Ref.Flags,[]);
   if Ref.Access<>rraRead then
   if Ref.Access<>rraRead then
@@ -3026,7 +3041,23 @@ begin
   if Ref.WithExprScope<>nil then
   if Ref.WithExprScope<>nil then
     RaiseMsg(20180215132828,ErrorEl);
     RaiseMsg(20180215132828,ErrorEl);
   if Ref.Context<>nil then
   if Ref.Context<>nil then
-    RaiseMsg(20180215132849,ErrorEl,GetObjName(Ref.Context));
+    begin
+    Ctx:=Ref.Context;
+    if Ctx.ClassType=TResolvedRefCtxConstructor then
+      begin
+      if TResolvedRefCtxConstructor(Ctx).Typ=nil then
+        RaiseMsg(20190222011342,ErrorEl);
+      AddReferenceToObj(Obj,'RefConstructorType',TResolvedRefCtxConstructor(Ctx).Typ);
+      end
+    else if Ctx.ClassType=TResolvedRefCtxAttrProc then
+      begin
+      if TResolvedRefCtxAttrProc(Ctx).Proc=nil then
+        RaiseMsg(20190222011427,ErrorEl);
+      AddReferenceToObj(Obj,'RefAttrProc',TResolvedRefCtxAttrProc(Ctx).Proc);
+      end
+    else
+      RaiseMsg(20180215132849,ErrorEl,GetObjName(Ref.Context));
+    end;
   AddReferenceToObj(Obj,'RefDecl',Ref.Declaration);
   AddReferenceToObj(Obj,'RefDecl',Ref.Declaration);
 end;
 end;
 
 
@@ -3806,6 +3837,13 @@ begin
     Obj.Add('TokenBased',El.TokenBased);
     Obj.Add('TokenBased',El.TokenBased);
 end;
 end;
 
 
+procedure TPCUWriter.WriteAttributes(Obj: TJSONObject; El: TPasAttributes;
+  aContext: TPCUWriterContext);
+begin
+  WritePasElement(Obj,El,aContext);
+  WritePasExprArray(Obj,El,'Calls',El.Calls,aContext);
+end;
+
 procedure TPCUWriter.WriteExtRefSignature(Ref: TPCUFilerElementRef;
 procedure TPCUWriter.WriteExtRefSignature(Ref: TPCUFilerElementRef;
   aContext: TPCUWriterContext);
   aContext: TPCUWriterContext);
 
 
@@ -4485,6 +4523,28 @@ begin
   Ref.Declaration:=RefEl;
   Ref.Declaration:=RefEl;
 end;
 end;
 
 
+procedure TPCUReader.Set_ResolvedReference_CtxConstructor(RefEl: TPasElement;
+  Data: TObject);
+var
+  Ref: TResolvedReference absolute Data;
+begin
+  if RefEl is TPasType then
+    TResolvedRefCtxConstructor(Ref.Context).Typ:=TPasType(RefEl) // no AddRef
+  else
+    RaiseMsg(20190222010314,Ref.Element,GetObjName(RefEl));
+end;
+
+procedure TPCUReader.Set_ResolvedReference_CtxAttrProc(RefEl: TPasElement;
+  Data: TObject);
+var
+  Ref: TResolvedReference absolute Data;
+begin
+  if RefEl is TPasConstructor then
+    TResolvedRefCtxAttrProc(Ref.Context).Proc:=TPasConstructor(RefEl) // no AddRef
+  else
+    RaiseMsg(20190222010821,Ref.Element,GetObjName(RefEl));
+end;
+
 procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string);
 procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string);
 var
 var
   E: EPas2JsReadError;
   E: EPas2JsReadError;
@@ -4906,7 +4966,7 @@ begin
         end;
         end;
     if not Found then
     if not Found then
       begin
       begin
-      if (FileVersion<2) and (SameText(s,'ignoreinterfaces')) then
+      if (FileVersion<5) and (SameText(s,'ignoreinterfaces')) then
         // ignore old switch
         // ignore old switch
       else
       else
         RaiseMsg(20180202144054,El,'unknown ModeSwitch "'+s+'"');
         RaiseMsg(20180202144054,El,'unknown ModeSwitch "'+s+'"');
@@ -5786,6 +5846,11 @@ begin
     'ClassDestructor': ReadProc(TPasClassDestructor,Name);
     'ClassDestructor': ReadProc(TPasClassDestructor,Name);
     'Operator': ReadOper(TPasConstructor,Name);
     'Operator': ReadOper(TPasConstructor,Name);
     'ClassOperator': ReadOper(TPasClassConstructor,Name);
     'ClassOperator': ReadOper(TPasClassConstructor,Name);
+    'Attributes':
+      begin
+      Result:=CreateElement(TPasAttributes,Name,Parent);
+      ReadAttributes(Obj,TPasAttributes(Result),aContext);
+      end;
     else
     else
       RaiseMsg(20180210143758,Parent,'unknown type "'+LeftStr(aType,100)+'"');
       RaiseMsg(20180210143758,Parent,'unknown type "'+LeftStr(aType,100)+'"');
     end;
     end;
@@ -5969,6 +6034,16 @@ begin
     if not Found then
     if not Found then
       RaiseMsg(20180215134804,ErrorEl,s);
       RaiseMsg(20180215134804,ErrorEl,s);
     end;
     end;
+  if Obj.Find('RefConstructorType')<>nil then
+    begin
+    Ref.Context:=TResolvedRefCtxConstructor.Create;
+    ReadElementReference(Obj,Ref,'RefConstructorType',@Set_ResolvedReference_CtxConstructor);
+    end
+  else if Obj.Find('RefAttrProc')<>nil then
+    begin
+    Ref.Context:=TResolvedRefCtxAttrProc.Create;
+    ReadElementReference(Obj,Ref,'RefAttrProc',@Set_ResolvedReference_CtxAttrProc);
+    end;
 end;
 end;
 
 
 procedure TPCUReader.ReadPasExpr(Obj: TJSONObject; Expr: TPasExpr;
 procedure TPCUReader.ReadPasExpr(Obj: TJSONObject; Expr: TPasExpr;
@@ -7548,6 +7623,13 @@ begin
     El.TokenBased:=b;
     El.TokenBased:=b;
 end;
 end;
 
 
+procedure TPCUReader.ReadAttributes(Obj: TJSONObject; El: TPasAttributes;
+  aContext: TPCUReaderContext);
+begin
+  ReadPasElement(Obj,El,aContext);
+  ReadPasExprArray(Obj,El,'Calls',El.Calls,aContext);
+end;
+
 procedure TPCUReader.ResolvePending;
 procedure TPCUReader.ResolvePending;
 var
 var
   i: Integer;
   i: Integer;

+ 29 - 7
packages/pastojs/tests/tcfiler.pas

@@ -121,6 +121,7 @@ type
     procedure CheckRestoredMethodResolution(const Path: string; Orig, Rest: TPasMethodResolution); virtual;
     procedure CheckRestoredMethodResolution(const Path: string; Orig, Rest: TPasMethodResolution); virtual;
     procedure CheckRestoredProcedure(const Path: string; Orig, Rest: TPasProcedure); virtual;
     procedure CheckRestoredProcedure(const Path: string; Orig, Rest: TPasProcedure); virtual;
     procedure CheckRestoredOperator(const Path: string; Orig, Rest: TPasOperator); virtual;
     procedure CheckRestoredOperator(const Path: string; Orig, Rest: TPasOperator); virtual;
+    procedure CheckRestoredAttributes(const Path: string; Orig, Rest: TPasAttributes); virtual;
   public
   public
     property Analyzer: TPas2JSAnalyzer read FAnalyzer;
     property Analyzer: TPas2JSAnalyzer read FAnalyzer;
     property RestAnalyzer: TPas2JSAnalyzer read FRestAnalyzer;
     property RestAnalyzer: TPas2JSAnalyzer read FRestAnalyzer;
@@ -163,7 +164,7 @@ type
     procedure TestPC_Initialization;
     procedure TestPC_Initialization;
     procedure TestPC_BoolSwitches;
     procedure TestPC_BoolSwitches;
     procedure TestPC_ClassInterface;
     procedure TestPC_ClassInterface;
-    procedure TestPC_IgnoreAttributes;
+    procedure TestPC_Attributes;
 
 
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
     procedure TestPC_UseUnit_Class;
@@ -1181,6 +1182,8 @@ begin
     CheckRestoredModule(Path,TPasModule(Orig),TPasModule(Rest))
     CheckRestoredModule(Path,TPasModule(Orig),TPasModule(Rest))
   else if C.InheritsFrom(TPasSection) then
   else if C.InheritsFrom(TPasSection) then
     CheckRestoredSection(Path,TPasSection(Orig),TPasSection(Rest))
     CheckRestoredSection(Path,TPasSection(Orig),TPasSection(Rest))
+  else if C=TPasAttributes then
+    CheckRestoredAttributes(Path,TPasAttributes(Orig),TPasAttributes(Rest))
   else
   else
     Fail(Path+': unknown class '+C.ClassName);
     Fail(Path+': unknown class '+C.ClassName);
 
 
@@ -1570,6 +1573,12 @@ begin
   CheckRestoredProcedure(Path,Orig,Rest);
   CheckRestoredProcedure(Path,Orig,Rest);
 end;
 end;
 
 
+procedure TCustomTestPrecompile.CheckRestoredAttributes(const Path: string;
+  Orig, Rest: TPasAttributes);
+begin
+  CheckRestoredPasExprArray(Path+'.Calls',Orig.Calls,Rest.Calls);
+end;
+
 { TTestPrecompile }
 { TTestPrecompile }
 
 
 procedure TTestPrecompile.Test_Base256VLQ;
 procedure TTestPrecompile.Test_Base256VLQ;
@@ -2213,22 +2222,35 @@ begin
   WriteReadUnit;
   WriteReadUnit;
 end;
 end;
 
 
-procedure TTestPrecompile.TestPC_IgnoreAttributes;
+procedure TTestPrecompile.TestPC_Attributes;
 begin
 begin
   StartUnit(false);
   StartUnit(false);
   Add([
   Add([
   'interface',
   'interface',
-  '{$modeswitch ignoreattributes}',
+  '{$modeswitch PrefixedAttributes}',
   'type',
   'type',
-  '  [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
   '  TObject = class',
   '  TObject = class',
-  '    [custom5()] FS: string;',
-  '    [customProp] property S: string read FS;',
+  '    constructor Create;',
+  '  end;',
+  '  TCustomAttribute = class',
+  '    constructor Create(Id: word);',
+  '  end;',
+  '  [Missing]',
+  '  TBird = class',
+  '    [TCustom]',
+  '    FField: word;',
+  '  end;',
+  '  TRec = record',
+  '    [TCustom]',
+  '    Size: word;',
   '  end;',
   '  end;',
   'var',
   'var',
-  '  [custom6]',
+  '  [TCustom, TCustom(3)]',
   '  o: TObject;',
   '  o: TObject;',
   'implementation',
   'implementation',
+  '[TCustom]',
+  'constructor TObject.Create; begin end;',
+  'constructor TCustomAttribute.Create(Id: word); begin end;',
   'end.',
   'end.',
   '']);
   '']);
   WriteReadUnit;
   WriteReadUnit;

+ 173 - 12
packages/pastojs/tests/tcmodules.pas

@@ -800,7 +800,9 @@ type
     Procedure TestResourcestringImplementation;
     Procedure TestResourcestringImplementation;
 
 
     // Attributes
     // Attributes
-    Procedure TestAtributes_Ignore;
+    Procedure TestAttributes_Members;
+    Procedure TestAttributes_Types;
+    Procedure TestAttributes_HelperConstructor_Fail;
 
 
     // Assertions, checks
     // Assertions, checks
     procedure TestAssert;
     procedure TestAssert;
@@ -28494,38 +28496,197 @@ begin
     '']));
     '']));
 end;
 end;
 
 
-procedure TTestModule.TestAtributes_Ignore;
+procedure TTestModule.TestAttributes_Members;
 begin
 begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
-  '{$modeswitch ignoreattributes}',
+  '{$modeswitch PrefixedAttributes}',
   'type',
   'type',
-  '  [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
   '  TObject = class',
   '  TObject = class',
-  '    [custom5()] FS: string;',
-  '    [customProp] property S: string read FS;',
+  '    constructor Create;',
   '  end;',
   '  end;',
-  'var',
-  '  [custom6]',
-  '  o: TObject;',
+  '  TCustomAttribute = class',
+  '    constructor Create(Id: word);',
+  '  end;',
+  '  [Missing]',
+  '  TBird = class',
+  '  published',
+  '    [Tcustom]',
+  '    FField: word;',
+  '    [tcustom(14)]',
+  '    property Size: word read FField;',
+  '    [Tcustom(15)]',
+  '    procedure Fly; virtual; abstract;',
+  '  end;',
+  '  TRec = record',
+  '    [Tcustom,tcustom(14)]',
+  '    Size: word;',
+  '  end;',
+  'constructor TObject.Create; begin end;',
+  'constructor TCustomAttribute.Create(Id: word); begin end;',
   'begin',
   'begin',
   '']);
   '']);
   ConvertProgram;
   ConvertProgram;
-  CheckSource('TestAtributes_Ignore',
+  CheckSource('TestAttributes_Members',
     LinesToStr([ // statements
     LinesToStr([ // statements
     'rtl.createClass($mod, "TObject", null, function () {',
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  this.$init = function () {',
-    '    this.FS = "";',
     '  };',
     '  };',
     '  this.$final = function () {',
     '  this.$final = function () {',
     '  };',
     '  };',
+    '  this.Create = function () {',
+    '    return this;',
+    '  };',
     '});',
     '});',
-    'this.o = null;',
+    'rtl.createClass($mod, "TCustomAttribute", $mod.TObject, function () {',
+    '  this.Create$1 = function (Id) {',
+    '    return this;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.FField = 0;',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("FField", rtl.word, {',
+    '    attr: [$mod.TCustomAttribute, "Create"]',
+    '  });',
+    '  $r.addProperty(',
+    '    "Size",',
+    '    0,',
+    '    rtl.word,',
+    '    "FField",',
+    '    "",',
+    '    {',
+    '      attr: [$mod.TCustomAttribute, "Create$1", [14]]',
+    '    }',
+    '  );',
+    '  $r.addMethod("Fly", 0, null, null, {',
+    '    attr: [$mod.TCustomAttribute, "Create$1", [15]]',
+    '  });',
+    '});',
+    'rtl.recNewT($mod, "TRec", function () {',
+    '  this.Size = 0;',
+    '  this.$eq = function (b) {',
+    '    return this.Size === b.Size;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    this.Size = s.Size;',
+    '    return this;',
+    '  };',
+    '  var $r = $mod.$rtti.$Record("TRec", {});',
+    '  $r.addField("Size", rtl.word, {',
+    '    attr: [',
+    '        $mod.TCustomAttribute,',
+    '        "Create",',
+    '        $mod.TCustomAttribute,',
+    '        "Create$1",',
+    '        [14]',
+    '      ]',
+    '  });',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestAttributes_Types;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$modeswitch PrefixedAttributes}',
+  'type',
+  '  TObject = class',
+  '    constructor Create(Id: word);',
+  '  end;',
+  '  TCustomAttribute = class',
+  '  end;',
+  '  [TCustom(1)]',
+  '  TMyClass = class',
+  '  end;',
+  '  [TCustom(2)]',
+  '  TRec = record',
+  '  end;',
+  '  [TCustom(3)]',
+  '  TInt = type word;',
+  'constructor TObject.Create(Id: word);',
+  'begin',
+  'end;',
+  'var p: pointer;',
+  'begin',
+  '  p:=typeinfo(TMyClass);',
+  '  p:=typeinfo(TRec);',
+  '  p:=typeinfo(TInt);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAttributes_Types',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function (Id) {',
+    '    return this;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TCustomAttribute", $mod.TObject, function () {',
+    '});',
+    'rtl.createClass($mod, "TMyClass", $mod.TObject, function () {',
+    '  var $r = this.$rtti;',
+    '  $r.attr = [$mod.TCustomAttribute, "Create", [1]];',
+    '});',
+    'rtl.recNewT($mod, "TRec", function () {',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '  $mod.$rtti.$Record("TRec", {',
+    '    attr: [$mod.TCustomAttribute, "Create", [2]]',
+    '  });',
+    '});',
+    '$mod.$rtti.$inherited("TInt", rtl.word, {',
+    '  attr: [$mod.TCustomAttribute, "Create", [3]]',
+    '});',
+    'this.p = null;',
     '']),
     '']),
     LinesToStr([ // $mod.$main
     LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TMyClass"];',
+    '$mod.p = $mod.$rtti["TRec"];',
+    '$mod.p = $mod.$rtti["TInt"];',
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestAttributes_HelperConstructor_Fail;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$modeswitch PrefixedAttributes}',
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  '  TCustomAttribute = class',
+  '  end;',
+  '  THelper = class helper for TCustomAttribute',
+  '    constructor Create(Id: word);',
+  '  end;',
+  '  [TCustom(3)]',
+  '  TMyInt = word;',
+  'constructor TObject.Create; begin end;',
+  'constructor THelper.Create(Id: word); begin end;',
+  'begin',
+  '  if typeinfo(TMyInt)=nil then ;']);
+  //SetExpectedConverterError('aaa',123);
+  ConvertProgram;
+end;
+
 procedure TTestModule.TestAssert;
 procedure TTestModule.TestAssert;
 begin
 begin
   StartProgram(false);
   StartProgram(false);