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

* Allow to cast pointer TValue to class pointer. Patch from Lipinast Lekrisov

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-12-17 17:39:09 +01:00
parent 5945722811
commit 69140d22eb
1 changed files with 13 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -185,6 +185,7 @@ type
procedure CastInterfaceToInterface(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
procedure CastFromInterface(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
// From Pointer
procedure CastPointerToClass(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
procedure CastFromPointer(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
// From set
procedure CastSetToSet(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
@ -3436,11 +3437,23 @@ begin
end;
end;
Procedure TValue.CastPointerToClass(out aRes : Boolean; out ADest: TValue; aDestType: PTypeInfo);
var
Tmp: Pointer;
begin
Tmp:=AsPointer;
TValue.Make(@Tmp,aDestType,aDest);
aRes:=True;
end;
Procedure TValue.CastFromPointer(out aRes : Boolean; out ADest: TValue; aDestType: PTypeInfo);
begin
Case aDestType^.Kind of
tkPointer, tkProcedure: CastAssign(aRes,aDest,aDestType);
tkClass: CastPointerToClass(aRes,aDest,aDestType);
else
aRes:=False;
end;