Jelajahi Sumber

compiler: don't treat methods without self node (static class methods, class contructors, destructors, operators) as method pointers, fix comparison of procdef and procvardef to allow assignment of a static class method to a regular procedural variable (issue #24486)

git-svn-id: trunk@25284 -
paul 12 tahun lalu
induk
melakukan
17ef986b17
4 mengubah file dengan 34 tambahan dan 6 penghapusan
  1. 1 0
      .gitattributes
  2. 6 4
      compiler/defcmp.pas
  3. 2 2
      compiler/symdef.pas
  4. 25 0
      tests/webtbs/tw24486.pp

+ 1 - 0
.gitattributes

@@ -13466,6 +13466,7 @@ tests/webtbs/tw2432.pp svneol=native#text/plain
 tests/webtbs/tw2435.pp svneol=native#text/plain
 tests/webtbs/tw2438.pp svneol=native#text/plain
 tests/webtbs/tw2442.pp svneol=native#text/plain
+tests/webtbs/tw24486.pp svneol=native#text/pascal
 tests/webtbs/tw2452.pp svneol=native#text/plain
 tests/webtbs/tw24536.pp svneol=native#text/plain
 tests/webtbs/tw2454.pp svneol=native#text/plain

+ 6 - 4
compiler/defcmp.pas

@@ -2113,8 +2113,8 @@ implementation
 
     function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;checkincompatibleuniv: boolean):tequaltype;
       var
-        eq : tequaltype;
-        po_comp : tprocoptions;
+        eq: tequaltype;
+        po_comp: tprocoptions;
         pa_comp: tcompare_paras_options;
       begin
          proc_to_procvar_equal:=te_incompatible;
@@ -2148,8 +2148,10 @@ implementation
          if checkincompatibleuniv then
            include(pa_comp,cpo_warn_incompatible_univ);
          { check return value and options, methodpointer is already checked }
-         po_comp:=[po_staticmethod,po_interrupt,
-                   po_iocheck,po_varargs];
+         po_comp:=[po_interrupt,po_iocheck,po_varargs];
+         { check static only if we compare method pointers }
+         if def1.is_methodpointer then
+           include(po_comp,po_staticmethod);
          if (m_delphi in current_settings.modeswitches) then
            exclude(po_comp,po_varargs);
          if (def1.proccalloption=def2.proccalloption) and

+ 2 - 2
compiler/symdef.pas

@@ -4769,14 +4769,14 @@ implementation
       begin
         { don't check assigned(_class), that's also the case for nested
           procedures inside methods }
-        result:=owner.symtabletype=ObjectSymtable;
+        result:=(owner.symtabletype=ObjectSymtable)and not no_self_node;
       end;
 
 
     function tprocdef.is_addressonly:boolean;
       begin
         result:=assigned(owner) and
-                (owner.symtabletype<>ObjectSymtable) and
+                not is_methodpointer and
                 (not(m_nested_procvars in current_settings.modeswitches) or
                  not is_nested_pd(self));
       end;

+ 25 - 0
tests/webtbs/tw24486.pp

@@ -0,0 +1,25 @@
+{%NORUN}
+program tw24486;
+
+{$mode delphi}
+
+type
+  tproc1 = procedure(a: integer);
+
+var
+  proc1: tproc1;
+
+type
+  tclass1 = class
+    class procedure p1(a: integer); static;
+  end;
+
+{ tclass1 }
+
+class procedure tclass1.p1(a: integer);
+begin
+end;
+
+begin
+  proc1 := tclass1.p1;
+end.