From 6e52b7195d525139683af4f5e40e634d97df208f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= Date: Sat, 15 Jul 2023 18:16:32 +0200 Subject: [PATCH] * Fix compilation --- packages/rtl-objpas/tests/tests.rtti.pas | 389 ----------------------- 1 file changed, 389 deletions(-) diff --git a/packages/rtl-objpas/tests/tests.rtti.pas b/packages/rtl-objpas/tests/tests.rtti.pas index 05158ab7eb..4745ebf6ae 100644 --- a/packages/rtl-objpas/tests/tests.rtti.pas +++ b/packages/rtl-objpas/tests/tests.rtti.pas @@ -1197,396 +1197,7 @@ begin end; - - -<<<<<<< HEAD procedure TTestRTTI.TestInterface; -======= - test.value1 := 42; - test.value2 := 'Hello World'; - TValue.Make(@test, TypeInfo(TTestRecord), value); - Check(value.GetReferenceToRawData <> @test, 'Reference to record is equal'); - Check(PTestRecord(value.GetReferenceToRawData)^.value1 = PTestRecord(@test)^.value1, 'Reference to record data value1 differs'); - Check(PTestRecord(value.GetReferenceToRawData)^.value2 = PTestRecord(@test)^.value2, 'Reference to record data value2 differs'); - - SetLength(arrdyn, 3); - arrdyn[0] := 42; - arrdyn[1] := 23; - arrdyn[2] := 49; - TValue.Make(@arrdyn, TypeInfo(TArrayOfLongintDyn), value); - Check(PPointer(value.GetReferenceToRawData)^ = Pointer(arrdyn), 'Reference to dynamic array data differs'); - - arrstat[0] := 42; - arrstat[1] := 23; - arrstat[2] := 49; - arrstat[3] := 59; - TValue.Make(@arrstat, TypeInfo(TArrayOfLongintStatic), value); - Check(value.GetReferenceToRawData <> @arrstat, 'Reference to static array is equal'); - Check(PLongInt(value.GetReferenceToRawData)^ = PLongInt(@arrstat)^, 'Reference to static array data differs'); -end; - -procedure TTestCase1.TestReferenceRawDataEmpty; -var - value: TValue; -begin - TValue.Make(Nil, TypeInfo(String), value); - Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty String is not assigned'); - Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty String data is assigned'); - - TValue.Make(Nil, TypeInfo(IInterface), value); - Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty interface is not assigned'); - Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty interface data is assigned'); - - TValue.Make(Nil, TypeInfo(LongInt), value); - Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty LongInt is not assigned'); - Check(PLongInt(value.GetReferenceToRawData)^ = 0, 'Empty longint data is not 0'); - - TValue.Make(Nil, TypeInfo(TTestRecord), value); - Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty record is not assigned'); - Check(PTestRecord(value.GetReferenceToRawData)^.value1 = 0, 'Empty record data value1 is not 0'); - Check(PTestRecord(value.GetReferenceToRawData)^.value2 = '', 'Empty record data value2 is not empty'); - - TValue.Make(Nil, TypeInfo(TArrayOfLongintDyn), value); - Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty dynamic array is not assigned'); - Check(not Assigned(PPointer(value.GetReferenceToRawData)^), 'Empty dynamic array data is assigned'); - - TValue.Make(Nil, TypeInfo(TArrayOfLongintStatic), value); - Check(Assigned(value.GetReferenceToRawData()), 'Reference to empty static array is not assigned'); - Check(PLongInt(value.GetReferenceToRawData)^ = 0, 'Empty static array data is not 0'); -end; - -procedure TTestCase1.TestDataSize; -var - u8: UInt8; - u16: UInt16; - u32: UInt32; - u64: UInt64; - s8: Int8; - s16: Int16; - s32: Int32; - s64: Int64; - f32: Single; - f64: Double; -{$ifdef FPC_HAS_TYPE_EXTENDED} - f80: Extended; -{$endif} - fco: Comp; - fcu: Currency; - ss: ShortString; - sa: AnsiString; - su: UnicodeString; - sw: WideString; - o: TObject; - c: TClass; - i: IInterface; - ad: TArrayOfLongintDyn; - _as: TArrayOfLongintStatic; - b8: Boolean; -{$ifdef fpc} - b16: Boolean16; - b32: Boolean32; - b64: Boolean64; -{$endif} - bl8: ByteBool; - bl16: WordBool; - bl32: LongBool; -{$ifdef fpc} - bl64: QWordBool; -{$endif} - e: TTestEnum; - s: TTestSet; - t: TTestRecord; - p: Pointer; - proc: TTestProc; - method: TTestMethod; - - value: TValue; -begin - u8:=245; - TValue.Make(@u8, TypeInfo(UInt8), value); - CheckEquals(1, value.DataSize, 'Size of UInt8 differs'); - u16:=789; - TValue.Make(@u16, TypeInfo(UInt16), value); - CheckEquals(2, value.DataSize, 'Size of UInt16 differs'); - u32:=568789; - TValue.Make(@u32, TypeInfo(UInt32), value); - CheckEquals(4, value.DataSize, 'Size of UInt32 differs'); - u64:=$abdcefadbcef; - TValue.Make(@u64, TypeInfo(UInt64), value); - CheckEquals(8, value.DataSize, 'Size of UInt64 differs'); - s8:=-32; - TValue.Make(@s8, TypeInfo(Int8), value); - CheckEquals(1, value.DataSize, 'Size of Int8 differs'); - s16:=-5345; - TValue.Make(@s16, TypeInfo(Int16), value); - CheckEquals(2, value.DataSize, 'Size of Int16 differs'); - s32:=-234567; - TValue.Make(@s32, TypeInfo(Int32), value); - CheckEquals(4, value.DataSize, 'Size of Int32 differs'); - s64:=23456789012; - TValue.Make(@s64, TypeInfo(Int64), value); - CheckEquals(8, value.DataSize, 'Size of Int64 differs'); - b8:=false; - TValue.Make(@b8, TypeInfo(Boolean), value); - CheckEquals(1, value.DataSize, 'Size of Boolean differs'); -{$ifdef fpc} - b16:=true; - TValue.Make(@b16, TypeInfo(Boolean16), value); - CheckEquals(2, value.DataSize, 'Size of Boolean16 differs'); - b32:=false; - TValue.Make(@b32, TypeInfo(Boolean32), value); - CheckEquals(4, value.DataSize, 'Size of Boolean32 differs'); - b64:=true; - TValue.Make(@b64, TypeInfo(Boolean64), value); - CheckEquals(8, value.DataSize, 'Size of Boolean64 differs'); -{$endif} - bl8:=true; - TValue.Make(@bl8, TypeInfo(ByteBool), value); - CheckEquals(1, value.DataSize, 'Size of ByteBool differs'); - bl16:=false; - TValue.Make(@bl16, TypeInfo(WordBool), value); - CheckEquals(2, value.DataSize, 'Size of WordBool differs'); - bl32:=false; - TValue.Make(@bl32, TypeInfo(LongBool), value); - CheckEquals(4, value.DataSize, 'Size of LongBool differs'); -{$ifdef fpc} - bl64:=true; - TValue.Make(@bl64, TypeInfo(QWordBool), value); - CheckEquals(8, value.DataSize, 'Size of QWordBool differs'); -{$endif} - f32:=4.567; - TValue.Make(@f32, TypeInfo(Single), value); - CheckEquals(4, value.DataSize, 'Size of Single differs'); - f64:=-3456.678; - TValue.Make(@f64, TypeInfo(Double), value); - CheckEquals(8, value.DataSize, 'Size of Double differs'); -{$ifdef FPC_HAS_TYPE_EXTENDED} - f80:=-2345.678; - TValue.Make(@f80, TypeInfo(Extended), value); - CheckEquals(10, value.DataSize, 'Size of Extended differs'); -{$endif} - fcu:=56.78; - TValue.Make(@fcu, TypeInfo(Currency), value); - CheckEquals(SizeOf(Currency), value.DataSize, 'Size of Currency differs'); - fco:=456; - TValue.Make(@fco, TypeInfo(Comp), value); - CheckEquals(SizeOf(Comp), value.DataSize, 'Size of Comp differs'); - ss := ''; - TValue.Make(@ss, TypeInfo(ShortString), value); - CheckEquals(254, value.DataSize, 'Size ofShortString differs'); - sa:= ''; - TValue.Make(@sa, TypeInfo(AnsiString), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of AnsiString differs'); - sw := ''; - TValue.Make(@sw, TypeInfo(WideString), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of WideString differs'); - su:=''; - TValue.Make(@su, TypeInfo(UnicodeString), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of UnicodeString differs'); - o := TTestValueClass.Create; - TValue.Make(@o, TypeInfo(TObject), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TObject differs'); - o.Free; - c := TObject; - TValue.Make(@c, TypeInfo(TClass), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TClass differs'); - i := Nil; - TValue.Make(@i, TypeInfo(IInterface), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of IInterface differs'); - TValue.Make(@t, TypeInfo(TTestRecord), value); - CheckEquals(SizeOf(TTestRecord), value.DataSize, 'Size of TTestRecord differs'); - proc := Nil; - TValue.Make(@proc, TypeInfo(TTestProc), value); - CheckEquals(SizeOf(TTestProc), value.DataSize, 'Size of TTestProc differs'); - method := Nil; - TValue.Make(@method, TypeInfo(TTestMethod), value); - CheckEquals(SizeOf(TTestMethod), value.DataSize, 'Size of TTestMethod differs'); - TValue.Make(@_as, TypeInfo(TArrayOfLongintStatic), value); - CheckEquals(SizeOf(TArrayOfLongintStatic), value.DataSize, 'Size of TArrayOfLongintStatic differs'); - TValue.Make(@ad, TypeInfo(TArrayOfLongintDyn), value); - CheckEquals(SizeOf(TArrayOfLongintDyn), value.DataSize, 'Size of TArrayOfLongintDyn differs'); - e:=low(TTestEnum); - TValue.Make(@e, TypeInfo(TTestEnum), value); - CheckEquals(SizeOf(TTestEnum), value.DataSize, 'Size of TTestEnum differs'); - s:=[low(TTestEnum),high(TTestEnum)]; - TValue.Make(@s, TypeInfo(TTestSet), value); - CheckEquals(SizeOf(TTestSet), value.DataSize, 'Size of TTestSet differs'); - p := Nil; - TValue.Make(@p, TypeInfo(Pointer), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs'); -end; - -procedure TTestCase1.TestDataSizeEmpty; -var - value: TValue; -begin - TValue.Make(Nil, TypeInfo(UInt8), value); - CheckEquals(1, value.DataSize, 'Size of UInt8 differs'); - TValue.Make(Nil, TypeInfo(UInt16), value); - CheckEquals(2, value.DataSize, 'Size of UInt16 differs'); - TValue.Make(Nil, TypeInfo(UInt32), value); - CheckEquals(4, value.DataSize, 'Size of UInt32 differs'); - TValue.Make(Nil, TypeInfo(UInt64), value); - CheckEquals(8, value.DataSize, 'Size of UInt64 differs'); - TValue.Make(Nil, TypeInfo(Int8), value); - CheckEquals(1, value.DataSize, 'Size of Int8 differs'); - TValue.Make(Nil, TypeInfo(Int16), value); - CheckEquals(2, value.DataSize, 'Size of Int16 differs'); - TValue.Make(Nil, TypeInfo(Int32), value); - CheckEquals(4, value.DataSize, 'Size of Int32 differs'); - TValue.Make(Nil, TypeInfo(Int64), value); - CheckEquals(8, value.DataSize, 'Size of Int64 differs'); - TValue.Make(Nil, TypeInfo(Boolean), value); - CheckEquals(1, value.DataSize, 'Size of Boolean differs'); -{$ifdef fpc} - TValue.Make(Nil, TypeInfo(Boolean16), value); - CheckEquals(2, value.DataSize, 'Size of Boolean16 differs'); - TValue.Make(Nil, TypeInfo(Boolean32), value); - CheckEquals(4, value.DataSize, 'Size of Boolean32 differs'); - TValue.Make(Nil, TypeInfo(Boolean64), value); - CheckEquals(8, value.DataSize, 'Size of Boolean64 differs'); -{$endif} - TValue.Make(Nil, TypeInfo(ByteBool), value); - CheckEquals(1, value.DataSize, 'Size of ByteBool differs'); - TValue.Make(Nil, TypeInfo(WordBool), value); - CheckEquals(2, value.DataSize, 'Size of WordBool differs'); - TValue.Make(Nil, TypeInfo(LongBool), value); - CheckEquals(4, value.DataSize, 'Size of LongBool differs'); -{$ifdef fpc} - TValue.Make(Nil, TypeInfo(QWordBool), value); - CheckEquals(8, value.DataSize, 'Size of QWordBool differs'); -{$endif} - TValue.Make(Nil, TypeInfo(Single), value); - CheckEquals(4, value.DataSize, 'Size of Single differs'); - TValue.Make(Nil, TypeInfo(Double), value); - CheckEquals(8, value.DataSize, 'Size of Double differs'); -{$ifdef FPC_HAS_TYPE_EXTENDED} - TValue.Make(Nil, TypeInfo(Extended), value); - CheckEquals(10, value.DataSize, 'Size of Extended differs'); -{$endif} - TValue.Make(Nil, TypeInfo(Currency), value); - CheckEquals(SizeOf(Currency), value.DataSize, 'Size of Currency differs'); - TValue.Make(Nil, TypeInfo(Comp), value); - CheckEquals(SizeOf(Comp), value.DataSize, 'Size of Comp differs'); - TValue.Make(Nil, TypeInfo(ShortString), value); - CheckEquals(254, value.DataSize, 'Size of ShortString differs'); - TValue.Make(Nil, TypeInfo(AnsiString), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs'); - TValue.Make(Nil, TypeInfo(WideString), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of WideString differs'); - TValue.Make(Nil, TypeInfo(UnicodeString), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of UnicodeString differs'); - TValue.Make(Nil, TypeInfo(TObject), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TObject differs'); - TValue.Make(Nil, TypeInfo(TClass), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of TClass differs'); - TValue.Make(Nil, TypeInfo(IInterface), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of IInterface differs'); - TValue.Make(Nil, TypeInfo(TTestRecord), value); - CheckEquals(SizeOf(TTestRecord), value.DataSize, 'Size of TTestRecord differs'); - TValue.Make(Nil, TypeInfo(TTestProc), value); - CheckEquals(SizeOf(TTestProc), value.DataSize, 'Size of TTestProc differs'); - TValue.Make(Nil, TypeInfo(TTestMethod), value); - CheckEquals(SizeOf(TTestMethod), value.DataSize, 'Size of TTestMethod differs'); - TValue.Make(Nil, TypeInfo(TArrayOfLongintStatic), value); - CheckEquals(SizeOf(TArrayOfLongintStatic), value.DataSize, 'Size of TArrayOfLongintStatic differs'); - TValue.Make(Nil, TypeInfo(TArrayOfLongintDyn), value); - CheckEquals(SizeOf(TArrayOfLongintDyn), value.DataSize, 'Size of TArrayOfLongintDyn differs'); - TValue.Make(Nil, TypeInfo(TTestEnum), value); - CheckEquals(SizeOf(TTestEnum), value.DataSize, 'Size of TTestEnum differs'); - TValue.Make(Nil, TypeInfo(TTestSet), value); - CheckEquals(SizeOf(TTestSet), value.DataSize, 'Size of TTestSet differs'); - TValue.Make(Nil, TypeInfo(Pointer), value); - CheckEquals(SizeOf(Pointer), value.DataSize, 'Size of Pointer differs'); -end; - -procedure TTestCase1.TestIsManaged; -begin - CheckEquals(true, IsManaged(TypeInfo(ansistring)), 'IsManaged for tkAString'); - CheckEquals(true, IsManaged(TypeInfo(widestring)), 'IsManaged for tkWString'); - CheckEquals(true, IsManaged(TypeInfo(Variant)), 'IsManaged for tkVariant'); - CheckEquals(true, IsManaged(TypeInfo(TArrayOfManagedRec)), - 'IsManaged for tkArray (with managed ElType)'); - CheckEquals(true, IsManaged(TypeInfo(TArrayOfString)), - 'IsManaged for tkArray (with managed ElType)'); - CheckEquals(true, IsManaged(TypeInfo(TManagedRec)), 'IsManaged for tkRecord'); - {$ifdef fpc} - CheckEquals(true, IsManaged(TypeInfo(TManagedRecOp)), 'IsManaged for tkRecord'); - {$endif} - CheckEquals(true, IsManaged(TypeInfo(IInterface)), 'IsManaged for tkInterface'); - CheckEquals(true, IsManaged(TypeInfo(TManagedObj)), 'IsManaged for tkObject'); - {$ifdef fpc} - CheckEquals(true, IsManaged(TypeInfo(specialize TArray)), 'IsManaged for tkDynArray'); - {$else} - CheckEquals(true, IsManaged(TypeInfo(TArray)), 'IsManaged for tkDynArray'); - {$endif} - CheckEquals(true, IsManaged(TypeInfo(unicodestring)), 'IsManaged for tkUString'); - CheckEquals(false, IsManaged(TypeInfo(shortstring)), 'IsManaged for tkSString'); - CheckEquals(false, IsManaged(TypeInfo(Byte)), 'IsManaged for tkInteger'); - CheckEquals(false, IsManaged(TypeInfo(AnsiChar)), 'IsManaged for tkChar'); - CheckEquals(false, IsManaged(TypeInfo(TTestEnum)), 'IsManaged for tkEnumeration'); - CheckEquals(false, IsManaged(TypeInfo(Single)), 'IsManaged for tkFloat'); - CheckEquals(false, IsManaged(TypeInfo(TTestSet)), 'IsManaged for tkSet'); - {$ifdef fpc} - CheckEquals(false, IsManaged(TypeInfo(TTestMethod)), 'IsManaged for tkMethod'); - {$else} - { Delphi bug (or sabotage). For some reason Delphi considers method pointers to be managed (only in newer versions, probably since XE7) :/ } - CheckEquals({$if RTLVersion>=28}true{$else}false{$endif}, IsManaged(TypeInfo(TTestMethod)), 'IsManaged for tkMethod'); - {$endif} - CheckEquals(false, IsManaged(TypeInfo(TArrayOfByte)), - 'IsManaged for tkArray (with non managed ElType)'); - CheckEquals(false, IsManaged(TypeInfo(TArrayOfNonManagedRec)), - 'IsManaged for tkArray (with non managed ElType)'); - CheckEquals(false, IsManaged(TypeInfo(TNonManagedRec)), 'IsManaged for tkRecord'); - CheckEquals(false, IsManaged(TypeInfo(TObject)), 'IsManaged for tkClass'); - CheckEquals(false, IsManaged(TypeInfo(TNonManagedObj)), 'IsManaged for tkObject'); - CheckEquals(false, IsManaged(TypeInfo(WideChar)), 'IsManaged for tkWChar'); - CheckEquals(false, IsManaged(TypeInfo(Boolean)), 'IsManaged for tkBool'); - CheckEquals(false, IsManaged(TypeInfo(Int64)), 'IsManaged for tkInt64'); - CheckEquals(false, IsManaged(TypeInfo(UInt64)), 'IsManaged for tkQWord'); - {$ifdef fpc} - CheckEquals(false, IsManaged(TypeInfo(ICORBATest)), 'IsManaged for tkInterfaceRaw'); - {$endif} - CheckEquals(false, IsManaged(TypeInfo(TTestProc)), 'IsManaged for tkProcVar'); - CheckEquals(false, IsManaged(TypeInfo(TTestHelper)), 'IsManaged for tkHelper'); - {$ifdef fpc} - CheckEquals(false, IsManaged(TypeInfo(file)), 'IsManaged for tkFile'); - {$endif} - CheckEquals(false, IsManaged(TypeInfo(TClass)), 'IsManaged for tkClassRef'); - CheckEquals(false, IsManaged(TypeInfo(Pointer)), 'IsManaged for tkPointer'); - CheckEquals(false, IsManaged(nil), 'IsManaged for nil'); -end; - -{$ifdef fpc} -procedure TTestCase1.TestOpenArrayToDyn; - - procedure OpenArrayProc(aArr: array of LongInt); - var - value: TValue; - begin -{$ifndef InLazIDE} - value := specialize OpenArrayToDynArrayValue(aArr); -{$endif} - CheckEquals(value.IsArray, True); - CheckEquals(value.IsOpenArray, False); - CheckEquals(value.IsObject, False); - CheckEquals(value.IsOrdinal, False); - CheckEquals(value.IsClass, False); - CheckEquals(value.GetArrayLength, 2); - CheckEquals(value.GetArrayElement(0).AsInteger, 42); - CheckEquals(value.GetArrayElement(1).AsInteger, 84); - value.SetArrayElement(0, 21); - { since this is a copy the original array is not modified! } - CheckEquals(aArr[0], 42); - end; - -begin - OpenArrayProc([42, 84]); -end; -{$endif} - -procedure TTestCase1.TestInterface; ->>>>>>> a86fa16f98 (* PChar -> PAnsiChar) var context: TRttiContext; t: TRttiType;