* if a call inside a generic's code that involves generic type arguments can't be clearly determined then postpone it till specialization in the hope that the type will be clear then

+ added test

git-svn-id: trunk@47686 -
This commit is contained in:
svenbarth 2020-12-04 22:07:34 +00:00
parent 0be298802b
commit 69e6f3dcbb
3 changed files with 73 additions and 3 deletions

1
.gitattributes vendored
View File

@ -15172,6 +15172,7 @@ tests/test/tgenfunc2.pp svneol=native#text/pascal
tests/test/tgenfunc20.pp svneol=native#text/pascal
tests/test/tgenfunc21.pp svneol=native#text/pascal
tests/test/tgenfunc22.pp svneol=native#text/pascal
tests/test/tgenfunc23.pp svneol=native#text/pascal
tests/test/tgenfunc3.pp svneol=native#text/pascal
tests/test/tgenfunc4.pp svneol=native#text/pascal
tests/test/tgenfunc5.pp svneol=native#text/pascal

View File

@ -3575,6 +3575,18 @@ implementation
function tcallnode.pass_typecheck:tnode;
function is_undefined_recursive(def:tdef):boolean;
begin
{ might become more refined in the future }
if def.typ=undefineddef then
result:=true
else if def.typ=arraydef then
result:=is_undefined_recursive(tarraydef(def).elementdef)
else
result:=false;
end;
var
candidates : tcallcandidates;
oldcallnode : tcallnode;
@ -3584,6 +3596,7 @@ implementation
paraidx,
cand_cnt : integer;
i : longint;
ignoregenericparacall,
ignorevisibility,
is_const : boolean;
statements : tstatementnode;
@ -3771,12 +3784,33 @@ implementation
{ Multiple candidates left? }
if cand_cnt>1 then
begin
CGMessage(type_e_cant_choose_overload_function);
{ if we're inside a generic and call another function
with generic types as arguments we don't complain in
the generic, but only during the specialization }
ignoregenericparacall:=false;
if df_generic in current_procinfo.procdef.defoptions then
begin
pt:=tcallparanode(left);
while assigned(pt) do
begin
if is_undefined_recursive(pt.resultdef) then
begin
ignoregenericparacall:=true;
break;
end;
pt:=tcallparanode(pt.right);
end;
end;
if not ignoregenericparacall then
begin
CGMessage(type_e_cant_choose_overload_function);
{$ifdef EXTDEBUG}
candidates.dump_info(V_Hint);
candidates.dump_info(V_Hint);
{$else EXTDEBUG}
candidates.list(false);
candidates.list(false);
{$endif EXTDEBUG}
end;
{ we'll just use the first candidate to make the
call }
end;

35
tests/test/tgenfunc23.pp Normal file
View File

@ -0,0 +1,35 @@
program tgenfunc;
{$mode objfpc}
var
TestTCalled: LongInt;
TestArrayOfTCalled: LongInt;
generic procedure Test<T>(const aArg: T);
begin
Inc(TestTCalled);
end;
generic procedure Test<T>(const aArg: array of T);
var
i: SizeInt;
begin
for i := 0 to High(aArg) do begin
specialize Test<T>(aArg[i]);
end;
Inc(TestArrayOfTCalled);
end;
begin
TestTCalled := 0;
TestArrayOfTCalled := 0;
specialize Test<LongInt>(1);
if TestTCalled <> 1 then
Halt(1);
specialize Test<LongInt>([1, 2, 3]);
if TestArrayOfTCalled <> 1 then
Halt(2);
if TestTCalled <> 4 then
Halt(3);
end.