paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 08:51:39 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Allow %o, let %p handle object pointers and class pointers. Fixes issue #40762

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-10-09 09:10:51 +02:00
parent 23bbf87c10
commit a2deb9cbf1
1 changed files with 28 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
rtl/objpas/sysutils/sysformt.inc
View File

@ -371,9 +371,34 @@ begin
SetLength(hs,Prec);
ToAdd:=hs;
end;
'P' : Begin
CheckArg(vtpointer,true);
ToAdd:=TFormatString(HexStr(ptruint(Args[DoArg].VPointer),sizeof(Ptruint)*2));
'O' :
begin
if CheckArg(vtClass,false) then
begin
if (Args[DoArg].VClass=Nil) then
ToAdd:='<Nil>'
else
ToAdd:=TFormatString(Args[DoArg].VClass.ClassName);
end
else
begin
CheckArg(vtObject,True);
if (Args[DoArg].VObject=Nil) then
ToAdd:='<Nil>'
else
ToAdd:=TFormatString(Args[DoArg].VObject.ToString);
end
end;
'P' : begin
if CheckArg(vtObject,false) then
ToAdd:=TFormatString(HexStr(ptruint(Args[DoArg].VObject),sizeof(Ptruint)*2))
else if CheckArg(vtClass,false) then
ToAdd:=TFormatString(HexStr(ptruint(Args[DoArg].VClass),sizeof(Ptruint)*2))
else
begin
CheckArg(vtpointer,true);
ToAdd:=TFormatString(HexStr(ptruint(Args[DoArg].VPointer),sizeof(Ptruint)*2));
end;
// Insert ':'. Is this needed in 32 bit ? No it isn't.
// Insert(':',ToAdd,5);
end;