Browse Source

* Extended RTTI tests

Michaël Van Canneyt 2 years ago
parent
commit
a98462835e

+ 22 - 0
tests/test/texrtti1.pp

@@ -0,0 +1,22 @@
+{%NORUN}
+{$mode objfpc}
+
+{
+  Test RTTI directive
+}
+program texrtti1;
+
+{$RTTI EXPLICIT PROPERTIES([])}
+{$RTTI EXPLICIT FIELDS([])}
+{$RTTI EXPLICIT METHODS([])}
+
+{$RTTI EXPLICIT PROPERTIES([vcPrivate,vcProtected,vcPublic,vcPublished])}
+{$RTTI EXPLICIT FIELDS([vcPrivate,vcProtected,vcPublic,vcPublished])}
+{$RTTI EXPLICIT METHODS([vcPrivate,vcProtected,vcPublic,vcPublished])}
+
+{$RTTI EXPLICIT PROPERTIES([vcPrivate,vcProtected,vcPublic,vcPublished])
+                FIELDS([vcPrivate,vcProtected,vcPublic,vcPublished])
+                METHODS([vcPrivate,vcProtected,vcPublic,vcPublished])}
+
+begin
+end.

+ 349 - 0
tests/test/texrtti10.pp

@@ -0,0 +1,349 @@
+{$MODE OBJFPC}
+{$M+}
+{$Modeswitch advancedrecords}
+
+program texrtti10;
+
+uses typinfo, sysutils, uexrttiutil;
+
+Type
+  {$RTTI EXPLICIT
+     PROPERTIES([vcPrivate,vcProtected,vcPublic,vcPublished])
+     FIELDS([vcPrivate,vcProtected,vcPublic,vcPublished])
+     METHODS([vcPrivate,vcProtected,vcPublic,vcPublished])}
+
+  { TFieldRTTI }
+
+  TFieldRTTI = Class
+  private
+    FPrivateA: Integer;
+    Property PrivateA : Integer Read FPrivateA Write FPrivateA;
+  strict private
+    FPrivateB: Integer;
+    Property PrivateB : Integer Read FPrivateB Write FPrivateB;
+  Protected
+    FProtectedA: Integer;
+    Property ProtectedA : Integer Read FProtectedA Write FProtectedA;
+  Strict Protected
+    FProtectedB: Integer;
+    Property ProtectedB : Integer Read FProtectedB Write FProtectedB;
+  Public
+    FPublicA: Integer;
+    FPublicB: Integer;
+    Property PublicA : Integer Read FPublicA Write FPublicA;
+    Property PublicB : Integer Read FPublicA Write FPublicB;
+  Private
+    FPublishedA: Integer;
+    FPublishedB: Integer;
+  Published
+    FPublishedC: TFieldRTTI;
+    FPublishedD: TFieldRTTI;
+    Property PublishedA : Integer Read FPublishedA Write FPublishedA;
+    Property PublishedB : Integer Read FPublishedA Write FPublishedB;
+  end;
+
+  { TMethodClassRTTI }
+
+  TMethodClassRTTI = Class (TObject)
+  private
+    Procedure PrivateMethodA;
+  strict private
+    Procedure PrivateMethodB; virtual;
+  private
+    Procedure PrivateMethodC; virtual; abstract;
+  protected
+    Procedure ProtectedMethodA;
+  strict protected
+    Procedure ProtectedMethodB; virtual;
+  protected
+    Procedure ProtectedMethodC; virtual; abstract;
+  public
+    Procedure PublicMethodA;
+    Procedure PublicMethodB; virtual;
+    Procedure PublicMethodC; virtual; abstract;
+  published
+    Procedure PublishedMethodA;
+    Procedure PublishedMethodB; virtual;
+    Procedure PublishedMethodC; virtual; abstract;
+  end;
+
+(*
+  // No published section
+
+  { TMethodClassRTTI2 }
+
+  TMethodClassRTTI2 = Class (TObject)
+  private
+    Procedure PrivateMethodA;
+  strict private
+    Procedure PrivateMethodB; virtual;
+  private
+    Procedure PrivateMethodC; virtual; abstract;
+  protected
+    Procedure ProtectedMethodA;
+  strict protected
+    Procedure ProtectedMethodB; virtual;
+  protected
+    Procedure ProtectedMethodC; virtual; abstract;
+  public
+    Procedure PublicMethodA;
+    Procedure PublicMethodB; virtual;
+    Procedure PublicMethodC; virtual; abstract;
+  end;
+
+{ TMethodClassRTTI2 }
+
+procedure TMethodClassRTTI2.PrivateMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI2.PrivateMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI2.ProtectedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI2.ProtectedMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI2.PublicMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI2.PublicMethodB;
+begin
+
+end;
+
+*)
+
+{ TMethodClassRTTI }
+
+procedure TMethodClassRTTI.PrivateMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PrivateMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodB;
+begin
+
+end;
+
+
+Procedure TestProperties;
+
+Var
+  A : PPropListEx;
+  aCount : Integer;
+
+begin
+  aCount:=GetPropListEx(TFieldRTTI,A);
+  try
+    AssertEquals('Property Count',8,aCount);
+    CheckProperty(0, A^[0]^,'PrivateA',tkInteger,vcPrivate);
+    CheckProperty(1, A^[1]^,'PrivateB',tkInteger,vcPrivate,True);
+    CheckProperty(2, A^[2]^,'ProtectedA',tkInteger,vcProtected);
+    CheckProperty(3, A^[3]^,'ProtectedB',tkInteger,vcProtected,True);
+    CheckProperty(4, A^[4]^,'PublicA',tkInteger,vcPublic);
+    CheckProperty(5, A^[5]^,'PublicB',tkInteger,vcPublic);
+    CheckProperty(6, A^[6]^,'PublishedA',tkInteger,vcPublished);
+    CheckProperty(7, A^[7]^,'PublishedB',tkInteger,vcPublished);
+  finally
+    Freemem(A);
+  end;
+end;
+
+Procedure TestClassFields;
+
+Var
+  A : PExtendedFieldInfoTable;
+  aCount : Integer;
+  t : TFieldRTTI;
+
+begin
+  // O:=TFieldRTTI.Create;
+  // aCount:=TFieldRTTI.InstanceSize;
+  // aCount:=PtrInt(O.FieldAddress('PublField'))-PtrInt(O);
+  aCount:=GetFieldList(TFieldRTTI,A);
+  AssertEquals('Class field Count',10,aCount);
+  CheckField(0, A^[0],'FPrivateA',tkInteger,vcPrivate);
+  CheckField(1, A^[1],'FPrivateB',tkInteger,vcPrivate,True);
+  CheckField(2, A^[2],'FProtectedA',tkInteger,vcProtected);
+  CheckField(3, A^[3],'FProtectedB',tkInteger,vcProtected,True);
+  CheckField(4, A^[4],'FPublicA',tkInteger,vcPublic);
+  CheckField(5, A^[5],'FPublicB',tkInteger,vcPublic);
+  CheckField(6, A^[6],'FPublishedA',tkInteger,vcPrivate);
+  CheckField(7, A^[7],'FPublishedB',tkInteger,vcPrivate);
+  CheckField(8, A^[8],'FPublishedC',tkClass,vcPublished);
+  CheckField(9, A^[9],'FPublishedD',tkClass,vcPublished);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcPrivate]);
+  AssertEquals('Count',4,aCount);
+  CheckField(0, A^[0],'FPrivateA',tkInteger,vcPrivate);
+  CheckField(1, A^[1],'FPrivateB',tkInteger,vcPrivate,True);
+  CheckField(2, A^[2],'FPublishedA',tkInteger,vcPrivate);
+  CheckField(3, A^[3],'FPublishedB',tkInteger,vcPrivate);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcProtected]);
+  AssertEquals('Count',2,aCount);
+  CheckField(2, A^[0],'FProtectedA',tkInteger,vcProtected);
+  CheckField(3, A^[1],'FProtectedB',tkInteger,vcProtected,True);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcPublic]);
+  AssertEquals('Count',2,aCount);
+  CheckField(4, A^[0],'FPublicA',tkInteger,vcPublic);
+  CheckField(5, A^[1],'FPublicB',tkInteger,vcPublic);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcPublished]);
+  AssertEquals('Count',2,aCount);
+  CheckField(8, A^[0],'FPublishedC',tkClass,vcPublished);
+  CheckField(9, A^[1],'FPublishedD',tkClass,vcPublished);
+  t := TFieldRTTI.Create;
+  AssertEquals('Legacy Field 0', A^[0]^.FieldOffset, Integer(PByte(t.FieldAddress('FPublishedC')) - PByte(t)));
+  AssertEquals('Legacy Field 1', A^[1]^.FieldOffset, Integer(PByte(t.FieldAddress('FPublishedD')) - PByte(t)));
+  t.Free;
+  //FreeMem(A);
+end;
+
+
+procedure TestClassMethods;
+
+Var
+  A : PExtendedMethodInfoTable;
+  aCount : Integer;
+  AInstance : TMethodClassRTTI;
+
+begin
+  aCount:=GetMethodList(TMethodClassRTTI,A,[]);
+  AssertEquals('Full Count',12,aCount);
+  CheckMethod('Full',0, A^[0],'PrivateMethodA',vcPrivate);
+  CheckMethod('Full',1, A^[1],'PrivateMethodB',vcPrivate,True);
+  CheckMethod('Full',2, A^[2],'PrivateMethodC',vcPrivate);
+  CheckMethod('Full',3, A^[3],'ProtectedMethodA',vcProtected);
+  CheckMethod('Full',4, A^[4],'ProtectedMethodB',vcProtected,True);
+  CheckMethod('Full',5, A^[5],'ProtectedMethodC',vcProtected);
+  CheckMethod('Full',6, A^[6],'PublicMethodA',vcPublic);
+  CheckMethod('Full',7, A^[7],'PublicMethodB',vcPublic);
+  CheckMethod('Full',8, A^[8],'PublicMethodC',vcPublic);
+  CheckMethod('Full',9, A^[9],'PublishedMethodA',vcPublished);
+  CheckMethod('Full',10, A^[10],'PublishedMethodB',vcPublished);
+  CheckMethod('Full',11, A^[11],'PublishedMethodC',vcPublished);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcPrivate]);
+  AssertEquals('Private Count',3,aCount);
+  CheckMethod('Priv',0, A^[0],'PrivateMethodA',vcPrivate);
+  CheckMethod('Priv',1, A^[1],'PrivateMethodB',vcPrivate,True);
+  CheckMethod('Priv',2, A^[2],'PrivateMethodC',vcPrivate);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcProtected]);
+  AssertEquals('Protected Count',3,aCount);
+  CheckMethod('Prot',0, A^[0],'ProtectedMethodA',vcProtected);
+  CheckMethod('Prot',1, A^[1],'ProtectedMethodB',vcProtected,True);
+  CheckMethod('Prot',2, A^[2],'ProtectedMethodC',vcProtected);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcPublic]);
+  AssertEquals('Public Count',3,aCount);
+  CheckMethod('Publ',0, A^[0],'PublicMethodA',vcPublic);
+  CheckMethod('Publ',1, A^[1],'PublicMethodB',vcPublic);
+  CheckMethod('Publ',2, A^[2],'PublicMethodC',vcPublic);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcPublished]);
+  AssertEquals('Published Count',3,aCount);
+  CheckMethod('Pubs',0, A^[0],'PublishedMethodA',vcPublished);
+  CheckMethod('Pubs',1, A^[1],'PublishedMethodB',vcPublished);
+  CheckMethod('Pubs',2, A^[2],'PublishedMethodC',vcPublished);
+  AssertSame('Method',@TMethodClassRTTI.PublishedMethodA, TMethodClassRTTI.MethodAddress('PublishedMethodA'));
+  AssertSame('Method',@TMethodClassRTTI.PublishedMethodB, TMethodClassRTTI.MethodAddress('PublishedMethodB'));
+  AssertNull('Method',TMethodClassRTTI.MethodAddress('PublishedMethodC'));
+  FreeMem(A);
+end;
+
+(*
+procedure TestClassMethods2;
+
+Var
+  A : PExtendedMethodInfoTable;
+  aCount : Integer;
+
+begin
+  aCount:=GetMethodList(TMethodClassRTTI2,A,[]);
+  AssertEquals('Full Count',9,aCount);
+  CheckMethod('Full',0, A^[0],'PrivateMethodA',vcPrivate);
+  CheckMethod('Full',1, A^[1],'PrivateMethodB',vcPrivate,True);
+  CheckMethod('Full',2, A^[2],'PrivateMethodC',vcPrivate);
+  CheckMethod('Full',3, A^[3],'ProtectedMethodA',vcProtected);
+  CheckMethod('Full',4, A^[4],'ProtectedMethodB',vcProtected,True);
+  CheckMethod('Full',5, A^[5],'ProtectedMethodC',vcProtected);
+  CheckMethod('Full',6, A^[6],'PublicMethodA',vcPublic);
+  CheckMethod('Full',7, A^[7],'PublicMethodB',vcPublic);
+  CheckMethod('Full',8, A^[8],'PublicMethodC',vcPublic);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI2,A,[vcPrivate]);
+  AssertEquals('Private Count',3,aCount);
+  CheckMethod('Priv',0, A^[0],'PrivateMethodA',vcPrivate);
+  CheckMethod('Priv',1, A^[1],'PrivateMethodB',vcPrivate,True);
+  CheckMethod('Priv',2, A^[2],'PrivateMethodC',vcPrivate);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI2,A,[vcProtected]);
+  AssertEquals('Protected Count',3,aCount);
+  CheckMethod('Prot',0, A^[0],'ProtectedMethodA',vcProtected);
+  CheckMethod('Prot',1, A^[1],'ProtectedMethodB',vcProtected,True);
+  CheckMethod('Prot',2, A^[2],'ProtectedMethodC',vcProtected);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI2,A,[vcPublic]);
+  AssertEquals('Public Count',3,aCount);
+  CheckMethod('Publ',0, A^[0],'PublicMethodA',vcPublic);
+  CheckMethod('Publ',1, A^[1],'PublicMethodB',vcPublic);
+  CheckMethod('Publ',2, A^[2],'PublicMethodC',vcPublic);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI2,A,[vcPublished]);
+  AssertEquals('Published Count',0,aCount);
+  FreeMem(A);
+end;
+*)
+
+begin
+  TestProperties;
+  TestClassFields;
+  TestClassMethods;
+  // TestClassMethods2;
+end.
+

