* fix #39679 and fix #39680: for implicit specializations a parameter used in a call might also inherit in some depth from a specialization used as parameter type

+ added tests
This commit is contained in:
Sven/Sarah Barth 2022-04-21 21:33:31 +02:00
parent 4053d59a2c
commit 66bac7c415
3 changed files with 79 additions and 4 deletions

View File

@ -1004,12 +1004,39 @@ uses
newparams.free;
end;
function maybe_inherited_specialization(givendef,desireddef:tstoreddef;out basedef:tstoreddef):boolean;
begin
result:=false;
basedef:=nil;
if givendef.typ<>objectdef then
begin
result:=givendef.is_specialization and (givendef.genericdef=desireddef.genericdef);
if result then
basedef:=givendef;
end
else
begin
while assigned(givendef) do
begin
if givendef.is_specialization and (givendef.genericdef=desireddef.genericdef) then
begin
basedef:=givendef;
result:=true;
break;
end;
givendef:=tobjectdef(givendef).childof;
end;
end;
end;
{ compare generic parameters <T> with call node parameters. }
function is_possible_specialization(callerparams:tfplist;genericdef:tprocdef;out unnamed_syms:tfplist;out genericparams:tfphashlist):boolean;
var
i,j,
count : integer;
paravar : tparavarsym;
base_def : tstoreddef;
target_def,
caller_def : tdef;
target_key : string;
@ -1127,11 +1154,10 @@ uses
target_def:=tobjectdef(target_def).childof;
end
{ handle generic specializations }
else if tstoreddef(caller_def).is_specialization and
tstoreddef(target_def).is_specialization and
(tstoreddef(caller_def).genericdef=tstoreddef(target_def).genericdef) then
else if tstoreddef(target_def).is_specialization and
maybe_inherited_specialization(tstoreddef(caller_def),tstoreddef(target_def),base_def) then
begin
handle_specializations(genericparams,tstoreddef(target_def),tstoreddef(caller_def));
handle_specializations(genericparams,tstoreddef(target_def),base_def);
continue;
end
{ handle all other generic params }

28
tests/webtbs/tw39679.pp Normal file
View File

@ -0,0 +1,28 @@
{ %NORUN }
program tw39679;
{$mode objfpc}{$H+}
{$ModeSwitch implicitfunctionspecialization}
type
generic TBase<T> = class(TObject);
generic TChild<T> = class(specialize TBase<T>);
TLongIntChild = class(specialize TChild<LongInt>);
TLongIntBase = class(specialize TBase<LongInt>);
generic procedure Foo<T>(lst: specialize TBase<T>);
begin
end;
var
lst: specialize TChild<Integer>;
lst2: TLongIntChild;
lst3: TLongIntBase;
begin
specialize Foo<Integer>(lst); // works
Foo(lst); // Error
Foo(lst2);
Foo(lst3);
end.

21
tests/webtbs/tw39680.pp Normal file
View File

@ -0,0 +1,21 @@
{ %NORUN }
program tw39680;
{$mode objfpc}{$H+}
{$ModeSwitch implicitfunctionspecialization}
uses
Generics.Collections;
generic procedure Foo<T>(lst: specialize TEnumerable<T>);
begin
end;
var
lst: specialize TList<Integer>; // Inherits from TEnumerable
begin
Foo(lst); // Error
specialize Foo<Integer>(lst); // works
end.