mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 15:28:08 +02:00
165 lines
3.0 KiB
ObjectPascal
165 lines
3.0 KiB
ObjectPascal
{$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.
|
|
|