View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0034128 | FPC | Compiler | public | 2018-08-13 14:03 | 2020-10-24 10:18 |
Reporter | Svetozar Belic | Assigned To | |||
Priority | normal | Severity | minor | Reproducibility | always |
Status | acknowledged | Resolution | open | ||
Summary | 0034128: Support for forward declarations of generic types | ||||
Description | The compiler currently does not support forward declarations of generic types such as: TTest<T> = class; // <- Not allowed. TTest<T> = class end; The attached patch file adds support for such declarations. | ||||
Additional Information | When a type section is parsed and a forward declaration of a generic type is encountered, a symbol and a definition (with oo_is_forward) is created as usual. Because it has oo_is_forward, this definition is incomplete. Types which use the incomplete definition will add them self to its used_by list. At the end of the type section (when the generic type is now parsed), resolve_forward_generic_types is called which goes through all the incomplete forward declarations, generates a specialization and replaces the incomplete definitions (by going through the incomplete definition's used_by list). After it has been replaced, the incomplete definition is deleted. If this is a wrong way to go about it, I would be happy if someone could provide some pointers to help me implement this a better way. | ||||
Tags | generics | ||||
Fixed in Revision | |||||
FPCOldBugId | |||||
FPCTarget | - | ||||
Attached Files |
|
has duplicate | 0026452 | resolved | Sven Barth | Internal error 2012101001 with forward template declaration |
related to | 0022402 | confirmed | Generic forward type declaration |
|
0001-Added-support-for-forward-declarations-of-generic-ty.patch (20,155 bytes)
From 1bb999c9a649728e2f70de96a59c37c90a57641d Mon Sep 17 00:00:00 2001 From: Svetozar Belic <toza.belic@gmail.com> Date: Fri, 10 Aug 2018 19:26:24 +0200 Subject: [PATCH] Added support for forward declarations of generic types. --- compiler/pdecl.pas | 19 ++++++-- compiler/pdecobj.pas | 7 +++ compiler/pdecsub.pas | 2 +- compiler/pdecvar.pas | 9 +++- compiler/pgenutil.pas | 93 +++++++++++++++++++++++++++++++++++-- compiler/ptype.pas | 124 +++++++++++++++++++++++++++++++++++++++++++++++++- compiler/symtype.pas | 8 ++++ 7 files changed, 253 insertions(+), 9 deletions(-) diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index c5b5bcc921..bc07d08ed4 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -566,6 +566,11 @@ implementation is_implicit_pointer_object_type(ttypesym(sym).typedef) and (oo_is_forward in tobjectdef(ttypesym(sym).typedef).objectoptions) then begin + if assigned(generictypelist) and assigned(tobjectdef(ttypesym(sym).typedef).genericparas) then + { check if generic parameters match the forward declaration } + if not compare_generic_parameters(generictypelist, tobjectdef(ttypesym(sym).typedef).genericparas) then + Message1(type_e_generic_declaration_does_not_match, ttypesym(sym).prettyname); + case token of _CLASS : objecttype:=default_class_type; @@ -680,6 +685,7 @@ implementation begin istyperenaming:=true; include(newtype.symoptions,sp_explicitrename); + maybe_add_used_by(hdef, newtype); end; if isunique then begin @@ -690,9 +696,13 @@ implementation if is_object(hdef) or is_class_or_interface_or_dispinterface(hdef) then begin - { just create a child class type; this is - Delphi-compatible } - hdef:=cobjectdef.create(tobjectdef(hdef).objecttype,genorgtypename,tobjectdef(hdef),true); + if oo_is_forward in tobjectdef(hdef).objectoptions then + { Forward declarations are not allowed. } + Message1(parser_e_forward_declaration_must_be_resolved, hdef.typesymbolprettyname) + else + { just create a child class type; this is + Delphi-compatible } + hdef:=cobjectdef.create(tobjectdef(hdef).objecttype,genorgtypename,tobjectdef(hdef),true); end else begin @@ -946,6 +956,9 @@ implementation ((idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]) or ((m_final_fields in current_settings.modeswitches) and (idtoken=_FINAL)))); + + resolve_forward_generic_types; + { resolve type block forward declarations and restore a unit container for them } resolve_forward_types; diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 1e41f98a70..c116215f64 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -1499,6 +1499,13 @@ 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); + + { generic parameter types were registered globaly, remove them } + symtablestack.push(current_structdef.symtable); + update_generic_para_ownership(current_structdef,genericdef,genericlist); + symtablestack.pop(current_structdef.symtable); + current_structdef.genericdef := genericdef; + end else begin diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index e2b0c1712a..487a6f80c1 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -536,7 +536,7 @@ implementation { update varsym } vs.vardef:=hdef; vs.defaultconstsym:=defaultvalue; - + maybe_add_used_by(hdef, vs); if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then begin if locationstr<>'' then diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 4d39397e46..97746d1c07 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -448,7 +448,7 @@ implementation begin consume(_COLON); single_type(p.propdef,[stoAllowSpecialization]); - + maybe_add_used_by(p.propdef, p); if is_dispinterface(astruct) and not is_automatable(p.propdef) then Message1(type_e_not_automatable,p.propdef.typename); @@ -1558,6 +1558,7 @@ implementation fieldvs : tfieldvarsym; hstaticvs : tstaticvarsym; vs : tabstractvarsym; + absvs : tabsolutevarsym; srsym : tsym; srsymtable : TSymtable; visibility : tvisibility; @@ -1730,6 +1731,7 @@ implementation begin fieldvs:=tfieldvarsym(sc[i]); fieldvs.vardef:=hdef; + maybe_add_used_by(hdef, fieldvs); { insert any additional hint directives } fieldvs.symoptions := fieldvs.symoptions + hintsymoptions; if deprecatedmsg<>nil then @@ -1794,6 +1796,11 @@ implementation cnodeutils.insertbssdata(hstaticvs); if vd_final in options then hstaticvs.varspez:=vs_final; + maybe_add_used_by(hdef, hstaticvs); + { hstaticvs has generated an absvarsym, add it to used by as well } + absvs := tabsolutevarsym(recst.Find(lower(generate_nested_name(recst,'_'))+'_'+fieldvs.name)); + if Assigned(absvs) then + maybe_add_used_by(hdef, absvs); end; if removeclassoption then begin diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index 7760a4e134..d423fedb3f 100644 --- a/compiler/pgenutil.pas +++ b/compiler/pgenutil.pas @@ -43,9 +43,11 @@ uses function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;parsedpos:tfileposinfo):tdef; function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;_prettyname:ansistring):tdef; function check_generic_constraints(genericdef:tstoreddef;paradeflist:tfpobjectlist;poslist:tfplist):boolean; + function compare_generic_parameters(deflist1, deflist2 : tfphashobjectlist): boolean; function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist; function parse_generic_specialization_types(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean; procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist); + procedure update_generic_para_ownership(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist); procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist); function generate_generic_name(const name:tidstring;specializename:ansistring;owner_hierarchy:string):tidstring; procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint); @@ -299,6 +301,34 @@ uses end; end; + function compare_generic_parameters(deflist1, deflist2 : tfphashobjectlist):boolean; + var + i : integer; + ts1, ts2 : ttypesym; + begin + if deflist1.count<>deflist2.count then + internalerror(2018081091); + + for i:=0 to deflist1.count-1 do + begin + ts1 := ttypesym(deflist1[i]); + ts2 := ttypesym(deflist2[i]); + if (ts1.typedef.typ<>ts2.typedef.typ) or (lower(ts1.realname)<>lower(ts2.Name)) then + exit(false); + + if (ts1.typedef.typ = errordef) or (ts2.typedef.typ = errordef) or + (not assigned(tstoreddef(ts1.typedef).genconstraintdata)) then + continue; + + if tstoreddef(ts1.typedef).genconstraintdata.flags <> tstoreddef(ts2.typedef).genconstraintdata.flags then + exit(false); + + if gcf_class in tstoreddef(ts1.typedef).genconstraintdata.flags then + if tobjectdef(ts1.typedef).childof <> tobjectdef(ts2.typedef).childof then + exit(false); + end; + result := true; + end; function parse_generic_specialization_types_internal(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring;parsedtype:tdef;parsedpos:tfileposinfo):boolean; var @@ -1056,9 +1086,13 @@ uses consume(_SEMICOLON); end; - vmtbuilder:=TVMTBuilder.Create(tobjectdef(result)); - vmtbuilder.generate_vmt; - vmtbuilder.free; + { Do not build VMT for forward declarations, it will be built later when fully defined. } + if not (oo_is_forward in tobjectdef(result).objectoptions) then + begin + vmtbuilder:=TVMTBuilder.Create(tobjectdef(result)); + vmtbuilder.generate_vmt; + vmtbuilder.free; + end; end; { handle params, calling convention, etc } procvardef: @@ -1384,6 +1418,7 @@ uses i : longint; generictype,sym : ttypesym; st : tsymtable; + hid : THashedIDString; begin def.genericdef:=genericdef; if not assigned(genericlist) then @@ -1418,6 +1453,25 @@ uses end else begin + { check if the parameter sym/def was already created by a forward definition } + if generictype.realname[1]='$' then + hid.id:=Copy(generictype.realname,2,255) + else + hid.id:=Upper(generictype.realname); + if st.FindWithHash(hid) <> nil then + begin + { delete the typedef if defined, it will not be used } + if (generictype.typedef<>cundefinedtype) and + (assigned(generictype.typedef.owner)) then + generictype.typedef.owner.deletedef(generictype.typedef); + { delete the symbol as well } + if assigned(generictype.owner) then + generictype.owner.Delete(generictype) + else + generictype.free; + continue; + end; + if (generictype.typedef.typ=undefineddef) and (generictype.typedef<>cundefinedtype) then begin { the generic parameters were parsed before the genericdef existed thus the @@ -1433,6 +1487,39 @@ uses end; end; + procedure update_generic_para_ownership(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist); + var + i : longint; + generictype,sym : ttypesym; + st : tsymtable; + begin + if not assigned(genericlist) or (genericlist.count<1) or (def.typ<>objectdef) then + exit; + + st:=tobjectdef(def).symtable; + + if not assigned(def.genericparas) then + def.genericparas:=tfphashobjectlist.create(false); + for i:=0 to genericlist.count-1 do + begin + generictype:=ttypesym(genericlist[i]); + if not assigned(generictype.owner) then + begin + if (generictype.typedef<>cundefinedtype) then + begin + { the generic parameters were parsed before the genericdef existed thus the + undefineddefs were added as part of the parent symtable } + if assigned(generictype.typedef.owner) then + generictype.typedef.owner.DefList.Extract(generictype.typedef); + generictype.typedef.changeowner(st); + end; + st.insert(generictype); + include(generictype.symoptions,sp_generic_para); + end; + def.genericparas.add(genericlist.nameofindex(i),generictype); + end; + end; + procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist); var gensym : ttypesym; diff --git a/compiler/ptype.pas b/compiler/ptype.pas index 38e2526e9f..c12e6eaa6e 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -39,6 +39,8 @@ interface TSingleTypeOptions=set of TSingleTypeOption; procedure resolve_forward_types; + procedure resolve_forward_generic_types; + procedure maybe_add_used_by(def : tdef; sym: tsym); { reads a string, file type or a type identifier } procedure single_type(var def:tdef;options:TSingleTypeOptions); @@ -76,7 +78,7 @@ implementation jvmdef, {$endif} { modules } - fmodule, + fmodule, nobj, { pass 1 } node, nset,ncnv,ncon,nld, @@ -235,6 +237,126 @@ implementation current_module.checkforwarddefs.clear; end; + procedure resolve_forward_generic_types; + var + i, r, oldIdx: longint; + def, newdef : tobjectdef; + hmodule : tmodule; + fileinfo : tfileposinfo; + old_block_type : tblock_type; + oldcurrent_filepos : tfileposinfo; + replaydepth : longint; + genericdef:tstoreddef; + hadtypetoken : boolean; + recordbuf : tdynamicarray; + vmtbuilder : tvmtbuilder; + begin + for i:= current_module.checkforwarddefs.Count-1 downto 0 do + begin + case tdef(current_module.checkforwarddefs[i]).typ of + pointerdef, + classrefdef:; + objectdef : + begin + def:=tobjectdef(current_module.checkforwarddefs[i]); + if not assigned(def.genericdef) then + continue; + + old_block_type:=block_type; + block_type:=bt_type; + + genericdef:=def.genericdef; + hmodule:=find_module_from_symtable(genericdef.owner); + if hmodule=nil then + internalerror(2018051202); + oldcurrent_filepos:=current_filepos; + { use the index the module got from the current compilation process } + current_filepos.moduleindex:=hmodule.unit_index; + current_tokenpos:=current_filepos; + if parse_generic then + begin + recordbuf:=current_scanner.recordtokenbuf; + current_scanner.recordtokenbuf:=nil; + end + else + recordbuf:=nil; + replaydepth:=current_scanner.replay_stack_depth; + + current_scanner.startreplaytokens(genericdef.generictokenbuf); + hadtypetoken:=false; + read_named_type(tdef(newdef),def.typesym,genericdef,def.genericparas,false,hadtypetoken); + ttypesym(def.typesym).typedef:=newdef; + newdef.typesym:=def.typesym; + + case newdef.typ of + { Build VMT indexes for classes and read hint directives } + objectdef: + begin + if replaydepth>current_scanner.replay_stack_depth then + begin + try_consume_hintdirective(newdef.typesym.symoptions,newdef.typesym.deprecatedmsg); + if replaydepth>current_scanner.replay_stack_depth then + consume(_SEMICOLON); + end; + + vmtbuilder:=TVMTBuilder.Create(newdef); + vmtbuilder.generate_vmt; + vmtbuilder.free; + end; + end; + current_filepos:=oldcurrent_filepos; + + { Consume the remainder of the buffer } + while current_scanner.replay_stack_depth>replaydepth do + consume(token); + if assigned(recordbuf) then + begin + if assigned(current_scanner.recordtokenbuf) then + internalerror(2018081002); + current_scanner.recordtokenbuf:=recordbuf; + end; + block_type:=old_block_type; + + if Assigned(def.used_by) then + begin + for r := 0 to def.used_by.Count-1 do + case tstoredsym(def.used_by[r]).typ of + fieldvarsym, + staticvarsym, + absolutevarsym, + paravarsym: + tabstractvarsym(def.used_by[r]).vardef := newdef; + propertysym: + tpropertysym(def.used_by[r]).propdef := newdef; + typesym: + ttypesym(def.used_by[r]).typedef := newdef; + else + internalerror(2018081003); + end; + end; + + oldIdx := current_module.globalsymtable.DefList.IndexOf(def); + newDef.defid:= def.defid; + current_module.pendingspecializations.Remove(def); + current_module.pendingspecializations.Add(newDef.typename, newDef); + current_module.globalsymtable.deletedef(def); + current_module.checkforwarddefs.Delete(i); + end; + else + internalerror(2018081004); + end; + end; + end; + + procedure maybe_add_used_by(def : tdef; sym: tsym); + begin + if (def is tobjectdef) and (oo_is_forward in tobjectdef(def).objectoptions) and assigned(tobjectdef(def).genericdef) then + begin + if not Assigned(def.used_by) then + def.used_by := TFPObjectList.Create(False); + def.used_by.Add(sym); + end; + end; procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms,allowunitsym:boolean;out srsym:tsym;out srsymtable:tsymtable;out is_specialize:boolean); forward; diff --git a/compiler/symtype.pas b/compiler/symtype.pas index a59ba6ad43..c80929873c 100644 --- a/compiler/symtype.pas +++ b/compiler/symtype.pas @@ -62,7 +62,9 @@ interface dbg_state : tdefdbgstatus; defoptions : tdefoptions; defstates : tdefstates; + used_by : TFPObjectList; constructor create(dt:tdeftyp); + destructor destroy;override; procedure buildderef;virtual;abstract; procedure buildderefimpl;virtual;abstract; procedure deref;virtual;abstract; @@ -283,6 +285,12 @@ implementation defid:=defid_not_registered; end; + destructor tdef.destroy; + begin + used_by.free; + inherited destroy; + end; + function tdef.typename:string; begin -- 2.16.2.windows.1 |
|
I applied it to test: Ran into problems when TTest<T> = class; has multiple specializations? Can you add tests for it? I may be expecting something wrong. I will keep a copy of the patched fpc trunk but I reverted it for this reason. Note I only test against {$mode delphi} and seldom touch {$mode objfpc} for generics. |
|
Any news? I also tested {$mode objfpc} by now, same answer. |
Date Modified | Username | Field | Change |
---|---|---|---|
2018-08-13 14:03 | Svetozar Belic | New Issue | |
2018-08-13 14:03 | Svetozar Belic | File Added: 0001-Added-support-for-forward-declarations-of-generic-ty.patch | |
2018-08-14 08:46 | Thaddy de Koning | Note Added: 0110027 | |
2018-08-14 08:47 | Thaddy de Koning | Note Edited: 0110027 | View Revisions |
2019-08-09 10:06 | Sven Barth | Tag Attached: generics | |
2019-08-09 10:08 | Thaddy de Koning | Note Added: 0117603 | |
2019-08-15 14:03 | Sven Barth | Status | new => acknowledged |
2019-08-15 14:03 | Sven Barth | FPCTarget | => - |
2019-08-30 15:14 | Sven Barth | Relationship added | has duplicate 0026452 |
2020-05-06 15:13 | Sven Barth | Relationship added | related to 0022402 |