freepascal.compiler/packages/rtl-objpas/tests/tests.rtti.types.pas

unit tests.rtti.types;

{$ifdef fpc}
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
{$modeswitch prefixedattributes}
{$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}

  { TMyAttribute }

  TMyAttribute = class(TCustomAttribute)
  private
    FValue: string;
  public
    constructor create(const avalue : string);
    property value : string read FValue;
  end;


  { TMyAnnotatedClass }

  [TMyAttribute('something')]
  TMyAnnotatedClass = class
  private
    FSomething: String;
  Published
    Property Something : String Read FSomething Write FSomeThing;
  end;

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;

{ TMyAttribute }

constructor TMyAttribute.create(const avalue: string);
begin
  FValue:=aValue;
end;

{$ifdef fpc}
class operator TManagedRecOp.AddRef(var  a: TManagedRecOp);
begin
end;
{$endif}


end.