+ add support for forward declarations of generic classes and interfaces (any implicit pointer type really); fixes #34128

This commit is contained in:
Sven/Sarah Barth 2022-02-18 17:06:45 +01:00
parent 3444b23c9a
commit 2a5023508a
20 changed files with 484 additions and 36 deletions

View File

@ -145,6 +145,7 @@ interface
checkforwarddefs,
deflist,
symlist : TFPObjectList;
forwardgenericdefs : TFPHashObjectList; { contains a list of specializations of a forward declared generic (the key) }
ptrdefs : THashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) }
arraydefs : THashSet; { list of single-element-arraydefs created in this module so we can reuse them (not saved/restored) }
procaddrdefs : THashSet; { list of procvardefs created when getting the address of a procdef (not saved/restored) }
@ -612,6 +613,7 @@ implementation
ansistrdef:=nil;
wpoinfo:=nil;
checkforwarddefs:=TFPObjectList.Create(false);
forwardgenericdefs:=TFPHashObjectList.Create(true);
extendeddefs:=TFPHashObjectList.Create(true);
genericdummysyms:=tfphashobjectlist.create(true);
pendingspecializations:=tfphashobjectlist.create(false);
@ -754,6 +756,7 @@ implementation
ansistrdef:=nil;
wpoinfo.free;
checkforwarddefs.free;
forwardgenericdefs.free;
globalsymtable.free;
localsymtable.free;
globalmacrosymtable.free;
@ -835,6 +838,8 @@ implementation
wpoinfo:=nil;
checkforwarddefs.free;
checkforwarddefs:=TFPObjectList.Create(false);
forwardgenericdefs.free;
forwardgenericdefs:=TFPHashObjectList.Create(true);
publicasmsyms.free;
publicasmsyms:=TFPHashObjectList.Create(true);
externasmsyms.free;

View File

