paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-11 22:08:18 +02:00
Code Issues Packages Projects Releases Wiki Activity
basemath
fpc/tests/test/texrtti10.pp
Michaël Van Canneyt a98462835e * Extended RTTI tests
2024-01-02 07:24:31 +01:00

350 lines
10 KiB
ObjectPascal
Raw Permalink Blame History

{$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.
Reference in New Issue View Git Blame Copy Permalink