Merged revisions 6748 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
r6748 | peter | 2007-03-08 08:53:36 +0100 (Thu, 08 Mar 2007) | 3 lines

  * call procvar only in arguments when the return type matches or there are
    no overloads, fixes 8462

........

git-svn-id: branches/fixes_2_2@6868 -

.gitattributes

@@ -8063,6 +8063,7 @@ tests/webtbs/tw8321.pp svneol=native#text/plain
 tests/webtbs/tw8371.pp svneol=native#text/plain
 tests/webtbs/tw8391.pp svneol=native#text/plain
 tests/webtbs/tw8434.pp svneol=native#text/plain
+tests/webtbs/tw8462.pp svneol=native#text/plain
 tests/webtbs/tw8513.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -1941,7 +1941,13 @@ implementation
 
               { Convert tp procvars when not expecting a procvar }
               if (def_to.typ<>procvardef) and
-                 (currpt.left.resultdef.typ=procvardef) then
+                 (currpt.left.resultdef.typ=procvardef) and
+                 { Only convert to call when there is no overload or the return type
+                   is equal to the expected type. }
+                 (
+                  (count=1) or
+                  equal_defs(tprocvardef(currpt.left.resultdef).returndef,def_to)
+                 ) then
                 begin
                   releasecurrpt:=true;
                   currpt:=tcallparanode(pt.getcopy);

tests/webtbs/tw8462.pp

@@ -0,0 +1,34 @@
+{$ifdef fpc}{$mode delphi}{$endif}
+
+uses
+  Classes;
+
+type
+  TTestProc = function(Index: Integer): String;
+
+  TMyObject = class(TObject)
+    procedure Test(Proc: TTestProc); overload;
+    procedure Test(Vals: TStrings); overload;
+  end;
+
+function GetString(Index: Integer): String;
+begin
+  Result := '';
+end;
+
+procedure TMyObject.Test(Proc: TTestProc);
+begin
+end;
+
+procedure TMyObject.Test(Vals: TStrings);
+begin
+end;
+
+var
+  O: TMyObject;
+  P: TTestProc;
+begin
+  O.Test(P);
+  O.Test(GetString);
+end.
+