* fix overload choosing if both normal proc and proc of object are available

git-svn-id: trunk@1496 -

.gitattributes

@@ -6305,6 +6305,7 @@ tests/webtbs/tw4188.pp svneol=native#text/plain
 tests/webtbs/tw4199.pp svneol=native#text/plain
 tests/webtbs/tw4201.pp svneol=native#text/plain
 tests/webtbs/tw4202.pp svneol=native#text/plain
+tests/webtbs/tw4209.pp svneol=native#text/plain
 tests/webtbs/tw4215.pp svneol=native#text/plain
 tests/webtbs/tw4219.pp svneol=native#text/plain
 tests/webtbs/tw4223.pp svneol=native#text/plain

compiler/defcmp.pas

@@ -114,7 +114,7 @@ interface
     { True if a function can be assigned to a procvar }
     { changed first argument type to pabstractprocdef so that it can also be }
     { used to test compatibility between two pprocvardefs (JM)               }
-    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;methoderr:boolean):tequaltype;
+    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
 
 
 implementation
@@ -1020,7 +1020,7 @@ implementation
                      if (m_tp_procvar in aktmodeswitches) or
                         (m_mac_procvar in aktmodeswitches) then
                       begin
-                        subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to),true);
+                        subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to));
                         if subeq>te_incompatible then
                          begin
                            doconv:=tc_proc_2_procvar;
@@ -1031,7 +1031,7 @@ implementation
                  procvardef :
                    begin
                      { procvar -> procvar }
-                     eq:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to),false);
+                     eq:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to));
                    end;
                  pointerdef :
                    begin
@@ -1455,7 +1455,7 @@ implementation
       end;
 
 
-    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef;methoderr:boolean):tequaltype;
+    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
       var
         eq : tequaltype;
         po_comp : tprocoptions;
@@ -1466,11 +1466,7 @@ implementation
          { check for method pointer }
          if (def1.is_methodpointer xor def2.is_methodpointer) or
             (def1.is_addressonly xor def2.is_addressonly) then
-          begin
-            if methoderr then
-              Message(type_e_no_method_and_procedure_not_compatible);
-            exit;
-          end;
+           exit;
          { check return value and options, methodpointer is already checked }
          po_comp:=[po_staticmethod,po_interrupt,
                    po_iocheck,po_varargs];

compiler/htypechk.pas

@@ -1367,7 +1367,7 @@ implementation
               if ((m_tp_procvar in aktmodeswitches) or
                   (m_mac_procvar in aktmodeswitches)) and
                  (p.left.nodetype=calln) and
-                 (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to),true)>=te_equal) then
+                 (proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to))>=te_equal) then
                 eq:=te_equal
               else
                 if (m_mac_procvar in aktmodeswitches) and
@@ -1835,7 +1835,7 @@ implementation
                  end
               else
               { for value and const parameters check precision of real, give
-                penalty for loosing of precision }
+                penalty for loosing of precision. var and out parameters must match exactly }
                if not(currpara.varspez in [vs_var,vs_out]) and
                   is_real(def_from) and
                   is_real(def_to) then
@@ -1864,8 +1864,9 @@ implementation
                  end
               else
               { related object parameters also need to determine the distance between the current
-                object and the object we are comparing with }
-               if (def_from.deftype=objectdef) and
+                object and the object we are comparing with. var and out parameters must match exactly }
+               if not(currpara.varspez in [vs_var,vs_out]) and
+                  (def_from.deftype=objectdef) and
                   (def_to.deftype=objectdef) and
                   (tobjectdef(def_from).objecttype=tobjectdef(def_to).objecttype) and
                   tobjectdef(def_from).is_related(tobjectdef(def_to)) then

compiler/ncnv.pas

@@ -1511,8 +1511,7 @@ implementation
                      { Now check if the procedure we are going to assign to
                        the procvar, is compatible with the procvar's type }
                      if not(nf_explicit in flags) and
-                        (proc_to_procvar_equal(currprocdef,
-                                               tprocvardef(resulttype.def),true)=te_incompatible) then
+                        (proc_to_procvar_equal(currprocdef,tprocvardef(resulttype.def))=te_incompatible) then
                        IncompatibleTypes(left.resulttype.def,resulttype.def);
                      exit;
                    end;

compiler/symsym.pas

@@ -882,7 +882,7 @@ implementation
         pd:=pdlistfirst;
         while assigned(pd) do
          begin
-           eq:=proc_to_procvar_equal(pd^.def,d,false);
+           eq:=proc_to_procvar_equal(pd^.def,d);
            if eq>=te_equal then
             begin
               { multiple procvars with the same equal level }

tests/webtbs/tw4209.pp

@@ -0,0 +1,34 @@
+{ Source provided for Free Pascal Bug Report 4209 }
+{ Submitted by "Ivo Steinmann" on  2005-07-22 }
+{ e-mail: [email protected] }
+Program testprog;
+
+{$mode delphi}
+
+var
+  err : boolean;
+
+type
+  XMethod = procedure of object;
+  XProcedure = procedure;
+
+procedure Test(const Callback: XMethod); overload;
+begin
+end;
+
+procedure Test(const Callback: XProcedure); overload;
+begin
+  writeln('ok');
+  err:=false;
+end;
+
+procedure Foobar;
+begin
+end;
+
+begin
+  err:=true;
+  Test(Foobar);
+  if err then
+    halt(1);
+end.