浏览代码

* compare the actual target nodes when checking whether the result of an
inline function is getting assigned to one of its parameters, so that
typecasts etc. are dealt with correctly (mantis #26536)

git-svn-id: trunk@28834 -

Jonas Maebe 10 年之前
父节点
当前提交
b0639405ac
共有 3 个文件被更改,包括 42 次插入1 次删除
  1. 1 0
      .gitattributes
  2. 1 1
      compiler/ncal.pas
  3. 40 0
      tests/webtbs/tw26536.pp

+ 1 - 0
.gitattributes

@@ -14087,6 +14087,7 @@ tests/webtbs/tw2647.pp svneol=native#text/plain
 tests/webtbs/tw26482.pp svneol=native#text/pascal
 tests/webtbs/tw2649.pp svneol=native#text/plain
 tests/webtbs/tw2651.pp svneol=native#text/plain
+tests/webtbs/tw26536.pp svneol=native#text/plain
 tests/webtbs/tw2656.pp svneol=native#text/plain
 tests/webtbs/tw2659.pp svneol=native#text/plain
 tests/webtbs/tw26599.pp svneol=native#text/pascal

+ 1 - 1
compiler/ncal.pas

@@ -3977,7 +3977,7 @@ implementation
                       (assigned(aktassignmentnode) and
                        (aktassignmentnode.right=self) and
                        (nf_assign_done_in_right in aktassignmentnode.flags) and
-                       aktassignmentnode.left.isequal(para.left)))) or
+                       actualtargetnode(@aktassignmentnode.left)^.isequal(actualtargetnode(@para.left)^)))) or
                     { the compiler expects that it can take the address of parameters passed by reference in
                       the case of const so we can't replace the node simply by a constant node
                       When playing with this code, ensure that

+ 40 - 0
tests/webtbs/tw26536.pp

@@ -0,0 +1,40 @@
+{$MODE OBJFPC}
+program test;
+
+type
+   TBaseClass = class
+      function PrintSelf(): TBaseClass; inline; // has to be inline for the bug to manifest
+   end;
+   
+   TSubClass = class(TBaseClass)
+   end;
+
+function TBaseClass.PrintSelf(): TBaseClass; inline;
+begin
+   Writeln(PtrUInt(Self));
+   Result := nil;
+   Writeln(PtrUInt(Self)); // prints 0!
+   if not assigned(self) then
+     halt(1);
+end;
+
+procedure NoOp(var Dummy: TBaseClass);
+begin
+end;
+
+
+var
+   Instance, Variable: TBaseClass;
+   res: longint;
+begin
+   Instance := TSubClass.Create();
+   Variable := nil;
+
+   NoOp(Variable); // this call is important for the bug to manifest
+   Variable := Instance;
+   // object being invoked has to be cast to a different type for the bug to manifest
+   // return value has to be assigned to the variable being used as "self"
+   Variable := TSubClass(Variable).PrintSelf();
+
+   Instance.Free();
+end.