* don't optimize funcret with assignment result if the value is also used

    as a parameter and the funcret is also passed as parameter. Because in that
    case both are pointing to the same memory location

git-svn-id: trunk@10159 -

.gitattributes

@@ -7916,6 +7916,8 @@ tests/webtbs/tw10681.pp svneol=native#text/plain
 tests/webtbs/tw1071.pp svneol=native#text/plain
 tests/webtbs/tw1073.pp svneol=native#text/plain
 tests/webtbs/tw10736.pp svneol=native#text/plain
+tests/webtbs/tw10753.pp svneol=native#text/plain
+tests/webtbs/tw10753a.pp svneol=native#text/plain
 tests/webtbs/tw1081.pp svneol=native#text/plain
 tests/webtbs/tw1090.pp svneol=native#text/plain
 tests/webtbs/tw1092.pp svneol=native#text/plain

compiler/ncal.pas

@@ -63,6 +63,7 @@ interface
           function  gen_self_tree:tnode;
           function  gen_vmt_tree:tnode;
           procedure gen_hidden_parameters;
+          function  funcret_can_be_reused:boolean;
           procedure maybe_create_funcret_node;
           procedure bind_parasym;
           procedure add_init_statement(n:tnode);
@@ -1651,10 +1652,95 @@ implementation
       end;
 
 
