瀏覽代碼

* apply patch by Blaise.ru: avoid internal error when assigning class methods, accessed via a class reference type, to incompatible procvars
+ added tests

Sven/Sarah Barth 3 年之前
父節點
當前提交
6e7a82440e
共有 6 個文件被更改,包括 90 次插入2 次删除
  1. 9 2
      compiler/ncnv.pas
  2. 17 0
      tests/test/tprocvar11.pp
  3. 17 0
      tests/test/tprocvar12.pp
  4. 15 0
      tests/test/tprocvar13.pp
  5. 16 0
      tests/test/tprocvar14.pp
  6. 16 0
      tests/test/tprocvar15.pp

+ 9 - 2
compiler/ncnv.pas

@@ -2494,6 +2494,7 @@ implementation
         aprocdef : tprocdef;
         eq : tequaltype;
         cdoptions : tcompare_defs_options;
+        selfnode : tnode;
         newblock: tblocknode;
         newstatement: tstatementnode;
         tempnode: ttempcreatenode;
@@ -2657,8 +2658,14 @@ implementation
                             tprocdef(currprocdef),tcallnode(left).symtableproc);
                         if (tcallnode(left).symtableprocentry.owner.symtabletype=ObjectSymtable) then
                          begin
-                           if assigned(tcallnode(left).methodpointer) then
-                             tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy)
+                           selfnode:=tcallnode(left).methodpointer;
+                           if assigned(selfnode) then
+                            begin
+                              { in case the nodetype is a typen, avoid the internal error
+                                in set_mp and instead let the code error out normally }
+                              if selfnode.nodetype<>typen then
+                                tloadnode(hp).set_mp(selfnode.getcopy)
+                            end
                            else
                              tloadnode(hp).set_mp(load_self_node);
                          end;

+ 17 - 0
tests/test/tprocvar11.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tprocvar11;
+
+{$mode delphi}
+
+type C = class
+    class procedure NonStatic;
+end;
+class procedure C.NonStatic; begin end;
+
+type CC = class of C;
+
+var IncompatWNonStatic: procedure;
+begin
+    IncompatWNonStatic := CC.NonStatic;
+end.

+ 17 - 0
tests/test/tprocvar12.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tprocvar12;
+
+{$mode delphi}
+
+type C = class
+    class procedure Static; static;
+end;
+class procedure C.Static; begin end;
+
+type CC = class of C;
+
+var IncompatWStatic: procedure of object;
+begin
+    IncompatWStatic := CC.Static;
+end.

+ 15 - 0
tests/test/tprocvar13.pp

@@ -0,0 +1,15 @@
+{ %FAIL }
+
+program tprocvar13;
+
+{$mode delphi}
+
+type O = object
+    class procedure Static; static;
+end;
+class procedure O.Static; begin end;
+
+var IncompatWStatic: procedure of object;
+begin
+    IncompatWStatic := O.Static;
+end.

+ 16 - 0
tests/test/tprocvar14.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+
+program tprocvar14;
+
+{$mode delphi}
+
+type C = class end;
+type H = class helper for C
+    class procedure NonStatic;
+end;
+class procedure H.NonStatic; begin end;
+
+var IncompatWNonStatic: procedure;
+begin
+    IncompatWNonStatic := H.NonStatic;
+end.

+ 16 - 0
tests/test/tprocvar15.pp

@@ -0,0 +1,16 @@
+{ %FAIL }
+
+program tprocvar15;
+
+{$mode delphi}
+
+type C = class end;
+type H = class helper for C
+    class procedure Static; static;
+end;
+class procedure H.Static; begin end;
+
+var IncompatWStatic: procedure of object;
+begin
+    IncompatWStatic := H.Static;
+end.