mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 11:09:27 +02:00
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:
parent
5012e45d04
commit
3d6c53ee74
@ -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);
|
||||
|
@ -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
41
tests/webtbs/tw39845.pp
Normal 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.
|
||||
|
Loading…
Reference in New Issue
Block a user