+    function check_funcret_used_as_para(var n: tnode; arg: pointer): foreachnoderesult;
+      var
+        destsym : tsym absolute arg;
+      begin
+        result := fen_false;
+        if (n.nodetype=loadn) and
+           (tloadnode(n).symtableentry = destsym) then
+          result := fen_norecurse_true;
+      end;
+
+
+    function tcallnode.funcret_can_be_reused:boolean;
+      var
+        realassignmenttarget: tnode;
+      begin
+        result:=false;
+
+        { we are processing an assignment node? }
+        if not(assigned(aktassignmentnode) and
+               (aktassignmentnode.right=self) and
+               (aktassignmentnode.left.resultdef=resultdef)) then
+          exit;
+
+        { destination must be able to be passed as var parameter }
+        if not valid_for_var(aktassignmentnode.left,false) then
+          exit;
+
+        { destination must be a simple load so it doesn't need a temp when
+          it is evaluated }
+        if not is_simple_para_load(aktassignmentnode.left,false) then
+          exit;
+
+        { remove possible typecasts }
+        realassignmenttarget:=aktassignmentnode.left.actualtargetnode;
+
+        { when it is not passed in a parameter it will only be used after the
+          function call }
+        if not paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then
+          begin
+            result:=true;
+            exit;
+          end;
+
+        { when we substitute a function result inside an inlined function,
+          we may take the address of this function result. Therefore the
+          substituted function result may not be in a register, as we cannot
+          take its address in that case                                      }
+        if (realassignmenttarget.nodetype=temprefn) and
+           not(ti_addr_taken in ttemprefnode(realassignmenttarget).tempinfo^.flags) and
+           not(ti_may_be_in_reg in ttemprefnode(realassignmenttarget).tempinfo^.flags) then
+          begin
+            result:=true;
+            exit;
+          end;
+
+        if (realassignmenttarget.nodetype=loadn) and
+           { nested procedures may access the current procedure's locals }
+           (procdefinition.parast.symtablelevel=normal_function_level) and
+           { must be a local variable, a value para or a hidden function result }
+           { parameter (which can be passed by address, but in that case it got }
+           { through these same checks at the caller side and is thus safe      }
+           (
+            (tloadnode(realassignmenttarget).symtableentry.typ=localvarsym) or
+            (
+             (tloadnode(realassignmenttarget).symtableentry.typ=paravarsym) and
+             ((tparavarsym(tloadnode(realassignmenttarget).symtableentry).varspez = vs_value) or
+              (vo_is_funcret in tparavarsym(tloadnode(realassignmenttarget).symtableentry).varoptions))
+            )
+           ) and
+           { the address may not have been taken of the variable/parameter, because }
+           { otherwise it's possible that the called function can access it via a   }
+           { global variable or other stored state                                  }
+           (
+            not(tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).addr_taken) and
+            (tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).varregable in [vr_none,vr_addr])
+           ) then
+          begin
+            { If the funcret is also used as a parameter we can't optimize becuase the funcret
+              and the parameter will point to the same address. That means that a change of the result variable
+              will result also in a change of the parameter value }
+            result:=not foreachnodestatic(left,@check_funcret_used_as_para,tloadnode(realassignmenttarget).symtableentry);
+            exit;
+          end;
+      end;
+
+
     procedure tcallnode.maybe_create_funcret_node;
       var
         temp : ttempcreatenode;
-        realassignmenttarget: tnode;
       begin
         { For the function result we need to create a temp node for:
             - Inlined functions
@@ -1681,51 +1767,7 @@ implementation
               of the refcount before being assigned. This is all done after the call so there
               is no issue with exceptions and possible use of the old value in the called
               function }
-            if assigned(aktassignmentnode) then
-              realassignmenttarget:=aktassignmentnode.left.actualtargetnode;
-            if assigned(aktassignmentnode) and
-               (aktassignmentnode.right=self) and
-               (aktassignmentnode.left.resultdef=resultdef) and
-               valid_for_var(aktassignmentnode.left,false) and
-               (
-                { when it is not passed in a parameter it will only be used after the
-                  function call, but only do it when it will be a simple parameter node
-                  and doesn't need to be in a temp }
-                (
-                 not paramanager.ret_in_param(resultdef,procdefinition.proccalloption) and
-                 { when we substitute a function result inside an inlined function,
-                   we may take the address of this function result. Therefore the
-                   substituted function result may not be in a register, as we cannot
-                   take its address in that case                                      }
-                 is_simple_para_load(aktassignmentnode.left,false)
-                ) or
-                (
-                 (realassignmenttarget.nodetype=temprefn) and
-                 not(ti_addr_taken in ttemprefnode(realassignmenttarget).tempinfo^.flags) and
-                 not(ti_may_be_in_reg in ttemprefnode(realassignmenttarget).tempinfo^.flags)
-                ) or
-                (
-                 (realassignmenttarget.nodetype=loadn) and
-                 { nested procedures may access the current procedure's locals }
-                 (procdefinition.parast.symtablelevel=normal_function_level) and
-                 { must be a local variable, a value para or a hidden function result }
-                 { parameter (which can be passed by address, but in that case it got }
-                 { through these same checks at the caller side and is thus safe      }
-                 (
-                  (tloadnode(realassignmenttarget).symtableentry.typ=localvarsym) or
-                  (
-                   (tloadnode(realassignmenttarget).symtableentry.typ=paravarsym) and
-                   ((tparavarsym(tloadnode(realassignmenttarget).symtableentry).varspez = vs_value) or
-                    (vo_is_funcret in tparavarsym(tloadnode(realassignmenttarget).symtableentry).varoptions))
-                  )
-                 ) and
-                 { the address may not have been taken of the variable/parameter, because }
-                 { otherwise it's possible that the called function can access it via a   }
-                 { global variable or other stored state                                  }
-                 not(tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).addr_taken) and
-                 (tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).varregable in [vr_none,vr_addr])
-                )
-               ) then
+            if funcret_can_be_reused then
               begin
                 funcretnode:=aktassignmentnode.left.getcopy;
                 include(funcretnode.flags,nf_is_funcret);

tests/webtbs/tw10753.pp

@@ -0,0 +1,33 @@
+{$mode objfpc}{$H+}
+uses
+  SysUtils;
+
+var
+  err : boolean;
+
+procedure p;
+ var
+  AStr,AText: string;
+   AValue: int64;
+ begin
+   //This goes wrong, notice the AStr input and output
+   AValue:=1234567890;
+   AStr := Format('%0.n',[1.0*AValue]); //1.234.567.890
+   AStr := Format('<font color="#ff0000">%s</font>',[AStr]);
+   Writeln('Wrong:' +AStr); //Wrong: <font color="#ff0000"></font>????
+   if AStr<>'<font color="#ff0000">1,234,567,890</font>' then
+     err:=true;
+   //This is Ok, notice the changed output AText
+   AValue:=2134567890;
+   AStr := Format('%0.n',[1.0*AValue]); //2.134.567.890
+   AText := Format('<font color="#ff0000">%s</font>',[AStr]);
+   Writeln('Ok:' +AText); //Ok 2.134.567.890
+   if Atext<>'<font color="#ff0000">2,134,567,890</font>' then
+     err:=true;
+end;
+
+begin
+  p;
+  if err then
+    halt(1);
+end.

tests/webtbs/tw10753a.pp

@@ -0,0 +1,37 @@
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+const buf: array[0..5] of char = 'abcdef';
+
+function foo(const a: string): string;
+begin
+ SetLength(result, 6);
+ Move(buf, result[1], sizeof(buf));
+ if a <> '1234567890' then
+ begin
+   writeln('Failed: ', a);
+   Halt(1);
+ end
+ else
+   writeln('ok');
+end;
+
+procedure test_proc(var a: string);
+var
+ s: string;
+begin
+{ Don't call UniqueString(s) here because it makes the compiler assume
+ that address of s is taken, and assignment s := foo(s) is not optimized }
+ s := a;            // refcount=2
+ a := 'whatever';   // modify source -> s.refcount becomes 1
+ writeln('before: ', s);
+ s := foo(s);
+ writeln(s);
+end;
+
+var
+ s: string;
+begin
+ s := '1234567890';
+ UniqueString(s);
+ test_proc(s);
+end.