parentfpstruct: explicitly trash before initialising

It's an internal sym, but it contains user data. Together with the previous
commit resolves #39845
This commit is contained in:
Jonas Maebe 2022-07-26 21:50:44 +02:00
parent 5012e45d04
commit 3d6c53ee74
3 changed files with 45 additions and 1 deletions

View File

@ -84,11 +84,12 @@ interface
{ trashes a paravarsym or localvarsym if possible (not a managed type,
"out" in case of parameter, ...) }
class procedure maybe_trash_variable(var stat: tstatementnode; p: tabstractnormalvarsym; trashn: tnode); virtual;
class function check_insert_trashing(pd: tprocdef): boolean; virtual;
strict protected
{ called from wrap_proc_body to insert the trashing for the wrapped
routine's local variables and parameters }
class function maybe_insert_trashing(pd: tprocdef; n: tnode): tnode;
class function check_insert_trashing(pd: tprocdef): boolean; virtual;
{ callback called for every local variable and parameter by
maybe_insert_trashing(), calls through to maybe_trash_variable() }
class procedure maybe_trash_variable_callback(p: TObject; statn: pointer);

View File

@ -953,6 +953,8 @@ implementation
begin
if assigned(tblocknode(procdef.parentfpinitblock).left) then
begin
if cnodeutils.check_insert_trashing(procdef) then
cnodeutils.maybe_trash_variable(newstatement,tabstractnormalvarsym(procdef.parentfpstruct),cloadnode.create(procdef.parentfpstruct,procdef.parentfpstruct.owner));
{ could be an asmn in case of a pure assembler procedure,
but those shouldn't access nested variables }
addstatement(newstatement,procdef.parentfpinitblock);

41
tests/webtbs/tw39845.pp Normal file
View File

@ -0,0 +1,41 @@
{ %opt=-gt -Sc }
{$mode objfpc}
program Project1;
type TLLVMTest = class
str: ansistring;
pos: pchar;
procedure expect(c: char);
procedure test();
end;
var
l: TLLVMTest;
procedure TLLVMTest.expect(c: char);
procedure error;
begin
while (pos^ <> c) and (pos^ <> #0) do pos += 1;
end;
begin
if pos^ = c then
pos += 1
else
halt(1);
end;
procedure TLLVMTest.test();
begin
str := 'abc';
pos:=@str[1];
expect('a');
end;
begin
l := TLLVMTest.create;
l.test();
end.