+ 215 - 0
tests/test/texrtti11.pp

@@ -0,0 +1,215 @@
+{$MODE OBJFPC}
+{$M+}
+
+{ Test partial generation of RTTI: private/public properties/methods only }
+
+program texrtti11;
+
+uses typinfo, sysutils, uexrttiutil;
+
+Type
+  {$RTTI EXPLICIT
+     PROPERTIES([vcPrivate,vcPublic])
+     FIELDS([vcPrivate,vcPublic])
+     METHODS([vcPrivate,vcPublic])}
+
+  { TFieldRTTI }
+
+  TFieldRTTI = Class
+  private
+    FPrivateA: Integer;
+    Property PrivateA : Integer Read FPrivateA Write FPrivateA;
+  strict private
+    FPrivateB: Integer;
+    Property PrivateB : Integer Read FPrivateB Write FPrivateB;
+  Protected
+    FProtectedA: Integer;
+    Property ProtectedA : Integer Read FProtectedA Write FProtectedA;
+  Strict Protected
+    FProtectedB: Integer;
+    Property ProtectedB : Integer Read FProtectedB Write FProtectedB;
+  Public
+    FPublicA: Integer;
+    FPublicB: Integer;
+    FPublishedA: Integer;
+    FPublishedB: Integer;
+    Property PublicA : Integer Read FPublicA Write FPublicA;
+    Property PublicB : Integer Read FPublicA Write FPublicB;
+  Published
+    Property PublishedA : Integer Read FPublishedA Write FPublishedA;
+    Property PublishedB : Integer Read FPublishedA Write FPublishedB;
+  end;
+
+  { TMethodClassRTTI }
+
+  TMethodClassRTTI = Class (TObject)
+  private
+    Procedure PrivateMethodA;
+  strict private
+    Procedure PrivateMethodB; virtual;
+  private
+    Procedure PrivateMethodC; virtual; abstract;
+  protected
+    Procedure ProtectedMethodA;
+  strict protected
+    Procedure ProtectedMethodB; virtual;
+  protected
+    Procedure ProtectedMethodC; virtual; abstract;
+  public
+    Procedure PublicMethodA;
+    Procedure PublicMethodB; virtual;
+    Procedure PublicMethodC; virtual; abstract;
+  published
+    Procedure PublishedMethodA;
+    Procedure PublishedMethodB; virtual;
+    Procedure PublishedMethodC; virtual; abstract;
+  end;
+
+{ TMethodClassRTTI }
+
+procedure TMethodClassRTTI.PrivateMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PrivateMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodB;
+begin
+
+end;
+
+
+Procedure TestProperties;
+
+Var
+  A : PPropListEx;
+  AL : PPropList;
+  aCount : Integer;
+
+begin
+  aCount:=GetPropListEx(TFieldRTTI,A);
+  try
+    AssertEquals('Count',4,aCount);
+    CheckProperty(0, A^[0]^,'PrivateA',tkInteger,vcPrivate);
+    CheckProperty(1, A^[1]^,'PrivateB',tkInteger,vcPrivate,True);
+    CheckProperty(2, A^[2]^,'PublicA',tkInteger,vcPublic);
+    CheckProperty(3, A^[3]^,'PublicB',tkInteger,vcPublic);
+  finally
+    Freemem(A);
+  end;
+  // Check legacy published property list
+  aCount:=GetPropList(TFieldRTTI,AL);
+  try
+    AssertEquals('Legacy Count',2,aCount);
+  finally
+    Freemem(AL);
+  end;
+end;
+
+Procedure TestClassFields;
+
+Var
+  A : PExtendedFieldInfoTable;
+  aCount : Integer;
+
+begin
+  aCount:=GetFieldList(TFieldRTTI,A);
+  AssertEquals('Count',6,aCount);
+  CheckField(0, A^[0],'FPrivateA',tkInteger,vcPrivate);
+  CheckField(1, A^[1],'FPrivateB',tkInteger,vcPrivate,True);
+  CheckField(2, A^[2],'FPublicA',tkInteger,vcPublic);
+  CheckField(3, A^[3],'FPublicB',tkInteger,vcPublic);
+  CheckField(4, A^[4],'FPublishedA',tkInteger,vcPublic);
+  CheckField(5, A^[5],'FPublishedB',tkInteger,vcPublic);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcPrivate]);
+  AssertEquals('Count',2,aCount);
+  CheckField(0, A^[0],'FPrivateA',tkInteger,vcPrivate);
+  CheckField(1, A^[1],'FPrivateB',tkInteger,vcPrivate,True);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcProtected]);
+  AssertEquals('Count',0,aCount);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcPublic]);
+  AssertEquals('Count',4,aCount);
+  CheckField(0, A^[0],'FPublicA',tkInteger,vcPublic);
+  CheckField(1, A^[1],'FPublicB',tkInteger,vcPublic);
+  CheckField(2, A^[2],'FPublishedA',tkInteger,vcPublic);
+  CheckField(3, A^[3],'FPublishedB',tkInteger,vcPublic);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcPublished]);
+  AssertEquals('Count',0,aCount);
+  FreeMem(A);
+end;
+
+
+procedure TestClassMethods;
+
+Var
+  A : PExtendedMethodInfoTable;
+  aCount : Integer;
+
+begin
+  aCount:=GetMethodList(TMethodClassRTTI,A,[]);
+  AssertEquals('Full Count',6,aCount);
+  CheckMethod('Full',0, A^[0],'PrivateMethodA',vcPrivate);
+  CheckMethod('Full',1, A^[1],'PrivateMethodB',vcPrivate,True);
+  CheckMethod('Full',2, A^[2],'PrivateMethodC',vcPrivate);
+  CheckMethod('Full',3, A^[3],'PublicMethodA',vcPublic);
+  CheckMethod('Full',4, A^[4],'PublicMethodB',vcPublic);
+  CheckMethod('Full',5, A^[5],'PublicMethodC',vcPublic);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcPrivate]);
+  AssertEquals('Private Count',3,aCount);
+  CheckMethod('Priv',0, A^[0],'PrivateMethodA',vcPrivate);
+  CheckMethod('Priv',1, A^[1],'PrivateMethodB',vcPrivate,True);
+  CheckMethod('Priv',2, A^[2],'PrivateMethodC',vcPrivate);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcProtected]);
+  AssertEquals('Protected Count',0,aCount);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcPublic]);
+  AssertEquals('Public Count',3,aCount);
+  CheckMethod('Publ',0, A^[0],'PublicMethodA',vcPublic);
+  CheckMethod('Publ',1, A^[1],'PublicMethodB',vcPublic);
+  CheckMethod('Publ',2, A^[2],'PublicMethodC',vcPublic);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcPublished]);
+  AssertEquals('Published Count',0,aCount);
+  FreeMem(A);
+end;
+
+begin
+  TestProperties;
+  TestClassFields;
+  TestClassMethods;
+end.
+

