mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-27 15:39:42 +02:00
* Forgot to add file
This commit is contained in:
parent
7bdd8105dd
commit
7230673b6c
192
packages/rtl-objpas/tests/tests.rtti.types.pas
Normal file
192
packages/rtl-objpas/tests/tests.rtti.types.pas
Normal 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.
|
||||
|
Loading…
Reference in New Issue
Block a user