Add support for generic type constraints. They are currently only useful to stop specialization of a generic. The parsing of a generic is still too lax and needs to be changed in the future...

symconst.pas:
  + extend "tdefoptions" by a "df_genconstraint" which will be used to mark dummy defs that should mainly satisfy the compiler's type checking without to much changes
symsym.pas:
  + add a class "tgenericconstraintdata" which will hold information about the constraints associated with a specific generic type parameter (designed for future extensions)
  + extend "ttypesym" by a reference to a "tgenericconstraintdata" which is written to the ppu only if needed
symtype.pas:
  + add a pointer to "tderef" as this is needed for the ppu reading/writing code for the "tgenericconstraintdata"
pdecl.pas, types_dec:
  + call "parse_generic_parameters" so that constraints are allowed
pgenutil.pas:
  + extend "generate_specialization" by a "parsedpos" to give in the file position of the first parsed parameter (needed for correct error locations when checking the constraints)
  + add an overloaded call of "generate_specialization" to differentiate between the use cases "first parameter parsed by generate_specialization" and "first parameter parsed by other code"; this also allows to write the "fillchar" for the "parampos" parameter only once ( => otherwise a warning is triggered => error in compilation)
  + extend the "parse_generic_specialization_types" by a "poslist" parameter which will contain the positions of all parsed type parameters (can only be used in the case that all parameters are parsed)
  * move the original code of "parse_generic_specialization_types" to a new procedure "parse_generic_specialization_types_internal" which take an additional "parsedpos" parameter which will be added to the "poslist" before all others; "parse_generic_specialization_types" calls this new procedure with a dummy argument (which won't be used)
  + extend "parse_generic_parameters" by the parsing of generic constraints which constructs correct defs for the parameters and fills in the new "tgenericconstraintdata" object for each parameter (note: the "constructor" constraint is only parsed for Delphi compatibility and basically means the same as a "class" constraint... (it's a relict of Delphi.NET))
  * adjust "insert_generic_parameter_types" as specializations and generics can no longer be differed by whether the type parameters are of type "undefineddef"
pdecsub.pas, parse_proc_head, consume_generic_interface:
  * adjust call to "generate_specialization"
  + add a new function "check_generic_constraints" which is used from within "generate_specialization" to ensure that the given specialization parameters are compatible with the constraints of the generic parameters
ptype.pas:
  * single_type: adjust call to "generate_specialization"
  * read_named_type, expr_type: adjust call to "generate_specialization"
  + write_persistent_type_info: don't write typeinfo for constraints
pexpr.pas, sub_expr:
  * adjust call to "generate_specialization"
* adjusted ppudump, because of added "tdefoptions.df_genconstraint" value

+ added tests for generic constraints
* modified test for class helper inside a generic which extends a class type parameter
+ added test for record helper inside a generic which extends a record type parameter

git-svn-id: trunk@23158 -

.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

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);

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

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;

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);

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);

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;
 

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;
 

compiler/symtype.pas

@@ -137,6 +137,7 @@ interface
         procedure build(s:TObject);
         function  resolve:TObject;
      end;
+     pderef = ^tderef;
 
 {************************************************
                    tpropaccesslist

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'),

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.

tests/test/tgenconstraint10.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint10;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest3TTestObject1 = TTest3<TTestObject1>;
+
+begin
+
+end.

tests/test/tgenconstraint11.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint11;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest4TTestRec = TTest4<TTestRec>;
+
+begin
+
+end.

tests/test/tgenconstraint12.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint12;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest4ITest1 = TTest4<ITest1>;
+
+begin
+
+end.

tests/test/tgenconstraint13.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint13;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest4TTestObject1 = TTest4<TTestObject1>;
+
+begin
+
+end.

tests/test/tgenconstraint14.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint14;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest5TObject = TTest5<TObject>;
+
+begin
+
+end.

tests/test/tgenconstraint15.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint15;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest5TTestRec = TTest5<TTestRec>;
+
+begin
+
+end.

tests/test/tgenconstraint16.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint16;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest5TTestObject1 = TTest5<TTestObject1>;
+
+begin
+
+end.

tests/test/tgenconstraint17.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint17;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest7IInterface = TTest7<IInterface>;
+
+begin
+
+end.

tests/test/tgenconstraint18.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint18;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest7TTestClass5 = TTest7<TTestClass5>;
+
+begin
+
+end.

tests/test/tgenconstraint19.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint19;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest7ITest1 = TTest7<ITest1>;
+
+begin
+
+end.

tests/test/tgenconstraint2.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint2;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest1TTestRec = TTest1<TTestRec>;
+
+begin
+
+end.

tests/test/tgenconstraint20.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint20;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest7TTestClass3 = TTest7<TTestClass3>;
+
+begin
+
+end.

tests/test/tgenconstraint21.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint21;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest8ITest1 = TTest8<ITest1>;
+
+begin
+
+end.

tests/test/tgenconstraint22.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint22;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest12TTestClass = TTest12<TTestClass>;
+
+begin
+
+end.

tests/test/tgenconstraint23.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint23;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest12TTestClass9 = TTest12<TTestClass9>;
+
+begin
+
+end.

tests/test/tgenconstraint24.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint24;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest12TTestClass3 = TTest12<TTestClass3>;
+
+begin
+
+end.

tests/test/tgenconstraint25.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint25;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest5TTestClass7 = TTest5<TTestClass7>;
+
+begin
+
+end.

tests/test/tgenconstraint26.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint26;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest12TTestClass5 = TTest12<TTestClass5>;
+
+begin
+
+end.

tests/test/tgenconstraint27.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint27;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest15TTestClass4 = TTest15<TTestClass4>;
+
+begin
+
+end.

tests/test/tgenconstraint28.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint28;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest15TTestClass7 = TTest15<TTestClass7>;
+
+begin
+
+end.

tests/test/tgenconstraint29.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint29;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest16ITest1 = TTest16<ITest1>;
+
+begin
+
+end.

tests/test/tgenconstraint3.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint3;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest1ITest1 = TTest1<ITest1>;
+
+begin
+
+end.

tests/test/tgenconstraint30.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint30;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest16TTestRec = TTest16<TTestRec>;
+
+begin
+
+end.

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.

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.

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.

tests/test/tgenconstraint34.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint34;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest21TTestRec = TTest21<TTestRec>;
+
+begin
+
+end.

tests/test/tgenconstraint35.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint35;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest21ITest1 = TTest21<ITest1>;
+
+begin
+
+end.

tests/test/tgenconstraint36.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint36;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest21TTestObject1 = TTest21<TTestObject1>;
+
+begin
+
+end.

tests/test/tgenconstraint4.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint4;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest1LongInt = TTest1<LongInt>;
+
+begin
+
+end.

tests/test/tgenconstraint5.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint5;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest1TClass = TTest1<TClass>;
+
+begin
+
+end.

tests/test/tgenconstraint6.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint6;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest1TTestObject1 = TTest1<TTestObject1>;
+
+begin
+
+end.

tests/test/tgenconstraint7.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint7;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest2TObject = TTest2<TObject>;
+
+begin
+
+end.

tests/test/tgenconstraint8.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint8;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest3TObject = TTest3<TObject>;
+
+begin
+
+end.

tests/test/tgenconstraint9.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tgenconstraint9;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  ugenconstraints;
+
+type
+  TTest3ITest1 = TTest3<ITest1>;
+
+begin
+
+end.

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.

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.

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.