+ 204 - 0
tests/test/texrtti12.pp

@@ -0,0 +1,204 @@
+{$MODE OBJFPC}
+{$M+}
+
+{ Test partial generation of RTTI: protected/published properties/methods only }
+
+program texrtti12;
+
+uses typinfo, sysutils, uexrttiutil;
+
+Type
+  {$RTTI EXPLICIT
+        PROPERTIES([vcProtected,vcPublished])
+        FIELDS([vcProtected,vcPublished])
+        METHODS([vcProtected,vcPublished])}
+
+  { TFieldRTTI }
+
+  TFieldRTTI = Class
+  private
+    FPrivateA: Integer;
+    Property PrivateA : Integer Read FPrivateA Write FPrivateA;
+  strict private
+    FPrivateB: Integer;
+    Property PrivateB : Integer Read FPrivateB Write FPrivateB;
+  Protected
+    FProtectedA: Integer;
+    Property ProtectedA : Integer Read FProtectedA Write FProtectedA;
+  Strict Protected
+    FProtectedB: Integer;
+    Property ProtectedB : Integer Read FProtectedB Write FProtectedB;
+  Public
+    FPublicA: Integer;
+    FPublicB: Integer;
+    Property PublicA : Integer Read FPublicA Write FPublicA;
+    Property PublicB : Integer Read FPublicA Write FPublicB;
+  Private
+    FPublishedA: Integer;
+    FPublishedB: Integer;
+  Published
+    Property PublishedA : Integer Read FPublishedA Write FPublishedA;
+    Property PublishedB : Integer Read FPublishedA Write FPublishedB;
+  end;
+
+  { TMethodClassRTTI }
+
+  TMethodClassRTTI = Class (TObject)
+  private
+    Procedure PrivateMethodA;
+  strict private
+    Procedure PrivateMethodB; virtual;
+  private
+    Procedure PrivateMethodC; virtual; abstract;
+  protected
+    Procedure ProtectedMethodA;
+  strict protected
+    Procedure ProtectedMethodB; virtual;
+  protected
+    Procedure ProtectedMethodC; virtual; abstract;
+  public
+    Procedure PublicMethodA;
+    Procedure PublicMethodB; virtual;
+    Procedure PublicMethodC; virtual; abstract;
+  published
+    Procedure PublishedMethodA;
+    Procedure PublishedMethodB; virtual;
+    Procedure PublishedMethodC; virtual; abstract;
+  end;
+
+{ TMethodClassRTTI }
+
+procedure TMethodClassRTTI.PrivateMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PrivateMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodB;
+begin
+
+end;
+
+
+Procedure TestProperties;
+
+Var
+  A : PPropListEx;
+  aCount : Integer;
+
+begin
+  aCount:=GetPropListEx(TFieldRTTI,A);
+  try
+    AssertEquals('Property Count',4,aCount);
+    CheckProperty(0, A^[0]^,'ProtectedA',tkInteger,vcProtected);
+    CheckProperty(1, A^[1]^,'ProtectedB',tkInteger,vcProtected,True);
+    CheckProperty(2, A^[2]^,'PublishedA',tkInteger,vcPublished);
+    CheckProperty(3, A^[3]^,'PublishedB',tkInteger,vcPublished);
+  finally
+    Freemem(A);
+  end;
+end;
+
+Procedure TestClassFields;
+
+Var
+  A : PExtendedFieldInfoTable;
+  aCount : Integer;
+
+begin
+  aCount:=GetFieldList(TFieldRTTI,A);
+  AssertEquals('Total field Count',2,aCount);
+  CheckField(0, A^[0],'FProtectedA',tkInteger,vcProtected);
+  CheckField(1, A^[1],'FProtectedB',tkInteger,vcProtected,True);
+//  CheckField(2, A^[2],'FPublishedA',tkInteger,vcPublished);
+//  CheckField(3, A^[3],'FPublishedB',tkInteger,vcPublished);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcProtected]);
+  AssertEquals('Protected field Count',2,aCount);
+  CheckField(0, A^[0],'FProtectedA',tkInteger,vcProtected);
+  CheckField(1, A^[1],'FProtectedB',tkInteger,vcProtected,True);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcPrivate]);
+  AssertEquals('Private field Count',0,aCount);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcPublished]);
+  AssertEquals('Published field Count',0,aCount);
+//  CheckField(4, A^[0],'FPublishedA',tkInteger,vcPublished);
+//  CheckField(5, A^[1],'FPublishedB',tkInteger,vcPublished);
+  FreeMem(A);
+  aCount:=GetFieldList(TFieldRTTI,A,[vcPublic]);
+  AssertEquals('Public field Count',0,aCount);
+  FreeMem(A);
+end;
+
+
+procedure TestClassMethods;
+
+Var
+  A : PExtendedMethodInfoTable;
+  aCount : Integer;
+
+begin
+  aCount:=GetMethodList(TMethodClassRTTI,A,[]);
+  AssertEquals('Full method Count',6,aCount);
+  CheckMethod('Full',0, A^[0],'ProtectedMethodA',vcProtected);
+  CheckMethod('Full',1, A^[1],'ProtectedMethodB',vcProtected,True);
+  CheckMethod('Full',2, A^[2],'ProtectedMethodC',vcProtected);
+  CheckMethod('Full',3, A^[3],'PublishedMethodA',vcPublished);
+  CheckMethod('Full',4, A^[4],'PublishedMethodB',vcPublished);
+  CheckMethod('Full',5, A^[5],'PublishedMethodC',vcPublished);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcProtected]);
+  AssertEquals('Protected method Count',3,aCount);
+  CheckMethod('Priv',0, A^[0],'ProtectedMethodA',vcProtected);
+  CheckMethod('Priv',1, A^[1],'ProtectedMethodB',vcProtected,True);
+  CheckMethod('Priv',2, A^[2],'ProtectedMethodC',vcProtected);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcPrivate]);
+  AssertEquals('Private method Count',0,aCount);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcPublished]);
+  AssertEquals('Published method Count',3,aCount);
+  CheckMethod('Publ',0, A^[0],'PublishedMethodA',vcPublished);
+  CheckMethod('Publ',1, A^[1],'PublishedMethodB',vcPublished);
+  CheckMethod('Publ',2, A^[2],'PublishedMethodC',vcPublished);
+  FreeMem(A);
+  aCount:=GetMethodList(TMethodClassRTTI,A,[vcPublic]);
+  AssertEquals('Public method Count',0,aCount);
+  FreeMem(A);
+end;
+
+begin
+  TestProperties;
+  TestClassFields;
+  TestClassMethods;
+end.
+

