* Forgot to add file

This commit is contained in:
Michaël Van Canneyt 2023-06-02 12:02:10 +02:00 committed by Pierre Muller
parent 7bdd8105dd
commit 7230673b6c

View File

@ -0,0 +1,192 @@
unit tests.rtti.types;
{$ifdef fpc}
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
{$endif}
interface
uses
Classes, SysUtils;
Type
{$M+}
TGetClassProperties = class
private
FPubPropRO: integer;
FPubPropRW: integer;
published
property PubPropRO: integer read FPubPropRO;
property PubPropRW: integer read FPubPropRW write FPubPropRW;
property PubPropSetRO: integer read FPubPropRO;
property PubPropSetRW: integer read FPubPropRW write FPubPropRW;
end;
TGetClassPropertiesSub = class(TGetClassProperties)
end;
{$M+}
ITestInterface = interface
procedure Test;
function Test2: LongInt;
procedure Test3(aArg1: LongInt; const aArg2: AnsiString; var aArg3: Boolean; out aArg4: Word);
function Test4(aArg1: array of LongInt; aArg2: array of const): AnsiString;
end;
{$M-}
TManagedRec = record
s: string;
end;
{$ifdef fpc}
TManagedRecOp = record
class operator AddRef(var a: TManagedRecOp);
end;
{$endif}
TNonManagedRec = record
i: Integer;
end;
TManagedObj = object
i: IInterface;
end;
TNonManagedObj = object
d: double;
end;
TTestEnum = (te1, te2, te3, te4, te5);
TTestSet = set of TTestEnum;
TTestProc = procedure;
TTestFunc1 = function: LongInt;
TTestFunc2 = function(aArg1: LongInt; aArg2: array of LongInt): String;
TTestMethod = procedure of object;
TTestMethod1 = function: LongInt of object;
TTestMethod2 = function(aArg1: LongInt; aArg2: array of LongInt): String of object;
TTestHelper = class helper for TObject
end;
TTestRecord = record
Value1: LongInt;
Value2: String;
end;
PTestRecord = ^TTestRecord;
TArrayOfString = array[0..0] of string;
TArrayOfManagedRec = array[0..0] of TManagedRec;
TArrayOfNonManagedRec = array[0..0] of TNonManagedRec;
TArrayOfByte = array[0..0] of byte;
TArrayOfLongintDyn = array of LongInt;
TArrayOfLongintStatic = array[0..3] of LongInt;
TArrayOfLongint2DStatic = array[0..3, 2..4] of LongInt;
TTestDynArray = array of Integer;
TTestEnumeration = (en1, en2, en3, en4);
{$M-}
{ TTestValueClass }
{$M+}
TTestValueClass = class
private
FAArray: TTestDynArray;
FAChar: AnsiChar;
FAComp: Comp;
FACurrency: Currency;
FADouble: Double;
FAEnumeration: TTestEnumeration;
FAExtended: Extended;
FAInteger: integer;
FAObject: TObject;
FASingle: Single;
FAString: string;
FABoolean: boolean;
FAShortString: ShortString;
FAUnknown: IUnknown;
FAWideChar: WideChar;
function GetAInteger: integer;
function GetAString: string;
function GetABoolean: boolean;
function GetAShortString: ShortString;
procedure SetWriteOnly(AValue: integer);
published
property AArray: TTestDynArray read FAArray write FAArray;
property AEnumeration: TTestEnumeration read FAEnumeration write FAEnumeration;
property AInteger: Integer read FAInteger write FAInteger;
property AString: string read FAString write FAString;
property ASingle: Single read FASingle write FASingle;
property ADouble: Double read FADouble write FADouble;
property AExtended: Extended read FAExtended write FAExtended;
property ACurrency: Currency read FACurrency write FACurrency;
property AObject: TObject read FAObject write FAObject;
property AUnknown: IUnknown read FAUnknown write FAUnknown;
property AComp: Comp read FAComp write FAComp;
property ABoolean: boolean read FABoolean write FABoolean;
property AShortString: ShortString read FAShortString write FAShortString;
property AGetInteger: Integer read GetAInteger;
property AGetString: string read GetAString;
property AGetBoolean: boolean read GetABoolean;
property AGetShortString: ShortString read GetAShortString;
property AWriteOnly: integer write SetWriteOnly;
property AChar: AnsiChar read FAChar write FAChar;
property AWideChar: WideChar read FAWideChar write FAWideChar;
end;
{$M-}
{$ifdef fpc}
{$PUSH}
{$INTERFACES CORBA}
ICORBATest = interface
end;
{$POP}
{$endif}
implementation
{ TTestValueClass }
function TTestValueClass.GetAInteger: integer;
begin
result := FAInteger;
end;
function TTestValueClass.GetAString: string;
begin
result := FAString;
end;
function TTestValueClass.GetABoolean: boolean;
begin
result := FABoolean;
end;
function TTestValueClass.GetAShortString: ShortString;
begin
Result := FAShortString;
end;
procedure TTestValueClass.SetWriteOnly(AValue: integer);
begin
// Do nothing
end;
{$ifdef fpc}
class operator TManagedRecOp.AddRef(var a: TManagedRecOp);
begin
end;
{$endif}
end.