Browse Source

* copy the vmt_entry node in tcallnode.dogetcopy (mantis #28313)
o mention why it doesn't have to be compared in tcallnode.docompare

git-svn-id: trunk@31071 -

Jonas Maebe 10 years ago
parent
commit
62784ef902
3 changed files with 27 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 6 0
      compiler/ncal.pas
  3. 20 0
      tests/webtbs/tw28313.pp

+ 1 - 0
.gitattributes

@@ -14518,6 +14518,7 @@ tests/webtbs/tw2817.pp svneol=native#text/plain
 tests/webtbs/tw28271.pp svneol=native#text/pascal
 tests/webtbs/tw2829.pp svneol=native#text/plain
 tests/webtbs/tw2830.pp svneol=native#text/plain
+tests/webtbs/tw28313.pp -text svneol=native#text/plain
 tests/webtbs/tw2832.pp svneol=native#text/plain
 tests/webtbs/tw2834.pp svneol=native#text/plain
 tests/webtbs/tw2841.pp svneol=native#text/plain

+ 6 - 0
compiler/ncal.pas

@@ -1632,6 +1632,10 @@ implementation
           n.call_vmt_node:=call_vmt_node.dogetcopy
         else
           n.call_vmt_node:=nil;
+        if assigned(vmt_entry) then
+          n.vmt_entry:=vmt_entry.dogetcopy
+        else
+          n.vmt_entry:=nil;
         { must be copied before the funcretnode, because the callcleanup block
           may contain a ttempdeletenode that sets the tempinfo of the
           corresponding temp to ti_nextref_set_hookoncopy_nil, and this nextref
@@ -1681,6 +1685,8 @@ implementation
           inherited docompare(p) and
           (symtableprocentry = tcallnode(p).symtableprocentry) and
           (procdefinition = tcallnode(p).procdefinition) and
+          { this implicitly also compares the vmt_entry node, as it is
+            deterministically based on the methodpointer }
           (methodpointer.isequal(tcallnode(p).methodpointer)) and
           (((cnf_typedefset in callnodeflags) and (cnf_typedefset in tcallnode(p).callnodeflags) and
             (equal_defs(typedef,tcallnode(p).typedef))) or

+ 20 - 0
tests/webtbs/tw28313.pp

@@ -0,0 +1,20 @@
+program project1;
+
+{$mode delphi}{$H+}
+
+uses
+  Classes;
+
+var
+   mode:integer;
+   tabs:TStrings;
+begin
+   tabs:=TStringList.Create;
+   mode:=0;
+   try
+    if not (Mode in [0..Tabs.Count-1]) then exit;
+   finally
+     tabs.Free;
+   end;
+end.
+