+ 164 - 0
tests/test/texrtti13.pp

@@ -0,0 +1,164 @@
+{$MODE OBJFPC}
+{$M+}
+
+{ Test disabling generation of RTTI: no extra RTTI }
+
+program texrtti13;
+
+uses typinfo, sysutils, uexrttiutil;
+
+Type
+  {$RTTI EXPLICIT
+        PROPERTIES([])
+        FIELDS([])
+        METHODS([])}
+
+  { TFieldRTTI }
+
+  TFieldRTTI = Class
+  private
+    FPrivateA: Integer;
+    Property PrivateA : Integer Read FPrivateA Write FPrivateA;
+  strict private
+    FPrivateB: Integer;
+    Property PrivateB : Integer Read FPrivateB Write FPrivateB;
+  Protected
+    FProtectedA: Integer;
+    Property ProtectedA : Integer Read FProtectedA Write FProtectedA;
+  Strict Protected
+    FProtectedB: Integer;
+    Property ProtectedB : Integer Read FProtectedB Write FProtectedB;
+  Public
+    FPublicA: Integer;
+    FPublicB: Integer;
+    FPublishedA: Integer;
+    FPublishedB: Integer;
+    Property PublicA : Integer Read FPublicA Write FPublicA;
+    Property PublicB : Integer Read FPublicA Write FPublicB;
+  Published
+    Property PublishedA : Integer Read FPublishedA Write FPublishedA;
+    Property PublishedB : Integer Read FPublishedA Write FPublishedB;
+  end;
+
+  { TMethodClassRTTI }
+
+  TMethodClassRTTI = Class (TObject)
+  private
+    Procedure PrivateMethodA;
+  strict private
+    Procedure PrivateMethodB; virtual;
+  private
+    Procedure PrivateMethodC; virtual; abstract;
+  protected
+    Procedure ProtectedMethodA;
+  strict protected
+    Procedure ProtectedMethodB; virtual;
+  protected
+    Procedure ProtectedMethodC; virtual; abstract;
+  public
+    Procedure PublicMethodA;
+    Procedure PublicMethodB; virtual;
+    Procedure PublicMethodC; virtual; abstract;
+  published
+    Procedure PublishedMethodA;
+    Procedure PublishedMethodB; virtual;
+    Procedure PublishedMethodC; virtual; abstract;
+  end;
+
+{ TMethodClassRTTI }
+
+procedure TMethodClassRTTI.PrivateMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PrivateMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodB;
+begin
+
+end;
+
+
+Procedure TestProperties;
+
+Var
+  A : PPropListEx;
+  AL : PPropList;
+  aCount : Integer;
+
+begin
+  aCount:=GetPropListEx(TFieldRTTI,A);
+  try
+    AssertEquals('Property Count',0,aCount);
+  finally
+    Freemem(A);
+  end;
+  // Check that legacy property info is still there
+  aCount:=GetPropList(TFieldRTTI,AL);
+  try
+    AssertEquals('Legacy property Count',2,aCount);
+  finally
+    Freemem(A);
+  end;
+end;
+
+Procedure TestClassFields;
+
+Var
+  A : PExtendedFieldInfoTable;
+  aCount : Integer;
+
+begin
+  aCount:=GetFieldList(TFieldRTTI,A);
+  AssertEquals('Total field Count',0,aCount);
+  FreeMem(A);
+end;
+
+
+procedure TestClassMethods;
+
+Var
+  A : PExtendedMethodInfoTable;
+  aCount : Integer;
+
+begin
+  aCount:=GetMethodList(TMethodClassRTTI,A,[]);
+  AssertEquals('Full method Count',0,aCount);
+  FreeMem(A);
+end;
+
+begin
+  TestProperties;
+  TestClassFields;
+  TestClassMethods;
+end.
+

