* Get Field Attributes + tests

packages/rtl-objpas/src/inc/rtti.pp

@@ -365,6 +365,7 @@ type
     destructor Destroy; override;
     function GetAttributes: TCustomAttributeArray; override;
     function GetFields: TRttiFieldArray; virtual;
+    function GetField(const aName: String): TRttiField; virtual;
     function GetDeclaredMethods: TRttiMethodArray; virtual;
     function GetProperties: TRttiPropertyArray; virtual;
     function GetProperty(const AName: string): TRttiProperty; virtual;
@@ -6521,8 +6522,19 @@ begin
 end;
 
 function TRttiField.GetAttributes: TCustomAttributeArray;
+
+var
+  tbl : PAttributeTable;
+  i : Integer;
+
 begin
-  Result:=nil;
+  Result:=[];
+  tbl:=FHandle^.AttributeTable;
+  if not (assigned(Tbl) and (Tbl^.AttributeCount>0)) then
+    exit;
+  SetLength(Result,Tbl^.AttributeCount);
+  For I:=0 to Length(Result)-1 do
+    Result[I]:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}TypInfo.GetAttribute(Tbl,I);
 end;
 
 function TRttiField.GetValue(Instance: Pointer): TValue;
@@ -6596,7 +6608,7 @@ begin
   Result := FTypeInfo;
 end;
 
-constructor TRttiType.Create(ATypeInfo: PTypeInfo; aUsePublishedOnly : boolean);
+constructor TRttiType.Create(ATypeInfo: PTypeInfo; aUsePublishedOnly: Boolean);
 
 begin
   inherited Create();
@@ -6627,6 +6639,20 @@ begin
   Result:=Nil;
 end;
 
+function TRttiType.GetField(const aName: String): TRttiField;
+
+var
+  Flds : TRttiFieldArray;
+  Fld: TRttiField;
+
+begin
+  Flds:=GetFields;
+  For Fld in Flds do
+    if SameText(Fld.Name,aName) then
+      Exit(Fld);
+  Result:=Nil;
+end;
+
 function TRttiType.GetAttributes: TCustomAttributeArray;
 var
   i: Integer;

packages/rtl-objpas/tests/testrunner.rtlobjpas.lpi

@@ -7,7 +7,6 @@
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
         <MainUnitHasScaledStatement Value="False"/>
-        <UseDefaultCompilerOptions Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <Title Value="testrunner.rtlobjpas"/>
@@ -29,6 +28,10 @@
         <Filename Value="testrunner.rtlobjpas.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="tests.rtti.attrtypes.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -41,6 +44,11 @@
       <OtherUnitFiles Value="../src/inc"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
     <Other>
       <ConfigFile>
         <WriteConfigFilePath Value=""/>

packages/rtl-objpas/tests/testrunner.rtlobjpas.pp

@@ -48,7 +48,7 @@ uses
   utcvector,
   utcquaternion,
 {$IFDEF HAS_MONITOR}
-  utcfpmonitor
+  utcfpmonitor, tests.rtti.attrtypes
 {$ENDIF}
 
 ;

packages/rtl-objpas/tests/tests.rtti.attrtypes.pas

