Browse Source

parentfpstruct: explicitly trash before initialising

It's an internal sym, but it contains user data. Together with the previous
commit resolves #39845
Jonas Maebe 3 years ago
parent
commit
3d6c53ee74
3 changed files with 45 additions and 1 deletions
  1. 2 1
      compiler/ngenutil.pas
  2. 2 0
      compiler/psub.pas
  3. 41 0
      tests/webtbs/tw39845.pp

+ 2 - 1
compiler/ngenutil.pas

@@ -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);

+ 2 - 0
compiler/psub.pas

@@ -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 - 0
tests/webtbs/tw39845.pp

@@ -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.
+