diff --git a/.gitattributes b/.gitattributes
index 55923ebf77..67eebf1dbc 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -10808,6 +10808,42 @@ tests/test/tfpu5.pp svneol=native#text/plain
tests/test/tfpuover.pp svneol=native#text/plain
tests/test/tfwork1.pp svneol=native#text/plain
tests/test/tfwork2.pp svneol=native#text/plain
+tests/test/tgenconstraint1.pp svneol=native#text/pascal
+tests/test/tgenconstraint10.pp svneol=native#text/pascal
+tests/test/tgenconstraint11.pp svneol=native#text/pascal
+tests/test/tgenconstraint12.pp svneol=native#text/pascal
+tests/test/tgenconstraint13.pp svneol=native#text/pascal
+tests/test/tgenconstraint14.pp svneol=native#text/pascal
+tests/test/tgenconstraint15.pp svneol=native#text/pascal
+tests/test/tgenconstraint16.pp svneol=native#text/pascal
+tests/test/tgenconstraint17.pp svneol=native#text/pascal
+tests/test/tgenconstraint18.pp svneol=native#text/pascal
+tests/test/tgenconstraint19.pp svneol=native#text/pascal
+tests/test/tgenconstraint2.pp svneol=native#text/pascal
+tests/test/tgenconstraint20.pp svneol=native#text/pascal
+tests/test/tgenconstraint21.pp svneol=native#text/pascal
+tests/test/tgenconstraint22.pp svneol=native#text/pascal
+tests/test/tgenconstraint23.pp svneol=native#text/pascal
+tests/test/tgenconstraint24.pp svneol=native#text/pascal
+tests/test/tgenconstraint25.pp svneol=native#text/pascal
+tests/test/tgenconstraint26.pp svneol=native#text/pascal
+tests/test/tgenconstraint27.pp svneol=native#text/pascal
+tests/test/tgenconstraint28.pp svneol=native#text/pascal
+tests/test/tgenconstraint29.pp svneol=native#text/pascal
+tests/test/tgenconstraint3.pp svneol=native#text/pascal
+tests/test/tgenconstraint30.pp svneol=native#text/pascal
+tests/test/tgenconstraint31.pp svneol=native#text/pascal
+tests/test/tgenconstraint32.pp svneol=native#text/pascal
+tests/test/tgenconstraint33.pp svneol=native#text/pascal
+tests/test/tgenconstraint34.pp svneol=native#text/pascal
+tests/test/tgenconstraint35.pp svneol=native#text/pascal
+tests/test/tgenconstraint36.pp svneol=native#text/pascal
+tests/test/tgenconstraint4.pp svneol=native#text/pascal
+tests/test/tgenconstraint5.pp svneol=native#text/pascal
+tests/test/tgenconstraint6.pp svneol=native#text/pascal
+tests/test/tgenconstraint7.pp svneol=native#text/pascal
+tests/test/tgenconstraint8.pp svneol=native#text/pascal
+tests/test/tgenconstraint9.pp svneol=native#text/pascal
tests/test/tgeneric1.pp svneol=native#text/plain
tests/test/tgeneric10.pp svneol=native#text/plain
tests/test/tgeneric11.pp svneol=native#text/plain
@@ -10944,6 +10980,7 @@ tests/test/thlp42.pp svneol=native#text/pascal
tests/test/thlp43.pp svneol=native#text/pascal
tests/test/thlp44.pp svneol=native#text/pascal
tests/test/thlp45.pp svneol=native#text/pascal
+tests/test/thlp46.pp svneol=native#text/pascal
tests/test/thlp5.pp svneol=native#text/pascal
tests/test/thlp6.pp svneol=native#text/pascal
tests/test/thlp7.pp svneol=native#text/pascal
@@ -11478,6 +11515,7 @@ tests/test/udots.prog.pp svneol=native#text/pascal
tests/test/udots.test.pp svneol=native#text/pascal
tests/test/uenum2a.pp svneol=native#text/plain
tests/test/uenum2b.pp svneol=native#text/plain
+tests/test/ugenconstraints.pas svneol=native#text/pascal
tests/test/ugeneric.test75.pp svneol=native#text/pascal
tests/test/ugeneric10.pp svneol=native#text/plain
tests/test/ugeneric14.pp svneol=native#text/plain
diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas
index cbab610dab..06a310233a 100644
--- a/compiler/pdecl.pas
+++ b/compiler/pdecl.pas
@@ -422,7 +422,7 @@ implementation
Message(parser_f_no_generic_inside_generic);
consume(_LSHARPBRACKET);
- generictypelist:=parse_generic_parameters;
+ generictypelist:=parse_generic_parameters(true);
consume(_RSHARPBRACKET);
str(generictypelist.Count,s);
diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas
index cc535eb552..ca360f109f 100644
--- a/compiler/pdecsub.pas
+++ b/compiler/pdecsub.pas
@@ -721,7 +721,7 @@ implementation
consume(_LSHARPBRACKET);
genparalist:=tfpobjectlist.create(false);
- if not parse_generic_specialization_types(genparalist,prettyname,specializename,nil) then
+ if not parse_generic_specialization_types(genparalist,nil,prettyname,specializename) then
srsym:=generrorsym
else
begin
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 5c51458d1c..c39e88b233 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -3181,7 +3181,7 @@ implementation
check_hints(parseddef.typesym,parseddef.typesym.symoptions,parseddef.typesym.deprecatedmsg);
{ generate the specialization }
- generate_specialization(gendef,false,'',parseddef,gensym.RealName);
+ generate_specialization(gendef,false,'',parseddef,gensym.RealName,p2.fileinfo);
{ we don't need the old left and right nodes anymore }
p1.Free;
@@ -3272,7 +3272,7 @@ implementation
Internalerror(2011071401);
{ generate the specialization }
- generate_specialization(gendef,false,'',nil,'');
+ generate_specialization(gendef,false,'');
{ we don't need the old p2 anymore }
p2.Free;
diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas
index 1b41f3fb0e..4ec2dc752d 100644
--- a/compiler/pgenutil.pas
+++ b/compiler/pgenutil.pas
@@ -34,9 +34,10 @@ uses
{ symtable }
symtype,symdef,symbase;
- procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string);
- function parse_generic_parameters:TFPObjectList;
- function parse_generic_specialization_types(genericdeflist:tfpobjectlist;out prettyname,specializename:ansistring;parsedtype:tdef):boolean;
+ procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string;parsedpos:tfileposinfo);
+ procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string);
+ function parse_generic_parameters(allowconstraints:boolean):TFPObjectList;
+ function parse_generic_specialization_types(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfpobjectlist);
function generate_generic_name(const name:tidstring;specializename:ansistring):tidstring;
@@ -97,7 +98,265 @@ uses
end;
end;
- procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string);
+ function check_generic_constraints(genericdef:tstoreddef;paradeflist:tfpobjectlist;poslist:tfplist):boolean;
+ var
+ i,j,
+ intfcount : longint;
+ paradef : tstoreddef;
+ objdef,
+ paraobjdef,
+ formalobjdef : tobjectdef;
+ generictype : ttypesym;
+ intffound : boolean;
+ filepos : tfileposinfo;
+ begin
+ { check whether the given specialization parameters fit to the eventual
+ constraints of the generic }
+ if genericdef.genericparas.count=0 then
+ internalerror(2012101001);
+ if genericdef.genericparas.count<>paradeflist.count then
+ internalerror(2012101002);
+ if paradeflist.count<>poslist.count then
+ internalerror(2012120801);
+ result:=true;
+ for i:=0 to genericdef.genericparas.count-1 do
+ begin
+ generictype:=ttypesym(genericdef.genericparas[i]);
+ filepos:=pfileposinfo(poslist[i])^;
+ if not assigned(generictype.genconstraintdata) then
+ { the parameter is of unspecified type, so no need to check }
+ continue;
+ paradef:=tstoreddef(paradeflist[i]);
+ { undefineddef is compatible with anything }
+ if generictype.typedef.typ=undefineddef then
+ continue;
+ if paradef.typ<>generictype.typedef.typ then
+ begin
+ case generictype.typedef.typ of
+ recorddef:
+ MessagePos(filepos,type_e_record_type_expected);
+ objectdef:
+ case tobjectdef(generictype.typedef).objecttype of
+ odt_class,
+ odt_javaclass:
+ MessagePos1(filepos,type_e_class_type_expected,paradef.typename);
+ odt_interfacecom,
+ odt_interfacecorba,
+ odt_dispinterface,
+ odt_interfacejava:
+ MessagePos1(filepos,type_e_interface_type_expected,paradef.typename);
+ else
+ internalerror(2012101003);
+ end;
+ errordef:
+ { ignore }
+ ;
+ else
+ internalerror(2012101004);
+ end;
+ result:=false;
+ end
+ else
+ begin
+ { the paradef types are the same, so do special checks for the
+ cases in which they are needed }
+ if generictype.typedef.typ=objectdef then
+ begin
+ paraobjdef:=tobjectdef(paradef);
+ formalobjdef:=tobjectdef(generictype.typedef);
+ if not (formalobjdef.objecttype in [odt_class,odt_javaclass,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface]) then
+ internalerror(2012101102);
+ if formalobjdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface] then
+ begin
+ { this is either a concerete interface or class type (the
+ latter without specific implemented interfaces) }
+ case paraobjdef.objecttype of
+ odt_interfacecom,
+ odt_interfacecorba,
+ odt_interfacejava,
+ odt_dispinterface:
+ if not paraobjdef.is_related(formalobjdef) then
+ begin
+ MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.typename);
+ result:=false;
+ end;
+ odt_class,
+ odt_javaclass:
+ begin
+ objdef:=paraobjdef;
+ intffound:=false;
+ while assigned(objdef) do
+ begin
+ for j:=0 to objdef.implementedinterfaces.count-1 do
+ if timplementedinterface(objdef.implementedinterfaces[j]).intfdef=formalobjdef then
+ begin
+ intffound:=true;
+ break;
+ end;
+ if intffound then
+ break;
+ objdef:=objdef.childof;
+ end;
+ result:=intffound;
+ if not result then
+ MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,formalobjdef.typename);
+ end;
+ else
+ begin
+ MessagePos1(filepos,type_e_class_or_interface_type_expected,paraobjdef.typename);
+ result:=false;
+ end;
+ end;
+ end
+ else
+ if df_genconstraint in formalobjdef.defoptions then
+ begin
+ { this is either a "class" or a concrete instance
+ which shall implement interfaces }
+ if not (paraobjdef.objecttype in [odt_class,odt_javaclass]) then
+ begin
+ MessagePos1(filepos,type_e_class_type_expected,paraobjdef.typename);
+ result:=false;
+ continue;
+ end;
+ if assigned(formalobjdef.childof) and
+ not paradef.is_related(formalobjdef.childof) then
+ begin
+ MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
+ result:=false;
+ end;
+ intfcount:=0;
+ for j:=0 to formalobjdef.implementedinterfaces.count-1 do
+ begin
+ objdef:=paraobjdef;
+ while assigned(objdef) do
+ begin
+ intffound:=assigned(
+ objdef.find_implemented_interface(
+ timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef
+ )
+ );
+ if intffound then
+ break;
+ objdef:=objdef.childof;
+ end;
+ if intffound then
+ inc(intfcount)
+ else
+ MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef.typename);
+ end;
+ if intfcount<>formalobjdef.implementedinterfaces.count then
+ result:=false;
+ end
+ else
+ if not paraobjdef.is_related(formalobjdef) then
+ begin
+ MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.typename);
+ result:=false;
+ end;
+ end;
+ end;
+ end;
+ end;
+
+
+ function parse_generic_specialization_types_internal(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring;parsedtype:tdef;parsedpos:tfileposinfo):boolean;
+ var
+ old_block_type : tblock_type;
+ first : boolean;
+ typeparam : tnode;
+ parampos : pfileposinfo;
+ tmpparampos : tfileposinfo;
+ begin
+ result:=true;
+ if genericdeflist=nil then
+ internalerror(2012061401);
+ { set the block type to type, so that the parsed type are returned as
+ ttypenode (e.g. classes are in non type-compatible blocks returned as
+ tloadvmtaddrnode) }
+ old_block_type:=block_type;
+ { if parsedtype is set, then the first type identifer was already parsed
+ (happens in inline specializations) and thus we only need to parse
+ the remaining types and do as if the first one was already given }
+ first:=not assigned(parsedtype);
+ if assigned(parsedtype) then
+ begin
+ genericdeflist.Add(parsedtype);
+ specializename:='$'+parsedtype.typename;
+ prettyname:=parsedtype.typesym.prettyname;
+ if assigned(poslist) then
+ begin
+ New(parampos);
+ parampos^:=parsedpos;
+ poslist.add(parampos);
+ end;
+ end
+ else
+ begin
+ specializename:='';
+ prettyname:='';
+ end;
+ while not (token in [_GT,_RSHARPBRACKET]) do
+ begin
+ { "first" is set to false at the end of the loop! }
+ if not first then
+ consume(_COMMA);
+ block_type:=bt_type;
+ tmpparampos:=current_filepos;
+ typeparam:=factor(false,true);
+ if typeparam.nodetype=typen then
+ begin
+ if df_generic in typeparam.resultdef.defoptions then
+ Message(parser_e_no_generics_as_params);
+ if assigned(poslist) then
+ begin
+ New(parampos);
+ parampos^:=tmpparampos;
+ poslist.add(parampos);
+ end;
+ genericdeflist.Add(typeparam.resultdef);
+ if not assigned(typeparam.resultdef.typesym) then
+ message(type_e_generics_cannot_reference_itself)
+ else
+ begin
+ specializename:=specializename+'$'+typeparam.resultdef.typename;
+ if first then
+ prettyname:=prettyname+typeparam.resultdef.typesym.prettyname
+ else
+ prettyname:=prettyname+','+typeparam.resultdef.typesym.prettyname;
+ end;
+ end
+ else
+ begin
+ Message(type_e_type_id_expected);
+ result:=false;
+ end;
+ typeparam.free;
+ first:=false;
+ end;
+ block_type:=old_block_type;
+ end;
+
+
+ function parse_generic_specialization_types(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
+ var
+ dummypos : tfileposinfo;
+ begin
+ FillChar(dummypos, SizeOf(tfileposinfo), 0);
+ result:=parse_generic_specialization_types_internal(genericdeflist,poslist,prettyname,specializename,nil,dummypos);
+ end;
+
+
+ procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string);
+ var
+ dummypos : tfileposinfo;
+ begin
+ FillChar(dummypos, SizeOf(tfileposinfo), 0);
+ generate_specialization(tt,parse_class_parent,_prettyname,nil,'',dummypos);
+ end;
+
+
+ procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string;parsedpos:tfileposinfo);
var
st : TSymtable;
srsym : tsym;
@@ -108,7 +367,6 @@ uses
errval,
i,
gencount : longint;
- crc : cardinal;
genericdef,def : tstoreddef;
generictype : ttypesym;
genericdeflist : TFPObjectList;
@@ -127,6 +385,7 @@ uses
state : tspecializationstate;
hmodule : tmodule;
oldcurrent_filepos : tfileposinfo;
+ poslist : tfplist;
begin
{ retrieve generic def that we are going to replace }
genericdef:=tstoreddef(tt);
@@ -218,14 +477,19 @@ uses
if not assigned(parsedtype) and not try_to_consume(_LT) then
consume(_LSHARPBRACKET);
- generictypelist:=TFPObjectList.create(false);
genericdeflist:=TFPObjectList.Create(false);
+ poslist:=tfplist.create;
{ Parse type parameters }
- err:=not parse_generic_specialization_types(genericdeflist,prettyname,specializename,parsedtype);
+ err:=not parse_generic_specialization_types_internal(genericdeflist,poslist,prettyname,specializename,parsedtype,parsedpos);
if err then
begin
- try_to_consume(_RSHARPBRACKET);
+ if not try_to_consume(_GT) then
+ try_to_consume(_RSHARPBRACKET);
+ genericdeflist.free;
+ for i:=0 to poslist.count-1 do
+ dispose(pfileposinfo(poslist[i]));
+ poslist.free;
tt:=generrordef;
exit;
end;
@@ -295,8 +559,12 @@ uses
if not found or (srsym.typ<>typesym) then
begin
identifier_not_found(genname);
+ if not try_to_consume(_GT) then
+ try_to_consume(_RSHARPBRACKET);
+ for i:=0 to poslist.count-1 do
+ dispose(pfileposinfo(poslist[i]));
+ poslist.free;
genericdeflist.Free;
- generictypelist.Free;
tt:=generrordef;
exit;
end;
@@ -304,6 +572,20 @@ uses
{ we've found the correct def }
genericdef:=tstoreddef(ttypesym(srsym).typedef);
+ if not check_generic_constraints(genericdef,genericdeflist,poslist) then
+ begin
+ { the parameters didn't fit the constraints, so don't continue with the
+ specialization }
+ genericdeflist.free;
+ for i:=0 to poslist.count-1 do
+ dispose(pfileposinfo(poslist[i]));
+ poslist.free;
+ tt:=generrordef;
+ if not try_to_consume(_GT) then
+ try_to_consume(_RSHARPBRACKET);
+ exit;
+ end;
+
{ build the new type's name }
finalspecializename:=generate_generic_name(genname,specializename);
ufinalspecializename:=upper(finalspecializename);
@@ -324,6 +606,8 @@ uses
internalerror(200511182);
end;
+ generictypelist:=tfpobjectlist.create(false);
+
{ build the list containing the types for the generic params }
gencount:=0;
for i:=0 to st.SymList.Count-1 do
@@ -558,11 +842,19 @@ uses
end;
- function parse_generic_parameters:TFPObjectList;
+ function parse_generic_parameters(allowconstraints:boolean):TFPObjectList;
var
generictype : ttypesym;
+ i,firstidx : longint;
+ srsymtable : tsymtable;
+ def : tdef;
+ defname : tidstring;
+ allowconstructor,
+ doconsume : boolean;
+ constraintdata : tgenericconstraintdata;
begin
result:=TFPObjectList.Create(false);
+ firstidx:=0;
repeat
if token=_ID then
begin
@@ -571,70 +863,131 @@ uses
result.add(generictype);
end;
consume(_ID);
- until not try_to_consume(_COMMA) ;
+ if try_to_consume(_COLON) then
+ begin
+ if not allowconstraints then
+ { TODO }
+ Message(parser_e_illegal_expression{ parser_e_generic_constraints_not_allowed_here});
+ { construct a name which can be used for a type specification }
+ constraintdata:=tgenericconstraintdata.create;
+ defname:='';
+ str(current_module.deflist.count,defname);
+ defname:='$gendef'+defname;
+
+ allowconstructor:=m_delphi in current_settings.modeswitches;
+
+ constraintdata.basedef:=generrordef;
+ repeat
+ doconsume:=true;
+
+ case token of
+ _CONSTRUCTOR:
+ begin
+ if not allowconstructor or (gcf_constructor in constraintdata.flags) then
+ Message(parser_e_illegal_expression);
+ include(constraintdata.flags,gcf_constructor);
+ allowconstructor:=false;
+ end;
+ _CLASS:
+ begin
+ if gcf_class in constraintdata.flags then
+ Message(parser_e_illegal_expression);
+ if constraintdata.basedef=generrordef then
+ include(constraintdata.flags,gcf_class)
+ else
+ Message(parser_e_illegal_expression);
+ end;
+ _RECORD:
+ begin
+ if ([gcf_constructor,gcf_class]*constraintdata.flags<>[])
+ or (constraintdata.interfaces.count>0) then
+ Message(parser_e_illegal_expression)
+ else
+ begin
+ srsymtable:=trecordsymtable.create(defname,0);
+ constraintdata.basedef:=trecorddef.create(defname,srsymtable);
+ include(constraintdata.flags,gcf_record);
+ allowconstructor:=false;
+ end;
+ end;
+ else
+ begin
+ { after single_type "token" is the trailing ",", ";" or
+ ">"! }
+ doconsume:=false;
+ { def is already set to a class or record }
+ if gcf_record in constraintdata.flags then
+ Message(parser_e_illegal_expression);
+ single_type(def, [stoAllowSpecialization]);
+ { only types that are inheritable are allowed }
+ if (def.typ<>objectdef) or
+ not (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_javaclass]) then
+ Message(type_e_class_or_interface_type_expected);
+ case tobjectdef(def).objecttype of
+ odt_class,
+ odt_javaclass:
+ begin
+ if gcf_class in constraintdata.flags then
+ { "class" + concrete class is not allowed }
+ Message(parser_e_illegal_expression)
+ else
+ { do we already have a concrete class? }
+ if constraintdata.basedef<>generrordef then
+ Message(parser_e_illegal_expression)
+ else
+ constraintdata.basedef:=def;
+ end;
+ odt_interfacecom,
+ odt_interfacecorba,
+ odt_interfacejava,
+ odt_dispinterface:
+ constraintdata.interfaces.add(def);
+ end;
+ end;
+ end;
+ if doconsume then
+ consume(token);
+ until not try_to_consume(_COMMA);
+
+ if ([gcf_class,gcf_constructor]*constraintdata.flags<>[]) or
+ ((constraintdata.interfaces.count>1) and (constraintdata.basedef=generrordef)) or
+ ((constraintdata.interfaces.count>0) and (constraintdata.basedef<>generrordef)) then
+ begin
+ if constraintdata.basedef.typ=errordef then
+ { don't pass an errordef as a parent to a tobjectdef }
+ constraintdata.basedef:=nil
+ else
+ if constraintdata.basedef.typ<>objectdef then
+ internalerror(2012101101);
+ constraintdata.basedef:=tobjectdef.create({$ifdef jvm}odt_javaclass{$else}odt_class{$endif},defname,tobjectdef(constraintdata.basedef));
+ include(constraintdata.basedef.defoptions,df_genconstraint);
+ for i:=0 to constraintdata.interfaces.count-1 do
+ tobjectdef(constraintdata.basedef).implementedinterfaces.add(
+ timplementedinterface.create(tobjectdef(constraintdata.interfaces[i])));
+ end
+ else
+ if constraintdata.interfaces.count=1 then
+ begin
+ constraintdata.basedef:=tdef(constraintdata.interfaces[0]);
+ constraintdata.interfaces.delete(0);
+ end;
+
+ for i:=firstidx to result.count-1 do
+ with ttypesym(result[i]) do
+ begin
+ genconstraintdata:=tgenericconstraintdata.create;
+ genconstraintdata.basedef:=constraintdata.basedef;
+ genconstraintdata.flags:=constraintdata.flags;
+ genconstraintdata.interfaces.assign(constraintdata.interfaces);
+ typedef:=constraintdata.basedef;
+ end;
+ firstidx:=result.count;
+
+ constraintdata.free;
+ end;
+ until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
end;
- function parse_generic_specialization_types(genericdeflist:tfpobjectlist;out prettyname,specializename:ansistring;parsedtype:tdef):boolean;
- var
- old_block_type : tblock_type;
- first : boolean;
- typeparam : tnode;
- begin
- result:=true;
- if genericdeflist=nil then
- internalerror(2012061401);
- { set the block type to type, so that the parsed type are returned as
- ttypenode (e.g. classes are in non type-compatible blocks returned as
- tloadvmtaddrnode) }
- old_block_type:=block_type;
- { if parsedtype is set, then the first type identifer was already parsed
- (happens in inline specializations) and thus we only need to parse
- the remaining types and do as if the first one was already given }
- first:=not assigned(parsedtype);
- if assigned(parsedtype) then
- begin
- genericdeflist.Add(parsedtype);
- specializename:='$'+parsedtype.typename;
- prettyname:=parsedtype.typesym.prettyname;
- end
- else
- begin
- specializename:='';
- prettyname:='';
- end;
- while not (token in [_GT,_RSHARPBRACKET]) do
- begin
- { "first" is set to false at the end of the loop! }
- if not first then
- consume(_COMMA);
- block_type:=bt_type;
- typeparam:=factor(false,true);
- if typeparam.nodetype=typen then
- begin
- if df_generic in typeparam.resultdef.defoptions then
- Message(parser_e_no_generics_as_params);
- genericdeflist.Add(typeparam.resultdef);
- if not assigned(typeparam.resultdef.typesym) then
- message(type_e_generics_cannot_reference_itself)
- else
- begin
- specializename:=specializename+'$'+typeparam.resultdef.typename;
- if first then
- prettyname:=prettyname+typeparam.resultdef.typesym.prettyname
- else
- prettyname:=prettyname+','+typeparam.resultdef.typesym.prettyname;
- end;
- end
- else
- begin
- Message(type_e_type_id_expected);
- result:=false;
- end;
- typeparam.free;
- first:=false;
- end;
- block_type:=old_block_type;
- end;
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
var
@@ -646,6 +999,12 @@ uses
if not assigned(genericlist) then
exit;
+ if assigned(genericdef) then
+ include(def.defoptions,df_specialization)
+ else
+ if genericlist.count>0 then
+ include(def.defoptions,df_generic);
+
case def.typ of
recorddef,objectdef: st:=tabstractrecorddef(def).symtable;
arraydef: st:=tarraydef(def).symtable;
@@ -657,10 +1016,6 @@ uses
for i:=0 to genericlist.count-1 do
begin
generictype:=ttypesym(genericlist[i]);
- if generictype.typedef.typ=undefineddef then
- include(def.defoptions,df_generic)
- else
- include(def.defoptions,df_specialization);
st.insert(generictype);
include(generictype.symoptions,sp_generic_para);
def.genericparas.add(generictype.name,generictype);
diff --git a/compiler/ptype.pas b/compiler/ptype.pas
index 1fd72d4909..1778a2f5cd 100644
--- a/compiler/ptype.pas
+++ b/compiler/ptype.pas
@@ -453,7 +453,7 @@ implementation
begin
if def.typ=forwarddef then
def:=ttypesym(srsym).typedef;
- generate_specialization(def,stoParseClassParent in options,'',nil,'');
+ generate_specialization(def,stoParseClassParent in options,'');
end
else
begin
@@ -968,7 +968,7 @@ implementation
end;
if dospecialize then
begin
- generate_specialization(def,false,name,nil,'');
+ generate_specialization(def,false,name);
{ handle nested types }
if assigned(def) then
post_comp_expr_gendef(def);
@@ -1689,7 +1689,7 @@ implementation
objectdef :
begin
{ Skip generics and forward defs }
- if (df_generic in def.defoptions) or
+ if ([df_generic,df_genconstraint]*def.defoptions<>[]) or
(oo_is_forward in tobjectdef(def).objectoptions) then
continue;
write_persistent_type_info(tobjectdef(def).symtable,is_global);
diff --git a/compiler/symconst.pas b/compiler/symconst.pas
index f2983df96e..69c3b2fdb8 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -187,7 +187,9 @@ type
{ type is a specialization of a generic type }
df_specialization,
{ def has been copied from another def so symtable is not owned }
- df_copied_def
+ df_copied_def,
+ { def was created as a generic constraint and thus is only "shallow" }
+ df_genconstraint
);
tdefoptions=set of tdefoption;
diff --git a/compiler/symsym.pas b/compiler/symsym.pas
index 4046c343f0..21475f5cf9 100644
--- a/compiler/symsym.pas
+++ b/compiler/symsym.pas
@@ -121,12 +121,35 @@ interface
property ProcdefList:TFPObjectList read FProcdefList;
end;
+ tgenericconstraintflag=(
+ gcf_constructor,
+ gcf_class,
+ gcf_record
+ );
+ tgenericconstraintflags=set of tgenericconstraintflag;
+
+ tgenericconstraintdata=class
+ basedef : tdef;
+ basedefderef : tderef;
+ interfaces : tfpobjectlist;
+ interfacesderef : tfplist;
+ flags : tgenericconstraintflags;
+ constructor create;
+ destructor destroy;override;
+ procedure ppuload(ppufile:tcompilerppufile);
+ procedure ppuwrite(ppufile:tcompilerppufile);
+ procedure buildderef;
+ procedure deref;
+ end;
+
ttypesym = class(Tstoredsym)
public
+ genconstraintdata : tgenericconstraintdata;
typedef : tdef;
typedefderef : tderef;
fprettyname : ansistring;
constructor create(const n : string;def:tdef);
+ destructor destroy;override;
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
procedure buildderef;override;
@@ -2352,6 +2375,77 @@ implementation
TTYPESYM
****************************************************************************}
+
+ constructor tgenericconstraintdata.create;
+ begin
+ interfaces:=tfpobjectlist.create(false);
+ interfacesderef:=tfplist.create;
+ end;
+
+
+ destructor tgenericconstraintdata.destroy;
+ var
+ i : longint;
+ begin
+ for i:=0 to interfacesderef.count-1 do
+ dispose(pderef(interfacesderef[i]));
+ interfacesderef.free;
+ interfaces.free;
+ inherited destroy;
+ end;
+
+ procedure tgenericconstraintdata.ppuload(ppufile: tcompilerppufile);
+ var
+ cnt,i : longint;
+ intfderef : pderef;
+ begin
+ ppufile.getsmallset(flags);
+ ppufile.getderef(basedefderef);
+ cnt:=ppufile.getlongint;
+ for i:=0 to cnt-1 do
+ begin
+ new(intfderef);
+ ppufile.getderef(intfderef^);
+ interfacesderef.add(intfderef);
+ end;
+ end;
+
+
+ procedure tgenericconstraintdata.ppuwrite(ppufile: tcompilerppufile);
+ var
+ i : longint;
+ begin
+ ppufile.putsmallset(flags);
+ ppufile.putderef(basedefderef);
+ ppufile.putlongint(interfacesderef.count);
+ for i:=0 to interfacesderef.count-1 do
+ ppufile.putderef(pderef(interfacesderef[i])^);
+ end;
+
+ procedure tgenericconstraintdata.buildderef;
+ var
+ intfderef : pderef;
+ i : longint;
+ begin
+ basedefderef.build(basedef);
+ for i:=0 to interfaces.count-1 do
+ begin
+ new(intfderef);
+ intfderef^.build(tobjectdef(interfaces[i]));
+ interfacesderef.add(intfderef);
+ end;
+ end;
+
+ procedure tgenericconstraintdata.deref;
+ var
+ i : longint;
+ begin
+ basedef:=tdef(basedefderef.resolve);
+ for i:=0 to interfacesderef.count-1 do
+ interfaces.add(pderef(interfacesderef[i])^.resolve);
+ end;
+
+
constructor ttypesym.create(const n : string;def:tdef);
begin
@@ -2364,24 +2458,39 @@ implementation
typedef.typesym:=self;
end;
+ destructor ttypesym.destroy;
+ begin
+ genconstraintdata.free;
+ inherited destroy;
+ end;
+
constructor ttypesym.ppuload(ppufile:tcompilerppufile);
begin
inherited ppuload(typesym,ppufile);
ppufile.getderef(typedefderef);
fprettyname:=ppufile.getansistring;
+ if ppufile.getbyte<>0 then
+ begin
+ genconstraintdata:=tgenericconstraintdata.create;
+ genconstraintdata.ppuload(ppufile);
+ end;
end;
procedure ttypesym.buildderef;
begin
typedefderef.build(typedef);
+ if assigned(genconstraintdata) then
+ genconstraintdata.buildderef;
end;
procedure ttypesym.deref;
begin
typedef:=tdef(typedefderef.resolve);
+ if assigned(genconstraintdata) then
+ genconstraintdata.deref;
end;
@@ -2390,6 +2499,13 @@ implementation
inherited ppuwrite(ppufile);
ppufile.putderef(typedefderef);
ppufile.putansistring(fprettyname);
+ if assigned(genconstraintdata) then
+ begin
+ ppufile.putbyte(1);
+ genconstraintdata.ppuwrite(ppufile);
+ end
+ else
+ ppufile.putbyte(0);
ppufile.writeentry(ibtypesym);
end;
diff --git a/compiler/symtype.pas b/compiler/symtype.pas
index ae2d381ffa..1ff195f77e 100644
--- a/compiler/symtype.pas
+++ b/compiler/symtype.pas
@@ -137,6 +137,7 @@ interface
procedure build(s:TObject);
function resolve:TObject;
end;
+ pderef = ^tderef;
{************************************************
tpropaccesslist
diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp
index cad83e06c4..2d583774dc 100644
--- a/compiler/utils/ppudump.pp
+++ b/compiler/utils/ppudump.pp
@@ -1170,7 +1170,8 @@ const
(mask:df_unique; str:'Unique Type'),
(mask:df_generic; str:'Generic'),
(mask:df_specialization; str:'Specialization'),
- (mask:df_copied_def; str:'Copied Typedef')
+ (mask:df_copied_def; str:'Copied Typedef'),
+ (mask:df_genconstraint; str:'Generic Constraint')
);
defstate : array[1..ord(high(tdefstate))] of tdefstateinfo=(
(mask:ds_vmt_written; str:'VMT Written'),
diff --git a/tests/test/tgenconstraint1.pp b/tests/test/tgenconstraint1.pp
new file mode 100644
index 0000000000..76d737816e
--- /dev/null
+++ b/tests/test/tgenconstraint1.pp
@@ -0,0 +1,78 @@
+{ %NORUN }
+
+{ Extensively test the Delphi compatible constraint syntax }
+
+program tgenconstraint1;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+{ types used for tests }
+uses
+ ugenconstraints;
+
+type
+ TTest1TObject = TTest1<TObject>;
+ // the documentation did say something different here...
+ //TTest1IInterface = TTest1<IInterface>;
+ TTest1TTestClass = TTest1<TTestClass>;
+
+ TTest2TTestRec = TTest2<TTestRec>;
+
+ TTest3TTestClass = TTest3<TTestClass>;
+ TTest3TTestClass2 = TTest3<TTestClass2>;
+
+ { ToDo }
+ TTest4TTestClass = TTest4<TTestClass>;
+ TTest4TTestClass2 = TTest4<TTestClass2>;
+
+ TTest5IInterface = TTest5<IInterface>;
+ TTest5ITest1 = TTest5<ITest1>;
+ TTest5ITest2 = TTest5<ITest2>;
+ TTest5TInterfacedObject = TTest5<TInterfacedObject>;
+
+ TTest6TTestClass3 = TTest6<TTestClass3>;
+ TTest6TTestClass4 = TTest6<TTestClass4>;
+
+ TTest7TTestClass4 = TTest7<TTestClass4>;
+
+ TTest8TTestClass3 = TTest8<TTestClass3>;
+ TTest8TTestClass4 = TTest8<TTestClass4>;
+ //TTest8TTestClass5 = TTest8<TTestClass5>;
+
+ // TTest9 is the same as TTest8
+
+ TTest10TTestClass3 = TTest10<TTestClass3>;
+ TTest10TTestClass6 = TTest10<TTestClass6>;
+
+ // TTest11 is the same as TTest10
+
+ TTest12TTestClass = TTest12<TTestClass7>;
+
+ TTest13TTestClass = TTest13<TTestClass>;
+ TTest13TTestClass6 = TTest13<TTestClass2>;
+
+ // TTest14 is the same as TTest10
+
+ TTest15TTestClass8 = TTest15<TTestClass8>;
+
+ TTest16TTestClass3 = TTest16<TTestClass3>;
+
+ TTest17ITest1ITest1 = TTest17<ITest1, ITest1>;
+ TTest17ITestClass3ITest2 = TTest17<TTestClass3, ITest2>;
+
+ TTest18ITest1ITest2 = TTest18<ITest1, ITest2>;
+ TTest18TTestClass3TTestClass5 = TTest18<TTestClass3, TTestClass5>;
+ TTest18TTestClass4TTestClass4TTestClass4 = TTest18<TTestClass4, TTestClass4>;
+
+ TTest19TTestRecTObject = TTest19<TTestRec, TObject>;
+
+ TTest20TTestClassTTestClass = TTest20<TTestClass, TTestClass>;
+
+ TTest21TObject = TTest21<TObject>;
+ TTest21TestClass = TTest21<TTestClass>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint10.pp b/tests/test/tgenconstraint10.pp
new file mode 100644
index 0000000000..89e5b90aef
--- /dev/null
+++ b/tests/test/tgenconstraint10.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint10;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest3TTestObject1 = TTest3<TTestObject1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint11.pp b/tests/test/tgenconstraint11.pp
new file mode 100644
index 0000000000..7e6687fc76
--- /dev/null
+++ b/tests/test/tgenconstraint11.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint11;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest4TTestRec = TTest4<TTestRec>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint12.pp b/tests/test/tgenconstraint12.pp
new file mode 100644
index 0000000000..47b898f94e
--- /dev/null
+++ b/tests/test/tgenconstraint12.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint12;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest4ITest1 = TTest4<ITest1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint13.pp b/tests/test/tgenconstraint13.pp
new file mode 100644
index 0000000000..7a23e64540
--- /dev/null
+++ b/tests/test/tgenconstraint13.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint13;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest4TTestObject1 = TTest4<TTestObject1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint14.pp b/tests/test/tgenconstraint14.pp
new file mode 100644
index 0000000000..cdfebc6f6b
--- /dev/null
+++ b/tests/test/tgenconstraint14.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint14;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest5TObject = TTest5<TObject>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint15.pp b/tests/test/tgenconstraint15.pp
new file mode 100644
index 0000000000..c62459792c
--- /dev/null
+++ b/tests/test/tgenconstraint15.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint15;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest5TTestRec = TTest5<TTestRec>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint16.pp b/tests/test/tgenconstraint16.pp
new file mode 100644
index 0000000000..bcb0cb7b2c
--- /dev/null
+++ b/tests/test/tgenconstraint16.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint16;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest5TTestObject1 = TTest5<TTestObject1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint17.pp b/tests/test/tgenconstraint17.pp
new file mode 100644
index 0000000000..89295a4abd
--- /dev/null
+++ b/tests/test/tgenconstraint17.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint17;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest7IInterface = TTest7<IInterface>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint18.pp b/tests/test/tgenconstraint18.pp
new file mode 100644
index 0000000000..9cf4c3040b
--- /dev/null
+++ b/tests/test/tgenconstraint18.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint18;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest7TTestClass5 = TTest7<TTestClass5>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint19.pp b/tests/test/tgenconstraint19.pp
new file mode 100644
index 0000000000..dc353bd928
--- /dev/null
+++ b/tests/test/tgenconstraint19.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint19;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest7ITest1 = TTest7<ITest1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint2.pp b/tests/test/tgenconstraint2.pp
new file mode 100644
index 0000000000..d49e1e9e76
--- /dev/null
+++ b/tests/test/tgenconstraint2.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint2;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest1TTestRec = TTest1<TTestRec>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint20.pp b/tests/test/tgenconstraint20.pp
new file mode 100644
index 0000000000..cbc05b7e32
--- /dev/null
+++ b/tests/test/tgenconstraint20.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint20;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest7TTestClass3 = TTest7<TTestClass3>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint21.pp b/tests/test/tgenconstraint21.pp
new file mode 100644
index 0000000000..2411860b0f
--- /dev/null
+++ b/tests/test/tgenconstraint21.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint21;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest8ITest1 = TTest8<ITest1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint22.pp b/tests/test/tgenconstraint22.pp
new file mode 100644
index 0000000000..b702301206
--- /dev/null
+++ b/tests/test/tgenconstraint22.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint22;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest12TTestClass = TTest12<TTestClass>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint23.pp b/tests/test/tgenconstraint23.pp
new file mode 100644
index 0000000000..06df2e8ad1
--- /dev/null
+++ b/tests/test/tgenconstraint23.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint23;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest12TTestClass9 = TTest12<TTestClass9>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint24.pp b/tests/test/tgenconstraint24.pp
new file mode 100644
index 0000000000..089fb7e3a1
--- /dev/null
+++ b/tests/test/tgenconstraint24.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint24;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest12TTestClass3 = TTest12<TTestClass3>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint25.pp b/tests/test/tgenconstraint25.pp
new file mode 100644
index 0000000000..233a56b94f
--- /dev/null
+++ b/tests/test/tgenconstraint25.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint25;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest5TTestClass7 = TTest5<TTestClass7>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint26.pp b/tests/test/tgenconstraint26.pp
new file mode 100644
index 0000000000..9cb7b558ab
--- /dev/null
+++ b/tests/test/tgenconstraint26.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint26;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest12TTestClass5 = TTest12<TTestClass5>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint27.pp b/tests/test/tgenconstraint27.pp
new file mode 100644
index 0000000000..a51f7138d1
--- /dev/null
+++ b/tests/test/tgenconstraint27.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint27;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest15TTestClass4 = TTest15<TTestClass4>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint28.pp b/tests/test/tgenconstraint28.pp
new file mode 100644
index 0000000000..f5ef833f04
--- /dev/null
+++ b/tests/test/tgenconstraint28.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint28;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest15TTestClass7 = TTest15<TTestClass7>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint29.pp b/tests/test/tgenconstraint29.pp
new file mode 100644
index 0000000000..1ed433da2b
--- /dev/null
+++ b/tests/test/tgenconstraint29.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint29;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest16ITest1 = TTest16<ITest1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint3.pp b/tests/test/tgenconstraint3.pp
new file mode 100644
index 0000000000..693af426f2
--- /dev/null
+++ b/tests/test/tgenconstraint3.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint3;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest1ITest1 = TTest1<ITest1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint30.pp b/tests/test/tgenconstraint30.pp
new file mode 100644
index 0000000000..1a535621b5
--- /dev/null
+++ b/tests/test/tgenconstraint30.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint30;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest16TTestRec = TTest16<TTestRec>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint31.pp b/tests/test/tgenconstraint31.pp
new file mode 100644
index 0000000000..8c173cd9bf
--- /dev/null
+++ b/tests/test/tgenconstraint31.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint31;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest17TTestClassTTestClass = TTest17<TTestClass, TTestClass>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint32.pp b/tests/test/tgenconstraint32.pp
new file mode 100644
index 0000000000..b2e5e39921
--- /dev/null
+++ b/tests/test/tgenconstraint32.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint32;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest17ITestTTestClass = TTest17<ITest1, TTestClass>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint33.pp b/tests/test/tgenconstraint33.pp
new file mode 100644
index 0000000000..3fbb79bd53
--- /dev/null
+++ b/tests/test/tgenconstraint33.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint33;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest17TTestClass5ITest2 = TTest17<TTestClass5, IInterface>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint34.pp b/tests/test/tgenconstraint34.pp
new file mode 100644
index 0000000000..08712fc8f3
--- /dev/null
+++ b/tests/test/tgenconstraint34.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint34;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest21TTestRec = TTest21<TTestRec>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint35.pp b/tests/test/tgenconstraint35.pp
new file mode 100644
index 0000000000..3fd347ab10
--- /dev/null
+++ b/tests/test/tgenconstraint35.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint35;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest21ITest1 = TTest21<ITest1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint36.pp b/tests/test/tgenconstraint36.pp
new file mode 100644
index 0000000000..dd46727a3e
--- /dev/null
+++ b/tests/test/tgenconstraint36.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint36;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest21TTestObject1 = TTest21<TTestObject1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint4.pp b/tests/test/tgenconstraint4.pp
new file mode 100644
index 0000000000..4db1b8f7c3
--- /dev/null
+++ b/tests/test/tgenconstraint4.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint4;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest1LongInt = TTest1<LongInt>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint5.pp b/tests/test/tgenconstraint5.pp
new file mode 100644
index 0000000000..6b3fa6d7a6
--- /dev/null
+++ b/tests/test/tgenconstraint5.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint5;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest1TClass = TTest1<TClass>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint6.pp b/tests/test/tgenconstraint6.pp
new file mode 100644
index 0000000000..941aff1ac8
--- /dev/null
+++ b/tests/test/tgenconstraint6.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint6;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest1TTestObject1 = TTest1<TTestObject1>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint7.pp b/tests/test/tgenconstraint7.pp
new file mode 100644
index 0000000000..34afa6c3b7
--- /dev/null
+++ b/tests/test/tgenconstraint7.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint7;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest2TObject = TTest2<TObject>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint8.pp b/tests/test/tgenconstraint8.pp
new file mode 100644
index 0000000000..4a3c675cb9
--- /dev/null
+++ b/tests/test/tgenconstraint8.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint8;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest3TObject = TTest3<TObject>;
+
+begin
+
+end.
diff --git a/tests/test/tgenconstraint9.pp b/tests/test/tgenconstraint9.pp
new file mode 100644
index 0000000000..ddaa34fcb0
--- /dev/null
+++ b/tests/test/tgenconstraint9.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint9;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+uses
+ ugenconstraints;
+
+type
+ TTest3ITest1 = TTest3<ITest1>;
+
+begin
+
+end.
diff --git a/tests/test/thlp30.pp b/tests/test/thlp30.pp
index 1a49394b29..db99759500 100644
--- a/tests/test/thlp30.pp
+++ b/tests/test/thlp30.pp
@@ -1,6 +1,4 @@
-{ %FAIL }
-
-{ helpers can not extend type parameters even if they can only be classes }
+{ helpers can extend type parameters if they can only be classes }
program thlp30;
{$ifdef fpc}
@@ -14,6 +12,9 @@ type
end;
end;
+type
+ TFooTObject = TFoo<TObject>;
+
begin
end.
diff --git a/tests/test/thlp46.pp b/tests/test/thlp46.pp
new file mode 100644
index 0000000000..e691a0b44f
--- /dev/null
+++ b/tests/test/thlp46.pp
@@ -0,0 +1,24 @@
+{ helpers can extend type parameters if they can only be records }
+program thlp46;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$endif}
+
+type
+ TFoo<T: record> = class
+ type
+ THelper = record helper for T
+ end;
+ end;
+
+ TBar = record
+ f: LongInt;
+ end;
+
+type
+ TFooTBar = TFoo<TBar>;
+
+begin
+
+end.
diff --git a/tests/test/ugenconstraints.pas b/tests/test/ugenconstraints.pas
new file mode 100644
index 0000000000..1f5e1116a2
--- /dev/null
+++ b/tests/test/ugenconstraints.pas
@@ -0,0 +1,186 @@
+unit ugenconstraints;
+
+{$ifdef fpc}
+ {$mode delphi}
+{$else}
+ // Delphi only knows "MSWINDOWS"
+ {$define windows}
+{$endif}
+
+interface
+
+type
+ TTestClass = class
+
+ end;
+
+ TTestClass2 = class(TTestClass)
+
+ end;
+
+ TTestRec = record
+
+ end;
+
+ ITest1 = interface
+
+ end;
+
+ ITest2 = interface(ITest1)
+
+ end;
+
+ TTestClass3 = class(TInterfacedObject, ITest1)
+
+ end;
+
+ TTestClass4 = class(TInterfacedObject, ITest1, ITest2)
+
+ end;
+
+ TTestClass5 = class(TInterfacedObject, ITest2)
+
+ end;
+
+ TTestClass6 = class(TTestClass3, ITest2)
+
+ end;
+
+ TTestClass7 = class(TTestClass, ITest1)
+ function QueryInterface({$IFDEF FPC}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+ function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+ function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+ end;
+
+ TTestClass8 = class(TTestClass7, ITest2)
+
+ end;
+
+ TTestClass9 = class(TTestClass, ITest2)
+ function QueryInterface({$IFDEF FPC}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+ function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+ function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+ end;
+
+ TTestObject1 = object
+
+ end;
+
+type
+ TTest1<T: class> = class
+
+ end;
+
+ TTest2<T: record> = class
+
+ end;
+
+ TTest3<T: TTestClass> = class
+
+ end;
+
+ TTest4<T: class, constructor> = class
+
+ end;
+
+ TTest5<T: IInterface> = class
+
+ end;
+
+ TTest6<T: ITest1> = class
+
+ end;
+
+ TTest7<T: ITest1, ITest2> = class
+
+ end;
+
+ TTest8<T: class, ITest1> = class
+
+ end;
+
+ TTest9<T: ITest1, class> = class
+
+ end;
+
+ TTest10<T: class, constructor, ITest1> = class
+
+ end;
+
+ TTest11<T: constructor, ITest1, class> = class
+
+ end;
+
+ TTest12<T: TTestClass, ITest1> = class
+
+ end;
+
+ TTest13<T: TTestClass, constructor> = class
+
+ end;
+
+ TTest14<T: TTestClass, ITest1, constructor> = class
+
+ end;
+
+ TTest15<T: ITest1, constructor, ITest2, TTestClass> = class
+
+ end;
+
+ TTest16<T: ITest1, constructor> = class
+
+ end;
+
+ TTest17<T1, T2: ITest1> = class
+
+ end;
+
+ TTest18<T1: ITest1; T2: ITest2> = class
+
+ end;
+
+ TTest19<T1: record; T2: class> = class
+
+ end;
+
+ TTest20<T1: TTestClass; T2: constructor> = class
+
+ end;
+
+ TTest21<T: constructor> = class
+
+ end;
+
+implementation
+
+function TTestClass7.QueryInterface({$IFDEF FPC}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;
+begin
+
+end;
+
+function TTestClass7._AddRef : longint;
+begin
+
+end;
+
+function TTestClass7._Release : longint;
+begin
+
+end;
+
+function TTestClass9.QueryInterface({$IFDEF FPC}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;
+begin
+
+end;
+
+function TTestClass9._AddRef : longint;
+begin
+
+end;
+
+function TTestClass9._Release : longint;
+begin
+
+end;
+
+end.