浏览代码

* Forgot to add file

Michaël Van Canneyt 2 年之前
父节点
当前提交
462536ca9b
共有 1 个文件被更改,包括 192 次插入0 次删除
  1. 192 0
      packages/rtl-objpas/tests/tests.rtti.types.pas

+ 192 - 0
packages/rtl-objpas/tests/tests.rtti.types.pas

@@ -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.
+