paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 18:49:16 +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 CastInterfaceToInterface(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
procedure CastFromInterface(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo); procedure CastFromInterface(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
// From Pointer // From Pointer
procedure CastPointerToClass(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
procedure CastFromPointer(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo); procedure CastFromPointer(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
// From set // From set
procedure CastSetToSet(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo); procedure CastSetToSet(out aRes: Boolean; out ADest: TValue; aDestType: PTypeInfo);
@ -3436,11 +3437,23 @@ begin
end; end;
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); Procedure TValue.CastFromPointer(out aRes : Boolean; out ADest: TValue; aDestType: PTypeInfo);
begin begin
Case aDestType^.Kind of Case aDestType^.Kind of
tkPointer, tkProcedure: CastAssign(aRes,aDest,aDestType); tkPointer, tkProcedure: CastAssign(aRes,aDest,aDestType);
tkClass: CastPointerToClass(aRes,aDest,aDestType);
else else
aRes:=False; aRes:=False;
end; end;