+ 198 - 0
tests/test/texrtti14.pp

@@ -0,0 +1,198 @@
+{$MODE OBJFPC}
+{$M+}
+{$Modeswitch advancedrecords}
+
+program texrtti14;
+
+uses typinfo, sysutils, uexrttiutil;
+
+Type
+  {$RTTI EXPLICIT
+     PROPERTIES([vcPrivate,vcProtected,vcPublic,vcPublished])
+     FIELDS([vcPrivate,vcProtected,vcPublic,vcPublished])
+     METHODS([vcPrivate,vcProtected,vcPublic,vcPublished])}
+
+  { TFieldRTTI }
+
+  // Use different names, so we can distinguish RTTI in asm file...
+  TRecordFieldRTTI = record
+    private
+      FRPrivateA: Integer;
+      FRPrivateB: Integer;
+      Property RPrivateA : Integer Read FRPrivateA Write FRPrivateA;
+      Property RPrivateB : Integer Read FRPrivateB Write FRPrivateB;
+    Public
+      FRPublicA: Integer;
+      FRPublicB: Integer;
+      Property RPublicA : Integer Read FRPublicA Write FRPublicA;
+      Property RPublicB : Integer Read FRPublicA Write FRPublicB;
+
+   end;
+
+  TRecordFieldRTTIMixed = record
+    private
+      FRPrivateA: Integer;
+      FRPrivateB: Integer;
+      Property RPrivateA : Integer Read FRPrivateA Write FRPrivateA;
+      Property RPrivateB : Integer Read FRPrivateB Write FRPrivateB;
+    Public
+      FRPublicA: Integer;
+      FRPublicB: Integer;
+      Property RPublicA : Integer Read FRPublicA Write FRPublicA;
+      Property RPublicB : Integer Read FRPublicA Write FRPublicB;
+      Procedure DoA;
+   end;
+  // Use different names, so we can distinguish RTTI in asm file...
+
+  { TRecordMethodRTTI }
+
+  TRecordMethodRTTI = record
+    a,b,c : Integer;
+  private
+    Procedure PrivateMethodA;
+    Procedure PrivateMethodB;
+  Public
+    Procedure PublicMethodA;
+    Procedure PublicMethodB;
+   end;
+
+  { TRecordMethodRTTI }
+
+  procedure TRecordMethodRTTI.PrivateMethodA;
+  begin
+    //
+  end;
+
+  procedure TRecordMethodRTTI.PrivateMethodB;
+  begin
+    //
+  end;
+
+  procedure TRecordMethodRTTI.PublicMethodA;
+  begin
+    //
+  end;
+
+  procedure TRecordMethodRTTI.PublicMethodB;
+  begin
+    //
+  end;
+
+  Procedure TRecordFieldRTTIMixed.DoA;
+
+  begin
+  //
+  end;
+
+
+Procedure TestRecordProperties;
+
+Var
+  A : PPropListEx;
+  aCount : Integer;
+
+begin
+  aCount:=GetPropListEx(TypeInfo(TRecordFieldRTTI),A);
+  try
+    AssertEquals('Record property Count',4,aCount);
+    CheckProperty(0, A^[0]^,'RPrivateA',tkInteger,vcPrivate);
+    CheckProperty(1, A^[1]^,'RPrivateB',tkInteger,vcPrivate);
+    CheckProperty(2, A^[2]^,'RPublicA',tkInteger,vcPublic);
+    CheckProperty(3, A^[3]^,'RPublicB',tkInteger,vcPublic);
+  finally
+    Freemem(A);
+  end;
+  aCount:=GetPropListEx(TypeInfo(TRecordFieldRTTIMixed),A);
+  try
+    AssertEquals('Record mixed property Count',4,aCount);
+    CheckProperty(0, A^[0]^,'RPrivateA',tkInteger,vcPrivate);
+    CheckProperty(1, A^[1]^,'RPrivateB',tkInteger,vcPrivate);
+    CheckProperty(2, A^[2]^,'RPublicA',tkInteger,vcPublic);
+    CheckProperty(3, A^[3]^,'RPublicB',tkInteger,vcPublic);
+  finally
+    Freemem(A);
+  end;
+end;
+
+
+
+Procedure TestRecordFields;
+
+Var
+  A : PExtendedFieldInfoTable;
+  aCount : Integer;
+
+begin
+  aCount:=GetFieldList(TypeInfo(TRecordFieldRTTI),A);
+  AssertEquals('Record fields Count',4,aCount);
+  CheckField(0, A^[0],'FRPrivateA',tkInteger,vcPrivate);
+  CheckField(1, A^[1],'FRPrivateB',tkInteger,vcPrivate);
+  CheckField(4, A^[2],'FRPublicA',tkInteger,vcPublic);
+  CheckField(5, A^[3],'FRPublicB',tkInteger,vcPublic);
+  FreeMem(A); A:=Nil;
+  aCount:=GetFieldList(TypeInfo(TRecordFieldRTTI),A,[vcPrivate]);
+  AssertEquals('Private Record fields Count',2,aCount);
+  CheckField(0, A^[0],'FRPrivateA',tkInteger,vcPrivate);
+  CheckField(1, A^[1],'FRPrivateB',tkInteger,vcPrivate);
+  FreeMem(A); A:=Nil;
+  aCount:=GetFieldList(TypeInfo(TRecordFieldRTTI),A,[vcProtected]);
+  AssertEquals('Protected record fields Count',0,aCount);
+  A:=Nil;
+  aCount:=GetFieldList(TypeInfo(TRecordFieldRTTI),A,[vcPublic]);
+  AssertEquals('Public record fields Count',2,aCount);
+  CheckField(0, A^[0],'FRPublicA',tkInteger,vcPublic);
+  CheckField(1, A^[1],'FRPublicB',tkInteger,vcPublic);
+  FreeMem(A); A:=Nil;
+  aCount:=GetFieldList(TypeInfo(TRecordFieldRTTI),A,[vcPublished]);
+  AssertEquals('Published record fields count Count',0,aCount);
+  A:=Nil;
+  aCount:=GetFieldList(TypeInfo(TRecordFieldRTTIMixed),A);
+  AssertEquals('Mixed record fields Count',4,aCount);
+  CheckField(0, A^[0],'FRPrivateA',tkInteger,vcPrivate);
+  CheckField(1, A^[1],'FRPrivateB',tkInteger,vcPrivate);
+  CheckField(4, A^[2],'FRPublicA',tkInteger,vcPublic);
+  CheckField(5, A^[3],'FRPublicB',tkInteger,vcPublic);
+  FreeMem(A); A:=Nil;
+end;
+
+procedure TestRecordMethods;
+
+Var
+  A : PRecordMethodInfoTable;
+  aCount : Integer;
+
+begin
+  aCount:=GetMethodList(PTypeInfo(TypeInfo(TRecordMethodRTTI)),A,True,[]);
+  AssertEquals('Method Full Count',4,aCount);
+  CheckMethod('Full',0, A^[0],'PrivateMethodA',vcPrivate);
+  CheckMethod('Full',1, A^[1],'PrivateMethodB',vcPrivate);
+  CheckMethod('Full',2, A^[2],'PublicMethodA',vcPublic);
+  CheckMethod('Full',3, A^[3],'PublicMethodB',vcPublic);
+  FreeMem(A);
+  aCount:=GetMethodList(PTypeInfo(TypeInfo(TRecordMethodRTTI)),A,False,[vcPrivate]);
+  AssertEquals('Method Private Count',2,aCount);
+  CheckMethod('Priv',0, A^[0],'PrivateMethodA',vcPrivate);
+  CheckMethod('Priv',1, A^[1],'PrivateMethodB',vcPrivate);
+  FreeMem(A);
+  aCount:=GetMethodList(PTypeInfo(TypeInfo(TRecordMethodRTTI)),A,False,[vcProtected]);
+  AssertEquals('Method Protected Count',0,aCount);
+  if A<>Nil then
+   FreeMem(A);
+  aCount:=GetMethodList(PTypeInfo(TypeInfo(TRecordMethodRTTI)),A,False,[vcPublic]);
+  AssertEquals('Method Public Count',2,aCount);
+  CheckMethod('Publ',0, A^[0],'PublicMethodA',vcPublic);
+  CheckMethod('Publ',1, A^[1],'PublicMethodB',vcPublic);
+  FreeMem(A);
+  aCount:=GetMethodList(PTypeInfo(TypeInfo(TRecordMethodRTTI)),A,False,[vcPublished]);
+  AssertEquals('Method Published Count',0,aCount);
+  if A<>Nil then
+    FreeMem(A);
+end;
+
+
+begin
+  TestRecordFields;
+//  TestRecordProperties;
+  TestRecordMethods;
+end.
+

