Просмотр исходного кода

* explicitly check whether the methodpointer isn't the same as the result
before optimising function result assignment, because at this point the
hidden self parameter is not yet inserted (mantis #12597)
* changed ttypeconvnode.actualtargetnode to use the same logic as what
is used to determine whether something can be assigned to the result
of a type conversion (so the above check also works if the methodpointer
contains a typecast to a different object type)

git-svn-id: trunk@12038 -

Jonas Maebe 16 лет назад
Родитель
Сommit
1e178d324f
4 измененных файлов с 61 добавлено и 3 удалено
  1. 1 0
      .gitattributes
  2. 9 0
      compiler/ncal.pas
  3. 9 3
      compiler/ncnv.pas
  4. 42 0
      tests/webtbs/tw12597.pp

+ 1 - 0
.gitattributes

@@ -8614,6 +8614,7 @@ tests/webtbs/tw12508a.pp svneol=native#text/plain
 tests/webtbs/tw1251b.pp svneol=native#text/plain
 tests/webtbs/tw1255.pp svneol=native#text/plain
 tests/webtbs/tw12575.pp svneol=native#text/plain
+tests/webtbs/tw12597.pp svneol=native#text/plain
 tests/webtbs/tw1269.pp svneol=native#text/plain
 tests/webtbs/tw1275.pp svneol=native#text/plain
 tests/webtbs/tw1279.pp svneol=native#text/plain

+ 9 - 0
compiler/ncal.pas

@@ -1697,6 +1697,15 @@ implementation
             exit;
           end;
 
+        { if the result is the same as the self parameter (in case of objects),
+          we can't optimise. We have to check this explicitly becaise
+          hidden parameters such as self have not yet been inserted at this
+          point
+        }
+        if assigned(methodpointer) and
+           realassignmenttarget.isequal(methodpointer.actualtargetnode) then
+          exit;
+
         { 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

+ 9 - 3
compiler/ncnv.pas

@@ -54,6 +54,7 @@ interface
           function simplify:tnode; override;
           procedure mark_write;override;
           function docompare(p: tnode) : boolean; override;
+          function retains_value_location:boolean;
           function assign_allowed:boolean;
           procedure second_call_helper(c : tconverttype);
        private
@@ -1595,8 +1596,7 @@ implementation
       begin
         result:=self;
         while (result.nodetype=typeconvn) and
-              (nf_absolute in result.flags) and
-              (resultdef.size=left.resultdef.size) do
+              ttypeconvnode(result).retains_value_location do
           result:=ttypeconvnode(result).left;
       end;
 
@@ -2931,7 +2931,7 @@ implementation
       end;
 
 
-    function ttypeconvnode.assign_allowed:boolean;
+    function ttypeconvnode.retains_value_location:boolean;
       begin
         result:=(convtype=tc_equal) or
                 { typecasting from void is always allowed }
@@ -2951,6 +2951,12 @@ implementation
                 ((convtype in [tc_int_2_bool,tc_bool_2_int,tc_bool_2_bool]) and
                  (nf_explicit in flags) and
                  (resultdef.size=left.resultdef.size));
+      end;
+
+
+    function ttypeconvnode.assign_allowed:boolean;
+      begin
+        result:=retains_value_location;
 
         { When using only a part of the value it can't be in a register since
           that will load the value in a new register first }

+ 42 - 0
tests/webtbs/tw12597.pp

@@ -0,0 +1,42 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils;
+
+type
+
+  { TFoo }
+
+  TFoo = Object
+    a : integer;
+    function b : TFoo;
+  end;
+
+  tfoo2 = object(tfoo)
+  end;
+
+{ TFoo }
+
+function TFoo.b: TFoo;
+begin
+  result.a := 5;
+  writeln(IntToStr(self.a));
+  if (self.a<>2) then
+    halt(1);
+end;
+
+procedure t;
+var x : TFoo;
+begin
+  x.a := 2;
+  x := tfoo2(x).b;
+  writeln(IntToStr(x.a));
+  if (x.a<>5) then
+    halt(2);
+end;
+
+begin
+  t;
+end.