paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-11 10:58:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* ensure that the correct overload is picked for function reference parameters

Browse Source 
+ added tests
This commit is contained in:
Sven/Sarah Barth 2022-11-06 21:56:41 +01:00
parent 19cee9b841
commit d221f42a57
3 changed files with 124 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/htypechk.pas
View File

@ -2983,11 +2983,17 @@ implementation
returns a procdef we need to find the correct overloaded
procdef that matches the expected procvar. The loadnode
temporary returned the first procdef (PFV) }
if (def_to.typ=procvardef) and
if (
(def_to.typ=procvardef) or
is_funcref(def_to)
) and
(currpt.left.nodetype=loadn) and
(currpt.left.resultdef.typ=procdef) then
begin
pdtemp:=tprocsym(Tloadnode(currpt.left).symtableentry).Find_procdef_byprocvardef(Tprocvardef(def_to));
if def_to.typ=procvardef then
pdtemp:=tprocsym(Tloadnode(currpt.left).symtableentry).Find_procdef_byprocvardef(Tprocvardef(def_to))
else
pdtemp:=tprocsym(tloadnode(currpt.left).symtableentry).find_procdef_byfuncrefdef(tobjectdef(def_to));
if assigned(pdtemp) then
begin
tloadnode(currpt.left).setprocdef(pdtemp);
@ -2998,7 +3004,10 @@ implementation
{ same as above, but for the case that we have a proc-2-procvar
conversion together with a load }
if (def_to.typ=procvardef) and
if (
(def_to.typ=procvardef) or
is_funcref(def_to)
) and
(currpt.left.nodetype=typeconvn) and
(ttypeconvnode(currpt.left).convtype=tc_proc_2_procvar) and
(ttypeconvnode(currpt.left).totypedef=voidtype) and
@ -3006,7 +3015,10 @@ implementation
(ttypeconvnode(currpt.left).left.nodetype=loadn) and
(ttypeconvnode(currpt.left).left.resultdef.typ=procdef) then
begin
pdtemp:=tprocsym(tloadnode(ttypeconvnode(currpt.left).left).symtableentry).Find_procdef_byprocvardef(Tprocvardef(def_to));
if def_to.typ=procvardef then
pdtemp:=tprocsym(tloadnode(ttypeconvnode(currpt.left).left).symtableentry).Find_procdef_byprocvardef(Tprocvardef(def_to))
else
pdtemp:=tprocsym(tloadnode(ttypeconvnode(currpt.left).left).symtableentry).find_procdef_byfuncrefdef(tobjectdef(def_to));
if assigned(pdtemp) then
begin
tloadnode(ttypeconvnode(currpt.left).left).setprocdef(pdtemp);

54
tests/test/tfuncref50.pp Normal file
View File

@ -0,0 +1,54 @@
program tfuncref50;
{$mode delphi}
{$modeswitch functionreferences}
type
TFunc = reference to function(aArg: LongInt): LongInt;
function Test(aArg: TFunc): LongInt;
begin
Result := aArg(42);
end;
type
TTest = class
function Method(aArg: String): LongInt; overload;
function Method(aArg: LongInt): LongInt; overload;
procedure DoTest;
end;
function TTest.Method(aArg: String): LongInt;
begin
Result := 1;
end;
function TTest.Method(aArg: LongInt): LongInt;
begin
Result := 2;
end;
procedure TTest.DoTest;
begin
Test(Method);
end;
function Func(aArg: String): LongInt; overload;
begin
Result := 1;
end;
function Func(aArg: LongInt): LongInt; overload;
begin
Result := 2;
end;
var
t: TTest;
begin
t := TTest.Create;
t.DoTest;
t.Free;
if Test(Func) <> 2 then
Halt(2);
end.

54
tests/test/tfuncref51.pp Normal file
View File

@ -0,0 +1,54 @@
program tfuncref51;
{$mode objfpc}
{$modeswitch functionreferences}
type
TFunc = reference to function(aArg: LongInt): LongInt;
function Test(aArg: TFunc): LongInt;
begin
Result := aArg(42);
end;
type
TTest = class
function Method(aArg: String): LongInt; overload;
function Method(aArg: LongInt): LongInt; overload;
procedure DoTest;
end;
function TTest.Method(aArg: String): LongInt;
begin
Result := 1;
end;
function TTest.Method(aArg: LongInt): LongInt;
begin
Result := 2;
end;
procedure TTest.DoTest;
begin
Test(@Method);
end;
function Func(aArg: String): LongInt; overload;
begin
Result := 1;
end;
function Func(aArg: LongInt): LongInt; overload;
begin
Result := 2;
end;
var
t: TTest;
begin
t := TTest.Create;
t.DoTest;
t.Free;
if Test(@Func) <> 2 then
Halt(2);
end.