瀏覽代碼

* copy tcallnode.right after copying the callinitblock, as right can be a
temprefnode referring to a temp from the init block (mantis #31421)

git-svn-id: trunk@35478 -

Jonas Maebe 8 年之前
父節點
當前提交
1adde89621
共有 3 個文件被更改,包括 48 次插入1 次删除
  1. 1 0
      .gitattributes
  2. 9 1
      compiler/ncal.pas
  3. 38 0
      tests/webtbs/tw31421a.pp

+ 1 - 0
.gitattributes

@@ -15381,6 +15381,7 @@ tests/webtbs/tw31305.pp svneol=native#text/pascal
 tests/webtbs/tw3131.pp svneol=native#text/plain
 tests/webtbs/tw31332.pp svneol=native#text/pascal
 tests/webtbs/tw3137.pp svneol=native#text/plain
+tests/webtbs/tw31421a.pp svneol=native#text/plain
 tests/webtbs/tw3143.pp svneol=native#text/plain
 tests/webtbs/tw3144.pp svneol=native#text/plain
 tests/webtbs/tw3157.pp svneol=native#text/plain

+ 9 - 1
compiler/ncal.pas

@@ -1740,16 +1740,20 @@ implementation
         n : tcallnode;
         i : integer;
         hp,hpn : tparavarsym;
-        oldleft : tnode;
+        oldleft, oldright : tnode;
         para: tcallparanode;
       begin
         { Need to use a hack here to prevent the parameters from being copied.
           The parameters must be copied between callinitblock/callcleanupblock because
           they can reference methodpointer }
+        { same goes for right (= self/context for procvars) }
         oldleft:=left;
         left:=nil;
+        oldright:=right;
+        right:=nil;
         n:=tcallnode(inherited dogetcopy);
         left:=oldleft;
+        right:=oldright;
         n.symtableprocentry:=symtableprocentry;
         n.symtableproc:=symtableproc;
         n.procdefinition:=procdefinition;
@@ -1766,6 +1770,10 @@ implementation
           n.left:=left.dogetcopy
         else
           n.left:=nil;
+        if assigned(right) then
+          n.right:=right.dogetcopy
+        else
+          n.right:=nil;
         if assigned(methodpointer) then
           n.methodpointer:=methodpointer.dogetcopy
         else

+ 38 - 0
tests/webtbs/tw31421a.pp

@@ -0,0 +1,38 @@
+{ %norun }
+
+{$mode objfpc}
+{$h+}
+
+unit tw31421a;
+
+interface
+
+type
+  TMessageReceivedEvent = function (const Received: TObject): boolean of object;
+
+  TMessageReceivedEventList = class
+  private
+    function Get(Index: Integer): TMessageReceivedEvent;
+  public
+    property MyItems[Index: Integer]: TMessageReceivedEvent read Get; default;
+    procedure ExecuteAll(A: TMessageReceivedEvent; const Received: TObject);
+  end;
+
+implementation
+
+{ TMessageReceivedEventList -------------------------------------------------- }
+
+function TMessageReceivedEventList.Get(Index: Integer): TMessageReceivedEvent;
+begin
+  //Result := ...;
+end;
+
+procedure TMessageReceivedEventList.ExecuteAll(A: TMessageReceivedEvent; const Received: TObject);
+var
+  Handled: boolean;
+begin
+  Handled := false;
+  Handled := MyItems[0](Received) or Handled;
+end;
+
+end.