Przeglądaj źródła

* handle explicit typecasts of procdefs to procvardefs always via
proc_to_procdef, because a methodpointer may have to be discarded

git-svn-id: trunk@23929 -

Jonas Maebe 12 lat temu
rodzic
commit
0ad9f345dd
3 zmienionych plików z 33 dodań i 2 usunięć
  1. 1 0
      .gitattributes
  2. 7 2
      compiler/ncnv.pas
  3. 25 0
      tests/tbs/tb0595.pp

+ 1 - 0
.gitattributes

@@ -9837,6 +9837,7 @@ tests/tbs/tb0591.pp svneol=native#text/pascal
 tests/tbs/tb0592.pp svneol=native#text/plain
 tests/tbs/tb0593.pp svneol=native#text/pascal
 tests/tbs/tb0594.pp svneol=native#text/plain
+tests/tbs/tb0595.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tbs0594.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain

+ 7 - 2
compiler/ncnv.pas

@@ -2281,8 +2281,13 @@ implementation
                   { Handle explicit type conversions }
                   if nf_explicit in flags then
                    begin
-                     { do common tc_equal cast }
-                     convtype:=tc_equal;
+                     { do common tc_equal cast, except when dealing with proc -> procvar
+                       (may have to get rid of method pointer) }
+                     if (left.resultdef.typ<>procdef) or
+                        (resultdef.typ<>procvardef) then
+                       convtype:=tc_equal
+                     else
+                       convtype:=tc_proc_2_procvar;
 
                      { ordinal constants can be resized to 1,2,4,8 bytes }
                      if (left.nodetype=ordconstn) then

+ 25 - 0
tests/tbs/tb0595.pp

@@ -0,0 +1,25 @@
+{$mode delphi}{$h+}
+
+type
+  tc = class
+    class procedure test; static;
+  end;
+
+  tp = procedure;
+
+var
+  global: longint;
+
+  class procedure tc.test;
+    begin
+      global:=1;
+    end;
+
+var
+  p: tp;
+begin
+  p:=tp(tc.test);
+  p();
+  if global<>1 then
+    halt(1);
+end.