paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 13:00:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow assign of pointer to TValue. Patch by Lipinast Lekrisov

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-12-17 17:26:33 +01:00
parent bb2d12457c
commit 1c816990c3
2 changed files with 15 additions and 2 deletions
packages/rtl-objpas
src/inc
rtti.pp
tests
tests.rtti.value.pas

7
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -282,6 +282,7 @@ type
class operator := (AValue: QWord): TValue; inline;
class operator := (AValue: TObject): TValue; inline;
class operator := (AValue: TClass): TValue; inline;
class operator := (AValue: Pointer): TValue; inline;
class operator := (AValue: Boolean): TValue; inline;
class operator := (AValue: IUnknown): TValue; inline;
class operator := (AValue: TVarRec): TValue; inline;
@ -2386,7 +2387,6 @@ begin
Make(@AValue, System.TypeInfo(AValue), Result);
end;
class operator TValue.:=(const AValue: WideString): TValue;
begin
Make(@AValue, System.TypeInfo(AValue), Result);
@ -2472,6 +2472,11 @@ begin
Make(@AValue, System.TypeInfo(AValue), Result);
end;
class operator TValue.:=(AValue: Pointer): TValue;
begin
Make(@AValue, System.TypeInfo(AValue), Result);
end;
class operator TValue.:=(AValue: Boolean): TValue;
begin
Make(@AValue, System.TypeInfo(AValue), Result);

10
packages/rtl-objpas/tests/tests.rtti.value.pas
View File

@ -17,6 +17,7 @@ Type
procedure TestReferenceRawDataEmpty;
procedure TestIsManaged;
procedure TestCasts;
procedure TestAssignPointer;
end;
TTestValueSimple = Class(TTestCase)
@ -1959,7 +1960,14 @@ begin
.{$ifdef fpc}specialize{$endif} Cast<AnsiString>
.{$ifdef fpc}specialize{$endif} AsType<AnsiString>, 'TValue.From<shortring>.Cast<AnsiString> failed');
end;
procedure TTestValueGeneral.TestAssignPointer;
var
V : TValue;
begin
V:=Pointer(Nil);
AssertSame('Correct type info', TypeInfo(Pointer),V.TypeInfo);
end;
procedure TTestValueGeneral.TestReferenceRawData;
var