View Issue Details
| ID | Project | Category | View Status | Date Submitted | Last Update |
|---|---|---|---|---|---|
| 0034128 | FPC | Compiler | public | 2018-08-13 14:03 | 2019-08-15 14:03 |
| Reporter | Svetozar Belic | Assigned To | |||
| Priority | normal | Severity | minor | Reproducibility | always |
| Status | acknowledged | Resolution | open | ||
| Product Version | Product Build | ||||
| Target Version | Fixed in Version | ||||
| 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 |
| ||||
|
|
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 | => - |