+ 14 - 0
tests/test/texrtti2.pp

@@ -0,0 +1,14 @@
+{%FAIL}
+{$mode objfpc}
+
+{
+  Test RTTI directive (missing identifier)
+}
+program texrtti2;
+uses
+  typinfo;
+
+{$RTTI EXPLICIT PROPERTIES([MissingIdentifier])}
+
+begin
+end.

+ 14 - 0
tests/test/texrtti3.pp

@@ -0,0 +1,14 @@
+{%FAIL}
+{$mode objfpc}
+
+{
+  Test RTTI directive (leading comma)
+}
+program texrtti3;
+uses
+  typinfo;
+
+{$RTTI EXPLICIT PROPERTIES([,vcPrivate])}
+
+begin
+end.

+ 15 - 0
tests/test/texrtti4.pp

@@ -0,0 +1,15 @@
+{%FAIL}
+{$mode objfpc}
+
+{
+  Test RTTI directive (trailing comma)
+}
+program texrtti4;
+uses
+  typinfo;
+
+// TODO: Syntax error, "identifier" expected but "]"
+{$RTTI EXPLICIT PROPERTIES([vcPrivate,])}
+
+begin
+end.

+ 14 - 0
tests/test/texrtti5.pp

@@ -0,0 +1,14 @@
+{%FAIL}
+{$mode objfpc}
+
+{
+  Test RTTI directive (missing set)
+}
+program texrtti5;
+uses
+  typinfo;
+
+{$RTTI EXPLICIT PROPERTIES()}
+
+begin
+end.

+ 14 - 0
tests/test/texrtti6.pp

@@ -0,0 +1,14 @@
+{%FAIL}
+{$mode objfpc}
+
+{
+  Test RTTI directive (missing parentheses)
+}
+program texrtti6;
+uses
+  typinfo;
+
+{$RTTI EXPLICIT PROPERTIES}
+
+begin
+end.