@@ -0,0 +1,114 @@
+unit tests.rtti.attrtypes;
+
+{These types are put in a different unit so the $RTTI directive only influences these classes }
+
+{$mode objfpc}
+{$ModeSwitch prefixedattributes}
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+  TypInfo;
+
+Type
+   {$RTTI Explicit Fields[vcPrivate,vcPublic,vcProtected,vcPublished]
+                   Properties[vcPrivate,vcPublic,vcProtected,vcPublished]
+   }
+
+   { TIntAttribute }
+
+   { WeakAttribute }
+
+   WeakAttribute = class(TCustomAttribute)
+     Constructor Create;
+   end;
+
+   TIntAttribute = class(TCustomAttribute)
+   Private
+     FInt : Integer;
+   Public
+     Constructor Create(aInt: Integer);
+     Property Int : Integer Read FInt;
+   end;
+
+   MyAttribute = class(TIntAttribute)
+   end;
+
+   My2Attribute = class(TIntAttribute);
+   My3Attribute = class(TIntAttribute);
+   My4Attribute = class(TIntAttribute);
+
+
+   TFieldObject = Class(TObject)
+   Private
+     [Weak]
+     [my(1)]
+     [my2(2)]
+     PrivateField : Integer;
+   Protected
+     [my2(3)]
+     ProtectedField : Integer;
+   Public
+     [my3(4)]
+     PublicField : Integer;
+   Public
+     [my3(4)]
+     A, B : Integer;
+   end;
+
+   {$M+}
+   TPropertyObject = Class(TObject)
+   Private
+     PrivateField : Integer;
+     [Weak]
+     [my(1)]
+     [my2(2)]
+     Property PrivateProperty : Integer Read PrivateField;
+   Protected
+     ProtectedField : Integer;
+     [my2(3)]
+     Property ProtectedProperty : Integer Read ProtectedField;
+   Public
+     PublicField : Integer;
+     PublishedField : Integer;
+     [my3(4)]
+     Property PublicProperty : Integer Read PublicField;
+   Published
+     [my3(5)]
+     Property PublishedProperty : Integer Read PublishedField;
+   end;
+
+   TFieldRecord = Record
+   Private
+     [Weak]
+     [my(1)]
+     [my2(2)]
+     PrivateField : Integer;
+   Public
+     [my3(3)]
+     PublicField : Integer;
+   Public
+     [my3(4)]
+     A,B : Integer;
+   end;
+
+
+implementation
+
+
+constructor WeakAttribute.Create;
+begin
+  // Do nothing
+end;
+
+{ TIntAttribute }
+
+constructor TIntAttribute.Create(aInt: Integer);
+begin
+  Fint:=aInt;
+end;
+
+
+end.
+

packages/rtl-objpas/tests/tests.rtti.pas

@@ -108,6 +108,13 @@ type
     Procedure TestProperties;
     Procedure TestDeclaredMethods;
     Procedure TestMethods;
+    Procedure TestPrivateFieldAttributes;
+    Procedure TestProtectedFieldAttributes;
+    Procedure TestPublicFieldAttributes;
+    Procedure TestPrivatePropertyAttributes;
+    Procedure TestProtectedPropertyAttributes;
+    Procedure TestPublicPropertyAttributes;
+    Procedure TestPublishedPropertyAttributes;
   end;
 
   { TTestRecordExtendedRTTI }
@@ -118,13 +125,15 @@ type
     Procedure TestProperties;
     Procedure TestDeclaredMethods;
     Procedure TestMethods;
+    Procedure TestPrivateFieldAttributes;
+    Procedure TestPublicFieldAttributes;
   end;
 
 
 implementation
 
 uses
-  Tests.Rtti.Util, {tests.rtti.exttypes, }tests.rtti.types;
+  Tests.Rtti.Util, {tests.rtti.exttypes, } tests.rtti.attrtypes, tests.rtti.types;
 
 
 
@@ -1785,6 +1794,217 @@ begin
 
 end;
 
