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

Overload selection: call procvars if result is compatible with parameter

Browse Source 
Previously we only autmatically called procvars without parameters in TP/Delphi
modes if their result type was equal to the parameter type to which they were
passed. Resolves #39748.
This commit is contained in:
Jonas Maebe 2022-09-10 10:49:54 +02:00
parent 136022a7b2
commit e746cf96da
3 changed files with 62 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
compiler/htypechk.pas
View File

@ -2960,23 +2960,23 @@ implementation
{ Convert tp procvars when not expecting a procvar }
if (currpt.left.resultdef.typ=procvardef) and
not(def_to.typ in [procvardef,formaldef]) 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)
) and
{ and if it doesn't require any parameters }
(tprocvardef(currpt.left.resultdef).minparacount=0) then
begin
releasecurrpt:=true;
currpt:=tcallparanode(pt.getcopy);
if maybe_call_procvar(currpt.left,true) then
begin
currpt.resultdef:=currpt.left.resultdef;
def_from:=currpt.left.resultdef;
end;
end;
{ if it doesn't require any parameters }
(tprocvardef(currpt.left.resultdef).minparacount=0) and
{ Only convert to call when there is no overload or the return type
is compatible with the expected type. }
(
(count=1) or
(compare_defs_ext(tprocvardef(currpt.left.resultdef).returndef,def_to,nothingn,convtype,pdoper,[])>te_incompatible)
) then
begin
releasecurrpt:=true;
currpt:=tcallparanode(pt.getcopy);
if maybe_call_procvar(currpt.left,true) then
begin
currpt.resultdef:=currpt.left.resultdef;
def_from:=currpt.left.resultdef;
end;
end;
{ If we expect a procvar and the left is loadnode that
returns a procdef we need to find the correct overloaded

18
tests/webtbs/tw39748.pp Normal file
View File

@ -0,0 +1,18 @@
{$mode delphi}
uses
sysutils;
type
glenum=word;
TglGetError = function(): GLenum; cdecl;
function test: glenum; cdecl;
begin
result:=42;
end;
var glgeterror : TGlGeterror;
begin
glgeterror:=test;
if inttostr(glgeterror)<>'42' then
halt(1);
end.

27
tests/webtbs/tw39748a.pp Normal file
View File

@ -0,0 +1,27 @@
{$mode delphi}
type
glenum=word;
TglGetError = function(): GLenum; cdecl;
function test: glenum; cdecl;
begin
result:=42;
end;
procedure call(e: longint); overload;
begin
writeln('longint');
halt(1);
end;
procedure call(p :tglgeterror); overload;
begin
writeln('procvar');
end;
var glgeterror : TGlGeterror;
begin
glgeterror:=test;
call(glgeterror)
end.