+ 14 - 0
tests/test/texrtti7.pp

@@ -0,0 +1,14 @@
+{%FAIL}
+{$mode objfpc}
+
+{
+  Test RTTI directive (no clause specified)
+}
+program texrtti7;
+uses
+  typinfo;
+
+{$RTTI PROPERTIES}
+
+begin
+end.

+ 25 - 0
tests/test/texrtti8.pp

@@ -0,0 +1,25 @@
+{%NORUN}
+{$mode objfpc}
+
+{
+  Test RTTI directive (inherit clause)
+}
+program texrtti8;
+uses
+  typinfo;
+
+
+{$RTTI INHERIT PROPERTIES([])}
+{$RTTI INHERIT FIELDS([])}
+{$RTTI INHERIT METHODS([])}
+
+{$RTTI INHERIT PROPERTIES([vcPrivate,vcProtected,vcPublic,vcPublished])}
+{$RTTI INHERIT FIELDS([vcPrivate,vcProtected,vcPublic,vcPublished])}
+{$RTTI INHERIT METHODS([vcPrivate,vcProtected,vcPublic,vcPublished])}
+
+{$RTTI INHERIT PROPERTIES([vcPrivate,vcProtected,vcPublic,vcPublished])
+               FIELDS([vcPrivate,vcProtected,vcPublic,vcPublished])
+               METHODS([vcPrivate,vcProtected,vcPublic,vcPublished])}
+
+begin
+end.

+ 11 - 0
tests/test/texrtti9.pp

@@ -0,0 +1,11 @@
+{%FAIL}
+
+{$RTTI EXPLICIT PROPERTIES([])}
+
+{
+  Test RTTI directive in invalid location
+}
+program texrtti9;
+
+begin
+end.

+ 168 - 0
tests/test/uexrttiutil.pp

@@ -0,0 +1,168 @@
+unit uexrttiutil;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  SysUtils, TypInfo;
+
+// Low level tests
+Procedure AssertEquals(Msg : String; aExpected,aActual : Boolean);
+Procedure AssertEquals(Msg : String; aExpected,aActual : Integer);
+Procedure AssertEquals(Msg : String; aExpected,aActual : String);
+Procedure AssertEquals(Msg : String; aExpected,aActual : TVisibilityClass);
+Procedure AssertEquals(Msg : String; aExpected,aActual : TTypeKind);
+Procedure AssertNotNull(Msg : String; aPointer : Pointer);
+Procedure AssertNull(Msg : String; aPointer : Pointer);
+Procedure AssertSame(Msg : String; aExpected,aActual : Pointer);
+
+// Combined tests
+Procedure CheckProperty(aIdx : Integer; aData: TPropInfoEx; aName : String; aKind : TTypeKind; aVisibility : TVisibilityClass; isStrict : Boolean = False);
+Procedure CheckField(aIdx : Integer; aData: PExtendedVmtFieldEntry; aName : String; aKind : TTypeKind; aVisibility : TVisibilityClass; aStrict : Boolean = False);
+Procedure CheckMethod(aPrefix : string; aIdx : Integer; aData: PVmtMethodExEntry; aName : String; aVisibility : TVisibilityClass; aStrict : Boolean = False);
+Procedure CheckMethod(aPrefix : string; aIdx : Integer; aData: PRecMethodExEntry; aName : String; aVisibility : TVisibilityClass; aStrict : Boolean = False);
+
+implementation
+
+Procedure CheckMethod(aPrefix : string; aIdx : Integer; aData: PRecMethodExEntry; aName : String; aVisibility : TVisibilityClass; aStrict : Boolean = False);
+
+Var
+  Msg : String;
+
+begin
+  Msg:=aPrefix+': Checking method '+IntToStr(aIdx)+' ('+aName+') ';
+  AssertEquals(Msg+'name',aData^.Name,aName);
+  AssertEquals(Msg+'visibility',aVisibility,aData^.MethodVisibility);
+  AssertEquals(Msg+'strict',aData^.StrictVisibility,aStrict);
+end;
+
+
+Procedure CheckMethod(aPrefix : string; aIdx : Integer; aData: PVmtMethodExEntry; aName : String; aVisibility : TVisibilityClass; aStrict : Boolean = False);
+
+Var
+  Msg : String;
+
+begin
+  Msg:=aPrefix+': Checking method '+IntToStr(aIdx)+' ('+aName+') ';
+  AssertEquals(Msg+'name',aData^.Name,aName);
+  AssertEquals(Msg+'visibility',aVisibility,aData^.MethodVisibility);
+  AssertEquals(Msg+'strict',aData^.StrictVisibility,aStrict);
+end;
+
+Procedure CheckProperty(aIdx : Integer; aData: TPropInfoEx; aName : String; aKind : TTypeKind; aVisibility : TVisibilityClass; isStrict : Boolean = False);
+
+Var
+  Msg : String;
+
+begin
+  Msg:='Checking prop '+IntToStr(aIdx)+' ('+aName+') ';
+  AssertEquals(Msg+'name',aName, aData.Info^.Name);
+  AssertEquals(Msg+'kind',aKind, aData.Info^.PropType^.Kind);
+  AssertEquals(Msg+'visibility',aVisibility,aData.Visibility);
+  AssertEquals(Msg+'strict',isStrict,aData.StrictVisibility);
+end;
+
+
+Procedure CheckField(aIdx : Integer; aData: PExtendedVmtFieldEntry; aName : String; aKind : TTypeKind; aVisibility : TVisibilityClass; aStrict : Boolean = False);
+
+Var
+  Msg : String;
+
+begin
+  Msg:='Checking field '+IntToStr(aIdx)+' ('+aName+') ';
+  AssertEquals(Msg+'name',aName,aData^.Name^);
+  AssertEquals(Msg+'kind',aKind,PPTypeInfo(aData^.FieldType)^^.Kind);
+  AssertEquals(Msg+'visibility',aVisibility,aData^.FieldVisibility);
+  AssertEquals(Msg+'strict',aStrict,aData^.StrictVisibility);
+end;
+
+
+Procedure AssertEquals(Msg : String; aExpected,aActual : Integer);
+
+begin
+  If AExpected<>aActual then
+    begin
+    Msg:=Msg+': expected: '+IntToStr(aExpected)+' got: '+IntToStr(aActual);
+    Writeln(Msg);
+    Halt(1);
+    end;
+end;
+
+Procedure AssertEquals(Msg : String; aExpected,aActual : String);
+
+begin
+  If AExpected<>aActual then
+    begin
+    Msg:=Msg+': expected: <'+aExpected+'> got: <'+aActual+'>';
+    Writeln(Msg);
+    Halt(1);
+    end;
+end;
+
+Procedure AssertEquals(Msg : String; aExpected,aActual : TVisibilityClass);
+
+begin
+  If AExpected<>aActual then
+    begin
+    Msg:=Msg+': expected: '+IntToStr(Ord(aExpected))+' got: '+IntToStr(Ord(aActual));
+    Writeln(Msg);
+    Halt(1);
+    end;
+end;
+
+Procedure AssertEquals(Msg : String; aExpected,aActual : TTypeKind);
+
+begin
+  If AExpected<>aActual then
+    begin
+    Msg:=Msg+': expected: '+IntToStr(Ord(aExpected))+' got: '+IntToStr(Ord(aActual));
+    Writeln(Msg);
+    Halt(1);
+    end;
+end;
+
+procedure AssertNotNull(Msg: String; aPointer: Pointer);
+begin
+  if aPointer=Nil then
+    begin
+    Msg:=Msg+': expected not Nil pointer, but got Nil.';
+    Writeln(Msg);
+    Halt(1);
+    end;
+end;
+
+procedure AssertNull(Msg: String; aPointer: Pointer);
+begin
+  if aPointer<>Nil then
+    begin
+    Msg:=Msg+': expected Nil pointer, but got '+HexStr(aPointer);
+    Writeln(Msg);
+    Halt(1);
+    end;
+end;
+
+procedure AssertSame(Msg: String; aExpected, aActual: Pointer);
+begin
+  If AExpected<>aActual then
+    begin
+    Msg:=Msg+': expected: '+HexStr(aExpected)+' got: '+HexStr(aActual);
+    Writeln(Msg);
+    Halt(1);
+    end;
+end;
+
+Procedure AssertEquals(Msg : String; aExpected,aActual : Boolean);
+
+begin
+  If AExpected<>aActual then
+    begin
+    Msg:=Msg+': expected: '+BoolToStr(aExpected,True)+' got: '+BoolToStr(aActual,True);
+    Writeln(Msg);
+    Halt(1);
+    end;
+end;
+
+
+end.
+

