mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 06:06:17 +02:00
* call procvar only in arguments when the return type matches or there are
no overloads, fixes 8462 git-svn-id: trunk@6748 -
This commit is contained in:
parent
a99b5470af
commit
b054dcde56
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8064,6 +8064,7 @@ tests/webtbs/tw8321.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw8371.pp svneol=native#text/plain
|
tests/webtbs/tw8371.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw8391.pp svneol=native#text/plain
|
tests/webtbs/tw8391.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw8434.pp svneol=native#text/plain
|
tests/webtbs/tw8434.pp svneol=native#text/plain
|
||||||
|
tests/webtbs/tw8462.pp svneol=native#text/plain
|
||||||
tests/webtbs/ub1873.pp svneol=native#text/plain
|
tests/webtbs/ub1873.pp svneol=native#text/plain
|
||||||
tests/webtbs/ub1883.pp svneol=native#text/plain
|
tests/webtbs/ub1883.pp svneol=native#text/plain
|
||||||
tests/webtbs/uw0555.pp svneol=native#text/plain
|
tests/webtbs/uw0555.pp svneol=native#text/plain
|
||||||
|
@ -1974,7 +1974,13 @@ implementation
|
|||||||
|
|
||||||
{ Convert tp procvars when not expecting a procvar }
|
{ Convert tp procvars when not expecting a procvar }
|
||||||
if (def_to.typ<>procvardef) and
|
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
|
begin
|
||||||
releasecurrpt:=true;
|
releasecurrpt:=true;
|
||||||
currpt:=tcallparanode(pt.getcopy);
|
currpt:=tcallparanode(pt.getcopy);
|
||||||
|
34
tests/webtbs/tw8462.pp
Normal file
34
tests/webtbs/tw8462.pp
Normal file
@ -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.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user