Sergei Gorelkin wrote:
I'll be digging further in.
Here goes. I modified the test so that it fails reliably, and patched
the compiler so that is doesn't fail again.
It was a bit tricky to get a string with refcount=1 without telling the
compiler to take its address.
As for the patch, I could not invent anything more clever than comparing
the assignment target with all function parameters one by one. Also
typeconversion nodes may have to be handled.
Index: ncal.pas
===================================================================
--- ncal.pas (revision 9857)
+++ ncal.pas (working copy)
@@ -71,6 +71,7 @@
procedure order_parameters;
procedure check_inlining;
function pass1_normal:tnode;
+ function check_params(targetsym: tsym): boolean;
{ inlining support }
inlinelocals : TFPObjectList;
@@ -1653,6 +1654,28 @@
result:=vmttree;
end;
+function tcallnode.check_params(targetsym: tsym): boolean;
+var
+ hp, hp2: tnode;
+begin
+ result := false;
+ hp := left;
+ while assigned(hp) and (hp.nodetype = callparan) do
+ begin
+ if hp.resultdef = resultdef then
+ begin
+ hp2 := tcallparanode(hp).left;
+ if (hp2.nodetype = loadn) and
+ (tloadnode(hp2).symtableentry = targetsym) and
+ (tcallparanode(hp).parasym.varspez <> vs_value) and
+ { allow optimization for copy(), etc. that handle arguments in a known way }
+ (symtableproc <> systemunit) then
+ Exit;
+ end;
+ hp := tcallparanode(hp).right;
+ end;
+ result := true;
+end;
procedure tcallnode.maybe_create_funcret_node;
var
@@ -1709,6 +1732,8 @@
) or
(
(realassignmenttarget.nodetype=loadn) and
+ { check that assignment target is not passed as function
argument }
+ check_params(tloadnode(realassignmenttarget).symtableentry)
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 }
program test;
{$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._______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