+ 218 - 0
tests/test/urtticl.pp

@@ -0,0 +1,218 @@
+unit urtticl;
+
+{$mode ObjFPC}{$H+}
+{$M+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+
+Type
+
+
+{$RTTI EXPLICIT
+      PROPERTIES([vcProtected,vcPublished])
+      FIELDS([vcProtected,vcPublished])
+      METHODS([vcProtected,vcPublished])}
+
+   { TProtectedPublishedFieldRTTI }
+
+   TProtectedPublishedFieldRTTI = Class
+   private
+     FPrivateA: Integer;
+     Property PrivateA : Integer Read FPrivateA Write FPrivateA;
+   strict private
+     FPrivateB: Integer;
+     Property PrivateB : Integer Read FPrivateB Write FPrivateB;
+   Protected
+     FProtectedA: Integer;
+     Property ProtectedA : Integer Read FProtectedA Write FProtectedA;
+   Strict Protected
+     FProtectedB: Integer;
+     Property ProtectedB : Integer Read FProtectedB Write FProtectedB;
+   Public
+     FPublicA: Integer;
+     FPublicB: Integer;
+     Property PublicA : Integer Read FPublicA Write FPublicA;
+     Property PublicB : Integer Read FPublicA Write FPublicB;
+   Published
+     FPublishedA: Integer;
+     FPublishedB: Integer;
+     Property PublishedA : Integer Read FPublishedA Write FPublishedA;
+     Property PublishedB : Integer Read FPublishedA Write FPublishedB;
+   end;
+
+   { TProtectedPublishedMethodClassRTTI }
+
+   TProtectedPublishedMethodClassRTTI = Class (TObject)
+   private
+     Procedure PrivateMethodA;
+   strict private
+     Procedure PrivateMethodB; virtual;
+   private
+     Procedure PrivateMethodC; virtual; abstract;
+   protected
+     Procedure ProtectedMethodA;
+   strict protected
+     Procedure ProtectedMethodB; virtual;
+   protected
+     Procedure ProtectedMethodC; virtual; abstract;
+   public
+     Procedure PublicMethodA;
+     Procedure PublicMethodB; virtual;
+     Procedure PublicMethodC; virtual; abstract;
+   published
+     Procedure PublishedMethodA;
+     Procedure PublishedMethodB; virtual;
+     Procedure PublishedMethodC; virtual; abstract;
+   end;
+
+
+implementation
+
+{ TPrivatePublicMethodClassRTTI }
+
+
+{ TProtectedPublishedMethodClassRTTI }
+
+procedure TProtectedPublishedMethodClassRTTI.PrivateMethodA;
+begin
+
+end;
+
+procedure TProtectedPublishedMethodClassRTTI.PrivateMethodB;
+begin
+
+end;
+
+procedure TProtectedPublishedMethodClassRTTI.ProtectedMethodA;
+begin
+
+end;
+
+procedure TProtectedPublishedMethodClassRTTI.ProtectedMethodB;
+begin
+
+end;
+
+procedure TProtectedPublishedMethodClassRTTI.PublicMethodA;
+begin
+
+end;
+
+procedure TProtectedPublishedMethodClassRTTI.PublicMethodB;
+begin
+
+end;
+
+procedure TProtectedPublishedMethodClassRTTI.PublishedMethodA;
+begin
+
+end;
+
+procedure TProtectedPublishedMethodClassRTTI.PublishedMethodB;
+begin
+
+end;
+
+(*
+{$RTTI EXPLICIT
+   PROPERTIES([vcPrivate,vcPublic])
+   FIELDS([vcPrivate,vcPublic])
+   METHODS([vcPrivate,vcPublic])}
+*)
+
+{ TFieldRTTI }
+type
+TFieldRTTI = Class
+private
+  FPrivateA: Integer;
+  Property PrivateA : Integer Read FPrivateA Write FPrivateA;
+strict private
+  FPrivateB: Integer;
+  Property PrivateB : Integer Read FPrivateB Write FPrivateB;
+Protected
+  FProtectedA: Integer;
+  Property ProtectedA : Integer Read FProtectedA Write FProtectedA;
+Strict Protected
+  FProtectedB: Integer;
+  Property ProtectedB : Integer Read FProtectedB Write FProtectedB;
+Public
+  FPublicA: Integer;
+  FPublicB: Integer;
+  Property PublicA : Integer Read FPublicA Write FPublicA;
+  Property PublicB : Integer Read FPublicA Write FPublicB;
+end;
+
+{ TMethodClassRTTI }
+
+TMethodClassRTTI = Class (TObject)
+private
+  Procedure PrivateMethodA;
+strict private
+  Procedure PrivateMethodB; virtual;
+private
+  Procedure PrivateMethodC; virtual; abstract;
+protected
+  Procedure ProtectedMethodA;
+strict protected
+  Procedure ProtectedMethodB; virtual;
+protected
+  Procedure ProtectedMethodC; virtual; abstract;
+public
+  Procedure PublicMethodA;
+  Procedure PublicMethodB; virtual;
+  Procedure PublicMethodC; virtual; abstract;
+published
+  Procedure PublishedMethodA;
+  Procedure PublishedMethodB; virtual;
+  Procedure PublishedMethodC; virtual; abstract;
+end;
+
+{ TMethodClassRTTI }
+
+procedure TMethodClassRTTI.PrivateMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PrivateMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.ProtectedMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublicMethodB;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodA;
+begin
+
+end;
+
+procedure TMethodClassRTTI.PublishedMethodB;
+begin
+
+end;
+
+
+end.
+