* fix #38122 in a more correct way than previously done: instead of adjusting the methodpointer node when it's a deref node adjust what value is stored in a temp if a call node is encountered: store the pointer value, not the pointed to value to avoid the reference getting lost

+ added test (note: the test fails at least on x86_64-win64 due to some different reason :/ )
This commit is contained in:
Sven/Sarah Barth 2025-01-04 10:24:32 +01:00
parent d18a565e72
commit 50b160651c
2 changed files with 28 additions and 18 deletions

View File

@ -2263,6 +2263,7 @@ implementation
procedure tcallnode.load_in_temp(var p:tnode);
var
actnode : pnode;
loadp,
refp : tnode;
hdef : tdef;
@ -2271,6 +2272,21 @@ implementation
begin
if assigned(p) then
begin
{ if the node is a deref node we load the pointer in a temp to allow
code using this node to still be able to modify the original
reference (e.g. a function returning a floating point value on x86
would pass that value through the FP stack and then to the stack
and thus e.g. a type helper for float called on that would modify
the temporary memory on the stack instead of the returned pointer
value }
actnode:=@p;
actnode:=actualtargetnode(actnode);
if actnode^.nodetype=derefn then
begin
load_in_temp(tderefnode(actnode^).left);
exit;
end;
{ temp create }
usederef:=(p.resultdef.typ in [arraydef,recorddef]) or
is_shortstring(p.resultdef) or
@ -4415,24 +4431,6 @@ implementation
if methodpointer.nodetype<>typen then
begin
{ if the value a type helper works on is a derefentiation (before
removing postix operators) we need to pass the original pointer
as Self as the Self value might be changed by the helper }
if is_objectpascal_helper(tdef(procdefinition.owner.defowner)) and
not is_implicit_pointer_object_type(tobjectdef(procdefinition.owner.defowner).extendeddef) then
begin
hpt:=methodpointer;
hpt:=actualtargetnode(@hpt)^;
if hpt.nodetype=derefn then
begin
tmp:=tderefnode(hpt).left;
tderefnode(hpt).left:=nil;
methodpointer.free;
methodpointer:=tmp;
end;
end;
hpt:=methodpointer;
{ Remove all postfix operators }

12
tests/webtbs/tw38122c.pp Normal file
View File

@ -0,0 +1,12 @@
program tw38122c;
{$mode delphi}
uses sysutils;
var
j:integer;
begin
j:=22;
if pinteger(@j)^.tostring <> '22' then
halt(1);
end.