+procedure TTestClassExtendedRTTI.TestPrivateFieldAttributes;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiInstanceType absolute obj;
+  Attrs : TCustomAttributeArray;
+  Fld : TRttiField;
+  O : TCustomAttribute;
+  M2 : My2Attribute absolute O;
+
+begin
+  Obj:=FCtx.GetType(TypeInfo(TFieldObject));
+  AssertEquals('Correct class type',TRttiInstanceType,Obj.ClassType);
+  Fld:=RttiData.GetField('PrivateField');
+  AssertNotNull('Have field',Fld);
+  Attrs:=Fld.GetAttributes;
+  AssertNotNull('Have attribute data',Pointer(Attrs));
+  AssertEquals('attribute count',3,Length(Attrs));
+  AssertEquals('Attribute 1 name','WeakAttribute',Attrs[0].ClassName);
+  AssertEquals('Attribute 2 name','MyAttribute',Attrs[1].ClassName);
+  AssertEquals('Attribute 2 name','My2Attribute',Attrs[2].ClassName);
+  O:=Attrs[2];
+  AssertNotNull('Attribute class ',O);
+  AssertEquals('Attribute class ',O.ClassType,My2Attribute);
+  AssertEquals('Attribute value ',2,M2.Int);
+end;
+
+procedure TTestClassExtendedRTTI.TestProtectedFieldAttributes;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiInstanceType absolute obj;
+  Attrs : TCustomAttributeArray;
+  Fld : TRttiField;
+  O : TCustomAttribute;
+  M2 : My2Attribute absolute O;
+
+begin
+  Obj:=FCtx.GetType(TypeInfo(TFieldObject));
+  AssertEquals('Correct class type',TRttiInstanceType,Obj.ClassType);
+  Fld:=RttiData.GetField('ProtectedField');
+  AssertNotNull('Have field',Fld);
+  Attrs:=Fld.GetAttributes;
+  AssertNotNull('Have attribute data',Pointer(Attrs));
+  AssertEquals('attribute count',1,Length(Attrs));
+  AssertEquals('Attribute 1 name','My2Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('Attribute class ',O);
+  AssertEquals('Attribute class ',O.ClassType,My2Attribute);
+  AssertEquals('Attribute value ',3,M2.Int);
+end;
+
+Procedure TTestClassExtendedRTTI.TestPublicFieldAttributes;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiInstanceType absolute obj;
+  Attrs : TCustomAttributeArray;
+  Fld : TRttiField;
+  O : TCustomAttribute;
+  M3 : My3Attribute absolute O;
+  aCount : Integer;
+
+begin
+  Obj:=FCtx.GetType(TypeInfo(TFieldObject));
+  AssertEquals('Correct class type',TRttiInstanceType,Obj.ClassType);
+  aCount:=0;
+  For Fld in RttiData.GetFields do
+    if Fld.Visibility=mvPublic then
+      inc(aCount);
+  AssertEquals('Field count',3,aCount);
+  // PublicField
+  Fld:=RttiData.GetField('PublicField');
+  AssertNotNull('Have field',Fld);
+  Attrs:=Fld.GetAttributes;
+  AssertNotNull('Have attribute data',Pointer(Attrs));
+  AssertEquals('attribute count',1,Length(Attrs));
+  AssertEquals('Attribute 1 name','My3Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('Attribute class ',O);
+  AssertEquals('Attribute class ',O.ClassType,My3Attribute);
+  AssertEquals('Attribute value ',4,M3.Int);
+  // A
+  Fld:=RttiData.GetField('A');
+  AssertNotNull('A Have field',Fld);
+  Attrs:=Fld.GetAttributes;
+  AssertNotNull('A Have attribute data',Pointer(Attrs));
+  AssertEquals('A Attribute count',1,Length(Attrs));
+  AssertEquals('A Attribute 1 name','My3Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('A: Attribute class ',O);
+  AssertEquals('A: Attribute class ',O.ClassType,My3Attribute);
+  AssertEquals('A: Attribute value ',4,M3.Int);
+  // B
+  Fld:=RttiData.GetField('B');
+  AssertNotNull('B Have field',Fld);
+  Attrs:=Fld.GetAttributes;
+  AssertNotNull('B Have attribute data',Pointer(Attrs));
+  AssertEquals('A Attribute count',1,Length(Attrs));
+  AssertEquals('A Attribute 1 name','My3Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('B: Attribute class ',O);
+  AssertEquals('B: Attribute class ',O.ClassType,My3Attribute);
+  AssertEquals('B: Attribute value ',4,M3.Int);
+end;
+
+Procedure TTestClassExtendedRTTI.TestPrivatePropertyAttributes;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiInstanceType absolute obj;
+  Attrs : TCustomAttributeArray;
+  Prop : TRttiProperty;
+  O : TCustomAttribute;
+  aCount : Integer;
+  M2 : My2Attribute absolute O;
+
+begin
+  Obj:=FCtx.GetType(TypeInfo(TPropertyObject));
+  AssertEquals('Correct class type',TRttiInstanceType,Obj.ClassType);
+  aCount:=0;
+  Prop:=RttiData.GetProperty('PrivateProperty');
+  AssertNotNull('Have property',Prop);
+  Attrs:=Prop.GetAttributes;
+  AssertNotNull('Have attribute data',Pointer(Attrs));
+  AssertEquals('attribute count',3,Length(Attrs));
+  AssertEquals('Attribute 1 name','WeakAttribute',Attrs[0].ClassName);
+  AssertEquals('Attribute 2 name','MyAttribute',Attrs[1].ClassName);
+  AssertEquals('Attribute 2 name','My2Attribute',Attrs[2].ClassName);
+  O:=Attrs[2];
+  AssertNotNull('Attribute class ',O);
+  AssertEquals('Attribute class ',O.ClassType,My2Attribute);
+  AssertEquals('Attribute value ',2,M2.Int);
+end;
+
+Procedure TTestClassExtendedRTTI.TestProtectedPropertyAttributes;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiInstanceType absolute obj;
+  Attrs : TCustomAttributeArray;
+  Prop : TRttiProperty;
+  O : TCustomAttribute;
+  M2 : My2Attribute absolute O;
+
+begin
+  Obj:=FCtx.GetType(TypeInfo(TPropertyObject));
+  AssertEquals('Correct class type',TRttiInstanceType,Obj.ClassType);
+  Prop:=RttiData.GetProperty('ProtectedProperty');
+  AssertNotNull('Have property',Prop);
+  Attrs:=Prop.GetAttributes;
+  AssertNotNull('Have attribute data',Pointer(Attrs));
+  AssertEquals('attribute count',1,Length(Attrs));
+  AssertEquals('Attribute 1 name','My2Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('Attribute class ',O);
+  AssertEquals('Attribute class ',O.ClassType,My2Attribute);
+  AssertEquals('Attribute value ',3,M2.Int);
+end;
+
+Procedure TTestClassExtendedRTTI.TestPublicPropertyAttributes;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiInstanceType absolute obj;
+  Attrs : TCustomAttributeArray;
+  Prop : TRttiProperty;
+  O : TCustomAttribute;
+  M3 : My3Attribute absolute O;
+
+begin
+  Obj:=FCtx.GetType(TypeInfo(TPropertyObject));
+  AssertEquals('Correct class type',TRttiInstanceType,Obj.ClassType);
+  Prop:=RttiData.GetProperty('PublicProperty');
+  AssertNotNull('Have property',Prop);
+  Attrs:=Prop.GetAttributes;
+  AssertNotNull('Have attribute data',Pointer(Attrs));
+  AssertEquals('attribute count',1,Length(Attrs));
+  AssertEquals('Attribute 1 name','My3Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('Attribute class ',O);
+  AssertEquals('Attribute class ',O.ClassType,My3Attribute);
+  AssertEquals('Attribute value ',4,M3.Int);
+end;
+
+Procedure TTestClassExtendedRTTI.TestPublishedPropertyAttributes ;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiInstanceType absolute obj;
+  Attrs : TCustomAttributeArray;
+  Prop : TRttiProperty;
+  O : TCustomAttribute;
+  M3 : My3Attribute absolute O;
+
+begin
+  Obj:=FCtx.GetType(TypeInfo(TPropertyObject));
+  AssertEquals('Correct class type',TRttiInstanceType,Obj.ClassType);
+  Prop:=RttiData.GetProperty('PublishedProperty');
+  AssertNotNull('Have property',Prop);
+  Attrs:=Prop.GetAttributes;
+  AssertNotNull('Have attribute data',Pointer(Attrs));
+  AssertEquals('attribute count',1,Length(Attrs));
+  AssertEquals('Attribute 1 name','My3Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('Attribute class ',O);
+  AssertEquals('Attribute class ',O.ClassType,My3Attribute);
+  AssertEquals('Attribute value ',5,M3.Int);
+end;
+
+
 { TTestRecordExtendedRTTI }
 
 procedure TTestRecordExtendedRTTI.TestFields;
@@ -1889,6 +2109,87 @@ begin
   AssertEquals('Method Full Count',4,aCount);
 end;
 
+Procedure TTestRecordExtendedRTTI.TestPrivateFieldAttributes;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiRecordType absolute obj;
+  Attrs : TCustomAttributeArray;
+  Fld : TRttiField;
+  O : TCustomAttribute;
+  M2 : My2Attribute absolute O;
+
+begin
+  Obj:=FCtx.GetType(TypeInfo(TFieldRecord));
+  AssertEquals('Correct class type',TRttiRecordType,Obj.ClassType);
+  Fld:=RttiData.GetField('PrivateField');
+  AssertNotNull('Have field',Fld);
+  Attrs:=Fld.GetAttributes;
+  AssertNotNull('Have attribute data',Pointer(Attrs));
+  AssertEquals('attribute count',3,Length(Attrs));
+  AssertEquals('Attribute 1 name','WeakAttribute',Attrs[0].ClassName);
+  AssertEquals('Attribute 2 name','MyAttribute',Attrs[1].ClassName);
+  AssertEquals('Attribute 2 name','My2Attribute',Attrs[2].ClassName);
+  O:=Attrs[2];
+  AssertNotNull('Attribute class ',O);
+  AssertEquals('Attribute class ',O.ClassType,My2Attribute);
+  AssertEquals('Attribute value ',2,M2.Int);
+end;
+
+Procedure TTestRecordExtendedRTTI.TestPublicFieldAttributes;
+
+var
+  Obj : TRttiObject;
+  RttiData : TRttiRecordType absolute obj;
+  Attrs : TCustomAttributeArray;
+  Fld : TRttiField;
+  O : TCustomAttribute;
+  M3 : My3Attribute absolute O;
+  aCount : Integer;
+
+begin
+  Obj:=FCtx.GetType(TypeInfo(TFieldRecord));
+  AssertEquals('Correct class type',TRttiRecordType,Obj.ClassType);
+  aCount:=0;
+  For Fld in RttiData.GetFields do
+    if Fld.Visibility=mvPublic then
+      inc(aCount);
+  AssertEquals('Field count',3,aCount);
+  // PublicField
+  Fld:=RttiData.GetField('PublicField');
+  AssertNotNull('Have field',Fld);
+  Attrs:=Fld.GetAttributes;
+  AssertNotNull('Have attribute data',Pointer(Attrs));
+  AssertEquals('attribute count',1,Length(Attrs));
+  AssertEquals('Attribute 1 name','My3Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('Attribute class ',O);
+  AssertEquals('Attribute class ',O.ClassType,My3Attribute);
+  AssertEquals('Attribute value ',3,M3.Int);
+  // A
+  Fld:=RttiData.GetField('A');
+  AssertNotNull('A Have field',Fld);
+  Attrs:=Fld.GetAttributes;
+  AssertNotNull('A Have attribute data',Pointer(Attrs));
+  AssertEquals('A Attribute count',1,Length(Attrs));
+  AssertEquals('A Attribute 1 name','My3Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('A: Attribute class ',O);
+  AssertEquals('A: Attribute class ',O.ClassType,My3Attribute);
+  AssertEquals('A: Attribute value ',4,M3.Int);
+  // B
+  Fld:=RttiData.GetField('B');
+  AssertNotNull('B Have field',Fld);
+  Attrs:=Fld.GetAttributes;
+  AssertNotNull('B Have attribute data',Pointer(Attrs));
+  AssertEquals('A Attribute count',1,Length(Attrs));
+  AssertEquals('A Attribute 1 name','My3Attribute',Attrs[0].ClassName);
+  O:=Attrs[0];
+  AssertNotNull('B: Attribute class ',O);
+  AssertEquals('B: Attribute class ',O.ClassType,My3Attribute);
+  AssertEquals('B: Attribute value ',4,M3.Int);
+end;
+
 
 
 initialization

packages/rtl-objpas/tests/tests.rtti.types.pas

@@ -254,7 +254,6 @@ Type
       FRPublicB: Integer;
       Property RPublicA : Integer Read FRPublicA Write FRPublicA;
       Property RPublicB : Integer Read FRPublicA Write FRPublicB;
-
    end;
 
   TRecordFieldRTTIMixed = record