2
0
Эх сурвалжийг харах

* store parameters to inline routines that are already in a temp into a new
temp if the original temp was marked as ti_const, and the new parameter
gets modified (mantis #30015)

git-svn-id: trunk@34289 -

Jonas Maebe 9 жил өмнө
parent
commit
8e0ee6599c

+ 1 - 0
.gitattributes

@@ -15171,6 +15171,7 @@ tests/webtbs/tw2998.pp svneol=native#text/plain
 tests/webtbs/tw2999.pp svneol=native#text/plain
 tests/webtbs/tw29992.pp svneol=native#text/plain
 tests/webtbs/tw30007.pp svneol=native#text/plain
+tests/webtbs/tw30015.pp svneol=native#text/plain
 tests/webtbs/tw30030.pp svneol=native#text/pascal
 tests/webtbs/tw30035.pp svneol=native#text/plain
 tests/webtbs/tw30035a.pp svneol=native#text/plain

+ 4 - 2
compiler/ncal.pas

@@ -4668,10 +4668,12 @@ implementation
         { We don't need temps for parameters that are already temps, except if
           the passed temp could be put in a regvar while the parameter inside
           the routine cannot be (e.g., because its address is taken in the
-          routine) }
+          routine), or if the temp is a const and the parameter gets modified }
         if (para.left.nodetype=temprefn) and
            (not(ti_may_be_in_reg in ttemprefnode(para.left).tempinfo^.flags) or
-            not(tparavarsym(para.parasym).varregable in [vr_none,vr_addr])) then
+            not(tparavarsym(para.parasym).varregable in [vr_none,vr_addr])) and
+           (not(ti_const in ttemprefnode(para.left).tempinfo^.flags) or
+            (tparavarsym(para.parasym).varstate in [vs_initialised,vs_declared,vs_read])) then
           exit;
 
         { check if we have to create a temp, assign the parameter's

+ 38 - 0
tests/webtbs/tw30015.pp

@@ -0,0 +1,38 @@
+program project1;
+
+{$mode objfpc}
+
+{$Inline On} // inline must be turned on for both methods
+type
+  TTest = object // both methods must be inside of object
+    procedure ModifyValue(ValueModify: Int32); inline;
+    procedure SetKey(const ValueConst: Int32); inline;
+  end;
+
+  procedure TTest.ModifyValue(ValueModify: Int32);
+  begin
+    ValueModify := 1;
+  end;
+
+  procedure TTest.SetKey(const ValueConst: Int32);
+  var
+    OriginalValue: Int32;
+  begin
+    OriginalValue := ValueConst;
+    ModifyValue(ValueConst);
+    WriteLn('Current Value: ', ValueConst); //Outputs 1
+    WriteLn('Original Value: ', OriginalValue); //Outputs 2
+    if (OriginalValue<>2) or
+       (ValueConst<>2) then
+      halt(1);
+  end;
+
+var
+  TestObj: TTest;
+  i: Int32;
+
+begin
+  i := 1;
+  TestObj.SetKey(i + 1);
+end.
+