@ -47,7 +47,7 @@ interface
procedure property_dec;
procedure resourcestring_dec(out had_generic:boolean);
procedure parse_rttiattributes(var rtti_attrs_def:trtti_attribute_list);
function parse_forward_declaration(sym:tsym;gentypename,genorgtypename:tidstring;generictypelist:tfphashobjectlist;out newtype:ttypesym):tdef;
function parse_forward_declaration(sym:tsym;gentypename,genorgtypename:tidstring;genericdef:tdef;generictypelist:tfphashobjectlist;out newtype:ttypesym):tdef;
implementation
@ -567,7 +567,7 @@ implementation
end;
function parse_forward_declaration(sym:tsym;gentypename,genorgtypename:tidstring;generictypelist:tfphashobjectlist;out newtype:ttypesym):tdef;
function parse_forward_declaration(sym:tsym;gentypename,genorgtypename:tidstring;genericdef:tdef;generictypelist:tfphashobjectlist;out newtype:ttypesym):tdef;
var
wasforward : boolean;
objecttype : tobjecttyp;
@ -610,9 +610,12 @@ implementation
internalerror(200811072);
end;
consume(token);
{ determine the generic def in case we are in a nested type
of a specialization }
gendef:=determine_generic_def(gentypename);
if assigned(genericdef) then
gendef:=tstoreddef(genericdef)
else
{ determine the generic def in case we are in a nested type
of a specialization }
gendef:=determine_generic_def(gentypename);
{ we can ignore the result, the definition is modified }
object_dec(objecttype,genorgtypename,newtype,gendef,generictypelist,tobjectdef(ttypesym(sym).typedef),ht_none);
if wasforward and
@ -752,14 +755,6 @@ implementation
generictypelist:=parse_generic_parameters(true);
consume(_RSHARPBRACKET);
{ we are not freeing the type parameters, so register them }
for i:=0 to generictypelist.count-1 do
begin
tstoredsym(generictypelist[i]).register_sym;
if tstoredsym(generictypelist[i]).typ=typesym then
tstoreddef(ttypesym(generictypelist[i]).typedef).register_def;
end;
str(generictypelist.Count,s);
gentypename:=typename+'$'+s;
genorgtypename:=orgtypename+'$'+s;
@ -805,12 +800,23 @@ implementation
(sp_generic_dummy in sym.symoptions)
) then
begin
hdef:=parse_forward_declaration(sym,gentypename,genorgtypename,generictypelist,newtype);
hdef:=parse_forward_declaration(sym,gentypename,genorgtypename,nil,generictypelist,newtype);
end;
end;
{ no old type reused ? Then insert this new type }
if not assigned(newtype) then
begin
if isgeneric then
begin
{ we are not freeing the type parameters, so register them }
for i:=0 to generictypelist.count-1 do
begin
tstoredsym(generictypelist[i]).register_sym;
if tstoredsym(generictypelist[i]).typ=typesym then
tstoreddef(ttypesym(generictypelist[i]).typedef).register_def;
end;
end;
{ insert the new type first with an errordef, so that
referencing the type before it's really set it
will give an error (PFV) }
@ -1137,6 +1143,16 @@ implementation
tstoreddef(hdef).generictokenbuf:=localgenerictokenbuf;
{ Generic is never a type renaming }
hdef.typesym:=newtype;
{ reusing a forward declared type also reuses the type parameters,
so free them if they haven't been used }
for i:=0 to generictypelist.count-1 do
begin
if (tstoredsym(generictypelist[i]).typ=typesym) and
not ttypesym(generictypelist[i]).typedef.is_registered then
ttypesym(generictypelist[i]).typedef.free;
if not tstoredsym(generictypelist[i]).is_registered then
tstoredsym(generictypelist[i]).free;
end;
generictypelist.free;
end;

View File

@ -1450,7 +1450,7 @@ implementation
{ reuse forward objectdef? }
if assigned(fd) then
begin
if fd.objecttype<>objecttype then
if (fd.objecttype<>objecttype) or ((fd.is_generic or fd.is_specialization) xor assigned(genericlist)) then
begin
Message(parser_e_forward_mismatch);
{ recover }
@ -1567,6 +1567,19 @@ implementation
{ add to the list of definitions to check that the forward
is resolved. this is required for delphi mode }
current_module.checkforwarddefs.add(current_structdef);
symtablestack.push(current_structdef.symtable);
insert_generic_parameter_types(current_structdef,genericdef,genericlist,false);
{ when we are parsing a generic already then this is a generic as
well }
if old_parse_generic then
include(current_structdef.defoptions,df_generic);
parse_generic:=(df_generic in current_structdef.defoptions);
{ *don't* add the strict private symbol for non-Delphi modes for
forward defs }
symtablestack.pop(current_structdef.symtable);
end
else
begin
@ -1586,7 +1599,7 @@ implementation
parse_object_options;
symtablestack.push(current_structdef.symtable);
insert_generic_parameter_types(current_structdef,genericdef,genericlist);
insert_generic_parameter_types(current_structdef,genericdef,genericlist,assigned(fd));
{ when we are parsing a generic already then this is a generic as
well }
if old_parse_generic then

View File

@ -1152,7 +1152,7 @@ implementation
if tsym(genericparams[i]).typ=typesym then
tstoreddef(ttypesym(genericparams[i]).typedef).register_def;
end;
insert_generic_parameter_types(pd,nil,genericparams);
insert_generic_parameter_types(pd,nil,genericparams,false);
{ the list is no longer required }
genericparams.free;
genericparams:=nil;
@ -1199,7 +1199,7 @@ implementation
end;
end
else if assigned(genericdef) then
insert_generic_parameter_types(pd,tstoreddef(genericdef),generictypelist);
insert_generic_parameter_types(pd,tstoreddef(genericdef),generictypelist,false);
{ methods inherit df_generic or df_specialization from the objectdef }
if assigned(pd.struct) and

View File

@ -49,6 +49,7 @@ type
genname : string;
sym : tsym;
symtable : tsymtable;
forwarddef : tdef;
constructor create;
destructor destroy;override;
function getcopy:tspecializationcontext;
@ -95,6 +96,7 @@ begin
result.genname:=genname;
result.sym:=sym;
result.symtable:=symtable;
result.forwarddef:=forwarddef;
end;
end.

View File

@ -45,7 +45,7 @@ uses
function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist;isfwd:boolean);
procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:string):tidstring;
procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
@ -54,6 +54,7 @@ uses
function could_be_generic(const name:tidstring):boolean;inline;
procedure generate_specialization_procs;
procedure generate_specializations_for_forwarddef(def:tdef);
procedure maybe_add_pending_specialization(def:tdef);
function determine_generic_def(const name:tidstring):tstoreddef;
@ -74,7 +75,7 @@ uses
node,nobj,ncon,
{ parser }
scanner,
pbase,pexpr,pdecsub,ptype,psub,pparautl;
pbase,pexpr,pdecsub,ptype,psub,pparautl,pdecl;
type
tdeftypeset = set of tdeftyp;
@ -240,6 +241,30 @@ uses
end;
end;
procedure add_forward_generic_def(def:tdef;context:tspecializationcontext);
var
list : tfpobjectlist;
fwdcontext : tspecializationcontext;
begin
if not is_implicit_pointer_object_type(def) then
internalerror(2020070301);
if not (oo_is_forward in tobjectdef(def).objectoptions) then
internalerror(2020070302);
if not assigned(tobjectdef(def).genericdef) then
internalerror(2020070303);
list:=tfpobjectlist(current_module.forwardgenericdefs.find(tobjectdef(def).genericdef.fulltypename));
if not assigned(list) then
begin
list:=tfpobjectlist.create(true);
current_module.forwardgenericdefs.add(tobjectdef(def).genericdef.fulltypename,list);
end;
fwdcontext:=context.getcopy;
fwdcontext.forwarddef:=def;
list.add(fwdcontext);
end;
function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
var
i,j,
@ -654,6 +679,10 @@ uses
(
not assigned(genericdef.typesym) or
(genericdef.typesym.typ<>typesym)
) and
(
(genericdef.typ<>objectdef) or
not (oo_is_forward in tobjectdef(genericdef).objectoptions)
)
) or
(
@ -702,8 +731,12 @@ uses
begin
if genericdef.typ=procdef then
genname:=tprocdef(genericdef).procsym.realname
else if assigned(genericdef.typesym) then
genname:=ttypesym(genericdef.typesym).realname
else if (genericdef.typ=objectdef) and (oo_is_forward in tobjectdef(genericdef).objectoptions) then
genname:=tobjectdef(genericdef).objrealname^
else
genname:=ttypesym(genericdef.typesym).realname;
internalerror(2020071201);
end
else
genname:=symname;
@ -870,6 +903,7 @@ uses
specializest : tsymtable;
hashedid : thashedidstring;
tempst : tglobalsymtable;
tsrsym : ttypesym;
psym,
srsym : tsym;
paramdef1,
@ -1024,7 +1058,11 @@ uses
end;
{ decide in which symtable to put the specialization }
if parse_generic and not assigned(result) then
if assigned(context.forwarddef) then
begin
specializest:=context.forwarddef.owner;
end
else if parse_generic and not assigned(result) then
begin
srsymtable:=symtablestack.top;
if (srsymtable.symtabletype in [localsymtable,parasymtable]) and tstoreddef(srsymtable.defowner).is_specialization then
@ -1071,7 +1109,7 @@ uses
begin
hashedid.id:=ufinalspecializename;
if specializest.symtabletype=objectsymtable then
if (specializest.symtabletype=objectsymtable) and not assigned(context.forwarddef) then
begin
{ search also in parent classes }
if not assigned(current_genericdef) or (current_genericdef.typ<>objectdef) then
@ -1082,7 +1120,15 @@ uses
else
srsym:=tsym(specializest.findwithhash(hashedid));
if assigned(srsym) then
if assigned(context.forwarddef) then
begin
{ just do a few sanity checks }
if not assigned(srsym) or not (srsym.typ=typesym) then
internalerror(2020070306);
if ttypesym(srsym).typedef<>context.forwarddef then
internalerror(2020070307);
end
else if assigned(srsym) then
begin
retrieve_genericdef_or_procsym(srsym,result,psym);
end
@ -1147,8 +1193,8 @@ uses
else
srsym:=ctypesym.create(finalspecializename,generrordef);
{ insert the symbol only if we don't know already that we have
a procsym to add it to }
if not assigned(psym) then
a procsym to add it to and we aren't dealing with a forwarddef }
if not assigned(psym) and not assigned(context.forwarddef) then
specializest.insert(srsym);
{ specializations are declarations as such it is the wisest to
@ -1199,10 +1245,20 @@ uses
else
begin
current_scanner.startreplaytokens(genericdef.generictokenbuf,hmodule.change_endian);
hadtypetoken:=false;
read_named_type(result,srsym,genericdef,generictypelist,false,hadtypetoken);
ttypesym(srsym).typedef:=result;
result.typesym:=srsym;
if assigned(context.forwarddef) then
begin
tsrsym:=nil;
result:=parse_forward_declaration(context.forwarddef.typesym,ufinalspecializename,finalspecializename,genericdef,generictypelist,tsrsym);
srsym:=tsrsym;
end
else
begin
hadtypetoken:=false;
read_named_type(result,srsym,genericdef,generictypelist,false,hadtypetoken);
ttypesym(srsym).typedef:=result;
result.typesym:=srsym;
end;
if _prettyname<>'' then
ttypesym(result.typesym).fprettyname:=_prettyname
@ -1231,7 +1287,10 @@ uses
consume(_SEMICOLON);
end;
build_vmt(tobjectdef(result));
if oo_is_forward in tobjectdef(result).objectoptions then
add_forward_generic_def(result,context)
else
build_vmt(tobjectdef(result));
end;
{ handle params, calling convention, etc }
procvardef:
@ -1624,13 +1683,17 @@ uses
end;
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist;isfwd:boolean);
var
i : longint;
generictype : tstoredsym;
generictype,
fwdparam : tstoredsym;
generictypedef : tdef;
sym : tsym;
st : tsymtable;
fwdok : boolean;
conv : tconverttype;
op : tprocdef;
begin
def.genericdef:=genericdef;
if not assigned(genericlist) then
@ -1650,6 +1713,57 @@ uses
internalerror(201101020);
end;
{ if we have a forwarddef we check whether the generic parameters are
equal and otherwise ignore the list }
if isfwd then
begin
fwdok:=true;
if (genericlist.count>0) and
(
not assigned(def.genericparas)
or (def.genericparas.count<>genericlist.count)
) then
fwdok:=false
else
begin
for i:=0 to genericlist.count-1 do
begin
if def.genericparas.nameofindex(i)<>genericlist.nameofindex(i) then
begin
fwdok:=false;
break;
end;
generictype:=tstoredsym(genericlist[i]);
fwdparam:=tstoredsym(def.genericparas[i]);
op:=nil;
conv:=tc_equal;
if generictype.typ<>fwdparam.typ then
fwdok:=false
else if (generictype.typ=typesym) then
begin
if compare_defs_ext(ttypesym(generictype).typedef,ttypesym(fwdparam).typedef,nothingn,conv,op,[cdo_strict_genconstraint_check])<te_exact then
fwdok:=false;
end
else if (generictype.typ=constsym) then
begin
if (tconstsym(generictype).consttyp<>tconstsym(fwdparam).consttyp) or
(compare_defs_ext(tconstsym(generictype).constdef,tconstsym(fwdparam).constdef,nothingn,conv,op,[cdo_strict_genconstraint_check])<te_exact) then
fwdok:=false;
end
else
internalerror(2020070101);
if not fwdok then
break;
end;
end;
if not fwdok then
Message(parser_e_forward_mismatch);
exit;
end;
if (genericlist.count>0) and not assigned(def.genericparas) then
def.genericparas:=tfphashobjectlist.create(false);
for i:=0 to genericlist.count-1 do
@ -2055,6 +2169,29 @@ uses
end;
procedure generate_specializations_for_forwarddef(def:tdef);
var
list : tfpobjectlist;
idx,
i : longint;
context : tspecializationcontext;
begin
if not tstoreddef(def).is_generic then
internalerror(2020070304);
idx:=current_module.forwardgenericdefs.findindexof(def.fulltypename);
if idx<0 then
exit;
list:=tfpobjectlist(current_module.forwardgenericdefs.items[idx]);
if not assigned(list) then
internalerror(2020070305);
for i:=0 to list.count-1 do begin
context:=tspecializationcontext(list[i]);
generate_specialization_phase2(context,tstoreddef(def),false,'');
end;
current_module.forwardgenericdefs.delete(idx);
end;
procedure maybe_add_pending_specialization(def:tdef);
var
hmodule : tmodule;

View File

@ -229,6 +229,10 @@ implementation
if not(m_fpc in current_settings.modeswitches) and
(oo_is_forward in tobjectdef(def).objectoptions) then
MessagePos1(def.typesym.fileinfo,type_e_type_is_not_completly_defined,def.typename);
{ generate specializations for generic forwarddefs }
if not (oo_is_forward in tobjectdef(def).objectoptions) and
tstoreddef(def).is_generic then
generate_specializations_for_forwarddef(def);
end;
else
internalerror(200811071);
@ -1037,7 +1041,7 @@ implementation
(df_generic in old_current_structdef.defoptions) then
include(current_structdef.defoptions,df_generic);
insert_generic_parameter_types(current_structdef,genericdef,genericlist);
insert_generic_parameter_types(current_structdef,genericdef,genericlist,false);
{ when we are parsing a generic already then this is a generic as
well }
if old_parse_generic then
@ -1412,7 +1416,7 @@ implementation
else if assigned(genericlist) then
current_genericdef:=arrdef;
symtablestack.push(arrdef.symtable);
insert_generic_parameter_types(arrdef,genericdef,genericlist);
insert_generic_parameter_types(arrdef,genericdef,genericlist,false);
{ there are two possibilties for the following to be true:
* the array declaration itself is generic
* the array is declared inside a generic
@ -1586,7 +1590,7 @@ implementation
else if assigned(genericlist) then
current_genericdef:=pd;
symtablestack.push(pd.parast);
insert_generic_parameter_types(pd,genericdef,genericlist);
insert_generic_parameter_types(pd,genericdef,genericlist,false);
{ there are two possibilties for the following to be true:
* the procvar declaration itself is generic
* the procvar is declared inside a generic

40
tests/test/tgenfwd1.pp Normal file
View File

@ -0,0 +1,40 @@
{ %NORUN }
program tgenfwd1;
{$mode objfpc}
type
generic TGen1<T> = class;
generic TGen2<T: class> = class;
generic TGen3<const N: Integer> = class;
generic TGen4<T; S: class; const N: Integer> = class;
TTest = class
f1: specialize TGen1<LongInt>;
f2: specialize TGen2<TObject>;
f3: specialize TGen3<42>;
f4: specialize TGen4<LongInt, TObject, 42>;
{ this will reuse the above specializations }
f5: specialize TGen1<LongInt>;
f6: specialize TGen2<TObject>;
f7: specialize TGen3<42>;
f8: specialize TGen4<LongInt, TObject, 42>;
end;
generic TGen1<T> = class
end;
generic TGen2<T: class> = class
end;
generic TGen3<const N: Integer> = class
end;
generic TGen4<T; S: class; const N: Integer> = class
end;
begin
end.

15
tests/test/tgenfwd10.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgenfwd10;
{$mode objfpc}
type
generic TTest<const N: Integer> = class;
generic TTest<const N: Byte> = class
end;
begin
end.

15
tests/test/tgenfwd11.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgenfwd11;
{$mode objfpc}
type
generic TTest<const N: Integer> = class;
generic TTest<const M: Integer> = class
end;
begin
end.

15
tests/test/tgenfwd12.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgenfwd12;
{$mode objfpc}
type
generic TTest<const N: Integer> = class;
generic TTest<const N: Single> = class
end;
begin
end.

19
tests/test/tgenfwd13.pp Normal file
View File

@ -0,0 +1,19 @@
{ %NORUN }
program tgenfwd13;
{$mode objfpc}
type
generic ITest<T> = interface;
generic ISomeIntf<T> = interface
procedure Something(aTest: specialize ITest<T>);
end;
generic ITest<T> = interface
end;
begin
end.

38
tests/test/tgenfwd2.pp Normal file
View File

@ -0,0 +1,38 @@
program tgenfwd2;
{$mode delphi}
type
TGen1<T> = class;
TGen2<T: class> = class;
TGen3<const N: Integer> = class;
TGen4<T; S: class; const N: Integer> = class;
TTest = class
f1: TGen1<LongInt>;
f2: TGen2<TObject>;
f3: TGen3<42>;
f4: TGen4<LongInt, TObject, 42>;
{ this will reuse the above specializations }
f5: TGen1<LongInt>;
f6: TGen2<TObject>;
f7: TGen3<42>;
f8: TGen4<LongInt, TObject, 42>;
end;
TGen1<T> = class
end;
TGen2<T: class> = class
end;
TGen3<const N: Integer> = class
end;
TGen4<T; S: class; const N: Integer> = class
end;
begin
end.

15
tests/test/tgenfwd3.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgenfwd3;
{$mode objfpc}
type
generic TTest<T> = class;
generic TTest<T: class> = class
end;
begin
end.

15
tests/test/tgenfwd4.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgenfwd4;
{$mode objfpc}
type
generic TTest<T: class> = class;
generic TTest<T> = class
end;
begin
end.

18
tests/test/tgenfwd5.pp Normal file
View File

@ -0,0 +1,18 @@
{ %FAIL }
program tgenfwd5;
{$mode objfpc}
type
TSomeClass = class
end;
generic TTest<T: TObject> = class;
generic TTest<T: TSomeClass> = class
end;
begin
end.

15
tests/test/tgenfwd6.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgenfwd6;
{$mode objfpc}
type
generic TTest<T: TObject> = class;
generic TTest<T: IInterface> = class
end;
begin
end.

15
tests/test/tgenfwd7.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgenfwd7;
{$mode objfpc}
type
generic TTest<T: TObject> = class;
generic TTest<const N: Integer> = class
end;
begin
end.

15
tests/test/tgenfwd8.pp Normal file
View File

@ -0,0 +1,15 @@
{ %FAIL }
program tgenfwd8;
{$mode objfpc}
type
generic TTest<T> = class;
generic TTest<S> = class
end;
begin
end.

36
tests/test/tgenfwd9.pp Normal file
View File

@ -0,0 +1,36 @@
{ %NORUN }
program tgenfwd9;
{$mode objfpc}
type
TFoo = class
procedure Bar;
end;
TSomeClass = class
public type
generic TTest<T> = class;
TSomeNestedClass = class
f: specialize TTest<TFoo>;
end;
generic TTest<T> = class
f: T;
end;
var
s: TSomeNestedClass;
end;
procedure TFoo.Bar;
begin
end;
var
s: TSomeClass;
begin
s.s.f.f.Bar;
end.