瀏覽代碼

* fix for Mantis #35140: apply patch by Ryan Joseph together with some further changes by me to add support for constant parameters in generics
+ added tests

git-svn-id: trunk@45080 -

svenbarth 5 年之前
父節點
當前提交
60345366f2
共有 53 個文件被更改,包括 1492 次插入274 次删除
  1. 30 0
      .gitattributes
  2. 6 2
      compiler/defcmp.pas
  3. 1 1
      compiler/htypechk.pas
  4. 2 1
      compiler/ncnv.pas
  5. 37 4
      compiler/ncon.pas
  6. 4 1
      compiler/nmat.pas
  7. 16 4
      compiler/node.pas
  8. 3 2
      compiler/nset.pas
  9. 5 0
      compiler/pass_1.pas
  10. 22 4
      compiler/pdecl.pas
  11. 20 12
      compiler/pdecsub.pas
  12. 4 0
      compiler/pdecvar.pas
  13. 15 2
      compiler/pexpr.pas
  14. 3 3
      compiler/pgentype.pas
  15. 492 203
      compiler/pgenutil.pas
  16. 60 15
      compiler/pparautl.pas
  17. 1 1
      compiler/ppu.pas
  18. 3 1
      compiler/pstatmnt.pas
  19. 11 1
      compiler/ptype.pas
  20. 8 3
      compiler/symconst.pas
  21. 41 9
      compiler/symdef.pas
  22. 36 1
      compiler/symsym.pas
  23. 7 4
      compiler/utils/ppuutils/ppudump.pp
  24. 39 0
      tests/test/tgenconst1.pp
  25. 14 0
      tests/test/tgenconst10.pp
  26. 13 0
      tests/test/tgenconst11.pp
  27. 15 0
      tests/test/tgenconst12.pp
  28. 51 0
      tests/test/tgenconst13.pp
  29. 42 0
      tests/test/tgenconst14.pp
  30. 15 0
      tests/test/tgenconst15.pp
  31. 79 0
      tests/test/tgenconst16.pp
  32. 27 0
      tests/test/tgenconst17.pp
  33. 12 0
      tests/test/tgenconst18.pp
  34. 24 0
      tests/test/tgenconst19.pp
  35. 14 0
      tests/test/tgenconst2.pp
  36. 24 0
      tests/test/tgenconst20.pp
  37. 16 0
      tests/test/tgenconst21.pp
  38. 16 0
      tests/test/tgenconst22.pp
  39. 19 0
      tests/test/tgenconst23.pp
  40. 19 0
      tests/test/tgenconst24.pp
  41. 18 0
      tests/test/tgenconst25.pp
  42. 18 0
      tests/test/tgenconst26.pp
  43. 17 0
      tests/test/tgenconst27.pp
  44. 17 0
      tests/test/tgenconst28.pp
  45. 14 0
      tests/test/tgenconst29.pp
  46. 20 0
      tests/test/tgenconst3.pp
  47. 14 0
      tests/test/tgenconst30.pp
  48. 15 0
      tests/test/tgenconst4.pp
  49. 28 0
      tests/test/tgenconst5.pp
  50. 25 0
      tests/test/tgenconst6.pp
  51. 14 0
      tests/test/tgenconst7.pp
  52. 14 0
      tests/test/tgenconst8.pp
  53. 12 0
      tests/test/tgenconst9.pp

+ 30 - 0
.gitattributes

@@ -14721,6 +14721,36 @@ tests/test/tfpu5.pp svneol=native#text/plain
 tests/test/tfpuover.pp svneol=native#text/plain
 tests/test/tfpuover.pp svneol=native#text/plain
 tests/test/tfwork1.pp svneol=native#text/plain
 tests/test/tfwork1.pp svneol=native#text/plain
 tests/test/tfwork2.pp svneol=native#text/plain
 tests/test/tfwork2.pp svneol=native#text/plain
+tests/test/tgenconst1.pp svneol=native#text/pascal
+tests/test/tgenconst10.pp svneol=native#text/pascal
+tests/test/tgenconst11.pp svneol=native#text/pascal
+tests/test/tgenconst12.pp svneol=native#text/pascal
+tests/test/tgenconst13.pp svneol=native#text/pascal
+tests/test/tgenconst14.pp svneol=native#text/pascal
+tests/test/tgenconst15.pp svneol=native#text/pascal
+tests/test/tgenconst16.pp svneol=native#text/pascal
+tests/test/tgenconst17.pp svneol=native#text/pascal
+tests/test/tgenconst18.pp svneol=native#text/pascal
+tests/test/tgenconst19.pp svneol=native#text/pascal
+tests/test/tgenconst2.pp svneol=native#text/pascal
+tests/test/tgenconst20.pp svneol=native#text/pascal
+tests/test/tgenconst21.pp svneol=native#text/pascal
+tests/test/tgenconst22.pp svneol=native#text/pascal
+tests/test/tgenconst23.pp svneol=native#text/pascal
+tests/test/tgenconst24.pp svneol=native#text/pascal
+tests/test/tgenconst25.pp svneol=native#text/pascal
+tests/test/tgenconst26.pp svneol=native#text/pascal
+tests/test/tgenconst27.pp svneol=native#text/pascal
+tests/test/tgenconst28.pp svneol=native#text/pascal
+tests/test/tgenconst29.pp svneol=native#text/pascal
+tests/test/tgenconst3.pp svneol=native#text/pascal
+tests/test/tgenconst30.pp svneol=native#text/pascal
+tests/test/tgenconst4.pp svneol=native#text/pascal
+tests/test/tgenconst5.pp svneol=native#text/pascal
+tests/test/tgenconst6.pp svneol=native#text/pascal
+tests/test/tgenconst7.pp svneol=native#text/pascal
+tests/test/tgenconst8.pp svneol=native#text/pascal
+tests/test/tgenconst9.pp svneol=native#text/pascal
 tests/test/tgenconstraint1.pp svneol=native#text/pascal
 tests/test/tgenconstraint1.pp svneol=native#text/pascal
 tests/test/tgenconstraint10.pp svneol=native#text/pascal
 tests/test/tgenconstraint10.pp svneol=native#text/pascal
 tests/test/tgenconstraint11.pp svneol=native#text/pascal
 tests/test/tgenconstraint11.pp svneol=native#text/pascal

+ 6 - 2
compiler/defcmp.pas

@@ -345,9 +345,13 @@ implementation
                        internalerror(2012091302);
                        internalerror(2012091302);
                      symfrom:=ttypesym(tstoreddef(def_from).genericparas[i]);
                      symfrom:=ttypesym(tstoreddef(def_from).genericparas[i]);
                      symto:=ttypesym(tstoreddef(def_to).genericparas[i]);
                      symto:=ttypesym(tstoreddef(def_to).genericparas[i]);
-                     if not (symfrom.typ=typesym) or not (symto.typ=typesym) then
+                     if not (symfrom.typ in [typesym,constsym]) or not (symto.typ in [typesym,constsym]) then
                        internalerror(2012121401);
                        internalerror(2012121401);
-                     if not equal_defs(ttypesym(symfrom).typedef,ttypesym(symto).typedef) then
+                     if symto.typ<>symfrom.typ then
+                       diff:=true
+                     else if (symfrom.typ=constsym) and (symto.typ=constsym) and not equal_constsym(tconstsym(symfrom),tconstsym(symto),true) then
+                       diff:=true
+                     else if not equal_defs(ttypesym(symfrom).typedef,ttypesym(symto).typedef) then
                        diff:=true;
                        diff:=true;
                      if diff then
                      if diff then
                        break;
                        break;

+ 1 - 1
compiler/htypechk.pas

@@ -2779,7 +2779,7 @@ implementation
               internalerror(2015060301);
               internalerror(2015060301);
             { check whether the given parameters are compatible
             { check whether the given parameters are compatible
               to the def's constraints }
               to the def's constraints }
-            if not check_generic_constraints(pd,spezcontext.genericdeflist,spezcontext.poslist) then
+            if not check_generic_constraints(pd,spezcontext.paramlist,spezcontext.poslist) then
               exit;
               exit;
             def:=generate_specialization_phase2(spezcontext,pd,false,'');
             def:=generate_specialization_phase2(spezcontext,pd,false,'');
             case def.typ of
             case def.typ of

+ 2 - 1
compiler/ncnv.pas

@@ -3102,7 +3102,8 @@ implementation
                        { for constant values on absolute variables, swapping is required }
                        { for constant values on absolute variables, swapping is required }
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                          swap_const_value(tordconstnode(left).value,tordconstnode(left).resultdef.size);
                          swap_const_value(tordconstnode(left).value,tordconstnode(left).resultdef.size);
-                       adaptrange(resultdef,tordconstnode(left).value,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags,cs_check_range in localswitches);
+                       if not(nf_generic_para in flags) then
+                         adaptrange(resultdef,tordconstnode(left).value,([nf_internal,nf_absolute]*flags)<>[],nf_explicit in flags,cs_check_range in localswitches);
                        { swap value back, but according to new type }
                        { swap value back, but according to new type }
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                        if (target_info.endian = endian_big) and (nf_absolute in flags) then
                          swap_const_value(tordconstnode(left).value,resultdef.size);
                          swap_const_value(tordconstnode(left).value,resultdef.size);

+ 37 - 4
compiler/ncon.pas

@@ -306,6 +306,7 @@ implementation
         p1  : tnode;
         p1  : tnode;
         len : longint;
         len : longint;
         pc  : pchar;
         pc  : pchar;
+        value_set : pconstset;
       begin
       begin
         p1:=nil;
         p1:=nil;
         case p.consttyp of
         case p.consttyp of
@@ -331,18 +332,50 @@ implementation
           constwstring :
           constwstring :
             p1:=cstringconstnode.createunistr(pcompilerwidestring(p.value.valueptr));
             p1:=cstringconstnode.createunistr(pcompilerwidestring(p.value.valueptr));
           constreal :
           constreal :
-            p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,p.constdef);
+            begin
+              if (sp_generic_para in p.symoptions) and not (sp_generic_const in p.symoptions) then
+                p1:=crealconstnode.create(default(bestreal),p.constdef)
+              else
+                p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,p.constdef);
+            end;
           constset :
           constset :
-            p1:=csetconstnode.create(pconstset(p.value.valueptr),p.constdef);
+            begin
+              if sp_generic_const in p.symoptions then
+                begin
+                  new(value_set);
+                  value_set^:=pconstset(p.value.valueptr)^;
+                  p1:=csetconstnode.create(value_set,p.constdef);
+                end
+              else if sp_generic_para in p.symoptions then
+                begin
+                  new(value_set);
+                  p1:=csetconstnode.create(value_set,p.constdef);
+                end
+              else
+                p1:=csetconstnode.create(pconstset(p.value.valueptr),p.constdef);
+            end;
           constpointer :
           constpointer :
-            p1:=cpointerconstnode.create(p.value.valueordptr,p.constdef);
+            begin
+              if sp_generic_para in p.symoptions then
+                p1:=cpointerconstnode.create(default(tconstptruint),p.constdef)
+              else
+                p1:=cpointerconstnode.create(p.value.valueordptr,p.constdef);
+            end;
           constnil :
           constnil :
             p1:=cnilnode.create;
             p1:=cnilnode.create;
           constguid :
           constguid :
-            p1:=cguidconstnode.create(pguid(p.value.valueptr)^);
+            begin
+              if sp_generic_para in p.symoptions then
+                p1:=cguidconstnode.create(default(tguid))
+              else
+                p1:=cguidconstnode.create(pguid(p.value.valueptr)^);
+            end;
           else
           else
             internalerror(200205103);
             internalerror(200205103);
         end;
         end;
+        { transfer generic param flag from symbol to node }
+        if sp_generic_para in p.symoptions then
+          include(p1.flags,nf_generic_para);
         genconstsymtree:=p1;
         genconstsymtree:=p1;
       end;
       end;
 
 

+ 4 - 1
compiler/nmat.pas

@@ -131,7 +131,10 @@ implementation
               end;
               end;
             if rv = 0 then
             if rv = 0 then
               begin
               begin
-                Message(parser_e_division_by_zero);
+                { if the node is derived from a generic const parameter
+                  then don't issue an error }
+                if not (nf_generic_para in flags) then
+                  Message(parser_e_division_by_zero);
                 { recover }
                 { recover }
                 tordconstnode(right).value := 1;
                 tordconstnode(right).value := 1;
               end;
               end;

+ 16 - 4
compiler/node.pas

@@ -276,10 +276,13 @@ interface
          nf_block_with_exit,
          nf_block_with_exit,
 
 
          { tloadvmtaddrnode }
          { tloadvmtaddrnode }
-         nf_ignore_for_wpo  { we know that this loadvmtaddrnode cannot be used to construct a class instance }
+         nf_ignore_for_wpo, { we know that this loadvmtaddrnode cannot be used to construct a class instance }
 
 
-         { WARNING: there are now 31 elements in this type, and a set of this
-             type is written to the PPU. So before adding more than 32 elements,
+         { node is derived from generic parameter }
+         nf_generic_para
+
+         { WARNING: there are now 32 elements in this type, and a set of this
+             type is written to the PPU. So before adding more elements,
              either move some flags to specific nodes, or stream a normalset
              either move some flags to specific nodes, or stream a normalset
              to the ppu
              to the ppu
          }
          }
@@ -1380,6 +1383,9 @@ implementation
     constructor tunarynode.create(t:tnodetype;l : tnode);
     constructor tunarynode.create(t:tnodetype;l : tnode);
       begin
       begin
          inherited create(t);
          inherited create(t);
+         { transfer generic paramater flag }
+         if assigned(l) and (nf_generic_para in l.flags) then
+           include(flags,nf_generic_para);
          left:=l;
          left:=l;
       end;
       end;
 
 
@@ -1482,7 +1488,10 @@ implementation
     constructor tbinarynode.create(t:tnodetype;l,r : tnode);
     constructor tbinarynode.create(t:tnodetype;l,r : tnode);
       begin
       begin
          inherited create(t,l);
          inherited create(t,l);
-         right:=r
+         { transfer generic paramater flag }
+         if assigned(r) and (nf_generic_para in r.flags) then
+           include(flags,nf_generic_para);
+         right:=r;
       end;
       end;
 
 
 
 
@@ -1635,6 +1644,9 @@ implementation
     constructor ttertiarynode.create(_t:tnodetype;l,r,t : tnode);
     constructor ttertiarynode.create(_t:tnodetype;l,r,t : tnode);
       begin
       begin
          inherited create(_t,l,r);
          inherited create(_t,l,r);
+         { transfer generic parameter flag }
+         if assigned(t) and (nf_generic_para in t.flags) then
+           include(flags,nf_generic_para);
          third:=t;
          third:=t;
       end;
       end;
 
 

+ 3 - 2
compiler/nset.pas

@@ -424,8 +424,9 @@ implementation
          { both types must be compatible }
          { both types must be compatible }
          if compare_defs(left.resultdef,right.resultdef,left.nodetype)=te_incompatible then
          if compare_defs(left.resultdef,right.resultdef,left.nodetype)=te_incompatible then
            IncompatibleTypes(left.resultdef,right.resultdef);
            IncompatibleTypes(left.resultdef,right.resultdef);
-         { Check if only when its a constant set }
-         if (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then
+         { check if only when its a constant set and
+           ignore range nodes which are generic parameter derived }
+         if not (nf_generic_para in flags) and (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then
           begin
           begin
             { upper limit must be greater or equal than lower limit }
             { upper limit must be greater or equal than lower limit }
             if (tordconstnode(left).value>tordconstnode(right).value) and
             if (tordconstnode(left).value>tordconstnode(right).value) and

+ 5 - 0
compiler/pass_1.pas

@@ -62,6 +62,7 @@ implementation
     procedure typecheckpass_internal_loop(var p : tnode; out node_changed: boolean);
     procedure typecheckpass_internal_loop(var p : tnode; out node_changed: boolean);
       var
       var
          hp        : tnode;
          hp        : tnode;
+         oldflags  : tnodeflags;
       begin
       begin
         codegenerror:=false;
         codegenerror:=false;
         repeat
         repeat
@@ -73,9 +74,13 @@ implementation
           if assigned(hp) then
           if assigned(hp) then
             begin
             begin
               node_changed:=true;
               node_changed:=true;
+              oldflags:=p.flags;
               p.free;
               p.free;
               { switch to new node }
               { switch to new node }
               p:=hp;
               p:=hp;
+              { transfer generic paramter flag }
+              if nf_generic_para in oldflags then
+                include(p.flags,nf_generic_para);
             end;
             end;
         until not assigned(hp) or
         until not assigned(hp) or
               assigned(hp.resultdef);
               assigned(hp.resultdef);

+ 22 - 4
compiler/pdecl.pas

@@ -135,7 +135,10 @@ implementation
            setconstn :
            setconstn :
              begin
              begin
                new(ps);
                new(ps);
-               ps^:=tsetconstnode(p).value_set^;
+               if assigned(tsetconstnode(p).value_set) then
+                 ps^:=tsetconstnode(p).value_set^
+               else
+                 ps^:=[];
                hp:=cconstsym.create_ptr(orgname,constset,ps,p.resultdef);
                hp:=cconstsym.create_ptr(orgname,constset,ps,p.resultdef);
              end;
              end;
            pointerconstn :
            pointerconstn :
@@ -185,8 +188,22 @@ implementation
                end;
                end;
              end;
              end;
            else
            else
-             Message(parser_e_illegal_expression);
+             begin
+               { the node is from a generic parameter constant and is
+                 untyped so we need to pass a placeholder constant
+                 instead of givng an error }
+               if nf_generic_para in p.flags then
+                 hp:=cconstsym.create_ord(orgname,constnil,0,p.resultdef)
+               else
+                 Message(parser_e_illegal_expression);
+             end;
         end;
         end;
+        { transfer generic param flag from node to symbol }
+        if nf_generic_para in p.flags then
+          begin
+            include(hp.symoptions,sp_generic_const);
+            include(hp.symoptions,sp_generic_para);
+          end;
         current_tokenpos:=storetokenpos;
         current_tokenpos:=storetokenpos;
         p.free;
         p.free;
         readconstant:=hp;
         readconstant:=hp;
@@ -716,8 +733,9 @@ implementation
                { we are not freeing the type parameters, so register them }
                { we are not freeing the type parameters, so register them }
                for i:=0 to generictypelist.count-1 do
                for i:=0 to generictypelist.count-1 do
                  begin
                  begin
-                    ttypesym(generictypelist[i]).register_sym;
-                    tstoreddef(ttypesym(generictypelist[i]).typedef).register_def;
+                    tstoredsym(generictypelist[i]).register_sym;
+                    if tstoredsym(generictypelist[i]).typ=typesym then
+                      tstoreddef(ttypesym(generictypelist[i]).typedef).register_def;
                  end;
                  end;
 
 
                str(generictypelist.Count,s);
                str(generictypelist.Count,s);

+ 20 - 12
compiler/pdecsub.pas

@@ -628,7 +628,7 @@ implementation
               for i:=0 to genericparams.count-1 do
               for i:=0 to genericparams.count-1 do
                 begin
                 begin
                   sym:=ttypesym(genericparams[i]);
                   sym:=ttypesym(genericparams[i]);
-                  if tstoreddef(sym.typedef).is_registered then
+                  if (sym.typ<>constsym) and tstoreddef(sym.typedef).is_registered then
                     begin
                     begin
                       sym.typedef.free;
                       sym.typedef.free;
                       sym.typedef:=nil;
                       sym.typedef:=nil;
@@ -813,9 +813,11 @@ implementation
         function check_generic_parameters(def:tstoreddef):boolean;
         function check_generic_parameters(def:tstoreddef):boolean;
           var
           var
             i : longint;
             i : longint;
-            decltype,
-            impltype : ttypesym;
+            declsym,
+            implsym : tsym;
+            impltype : ttypesym absolute implsym;
             implname : tsymstr;
             implname : tsymstr;
+            fileinfo : tfileposinfo;
           begin
           begin
             result:=true;
             result:=true;
             if not assigned(def.genericparas) then
             if not assigned(def.genericparas) then
@@ -826,18 +828,23 @@ implementation
               internalerror(2018090104);
               internalerror(2018090104);
             for i:=0 to def.genericparas.count-1 do
             for i:=0 to def.genericparas.count-1 do
               begin
               begin
-                decltype:=ttypesym(def.genericparas[i]);
-                impltype:=ttypesym(genericparams[i]);
+                declsym:=tsym(def.genericparas[i]);
+                implsym:=tsym(genericparams[i]);
                 implname:=upper(genericparams.nameofindex(i));
                 implname:=upper(genericparams.nameofindex(i));
-                if decltype.name<>implname then
+                if declsym.name<>implname then
                   begin
                   begin
-                    messagepos1(impltype.fileinfo,sym_e_generic_type_param_mismatch,impltype.realname);
-                    messagepos1(decltype.fileinfo,sym_e_generic_type_param_decl,decltype.realname);
+                    messagepos1(implsym.fileinfo,sym_e_generic_type_param_mismatch,implsym.realname);
+                    messagepos1(declsym.fileinfo,sym_e_generic_type_param_decl,declsym.realname);
                     result:=false;
                     result:=false;
                   end;
                   end;
-                if df_genconstraint in impltype.typedef.defoptions then
+                if ((implsym.typ=typesym) and (df_genconstraint in impltype.typedef.defoptions)) or
+                    (implsym.typ=constsym) then
                   begin
                   begin
-                    messagepos(tstoreddef(impltype.typedef).genconstraintdata.fileinfo,parser_e_generic_constraints_not_allowed_here);
+                    if implsym.typ=constsym then
+                      fileinfo:=impltype.fileinfo
+                    else
+                      fileinfo:=tstoreddef(impltype.typedef).genconstraintdata.fileinfo;
+                    messagepos(fileinfo,parser_e_generic_constraints_not_allowed_here);
                     result:=false;
                     result:=false;
                   end;
                   end;
               end;
               end;
@@ -1127,8 +1134,9 @@ implementation
             { register the parameters }
             { register the parameters }
             for i:=0 to genericparams.count-1 do
             for i:=0 to genericparams.count-1 do
               begin
               begin
-                 ttypesym(genericparams[i]).register_sym;
-                 tstoreddef(ttypesym(genericparams[i]).typedef).register_def;
+                 tsym(genericparams[i]).register_sym;
+                 if tsym(genericparams[i]).typ=typesym then
+                   tstoreddef(ttypesym(genericparams[i]).typedef).register_def;
               end;
               end;
             insert_generic_parameter_types(pd,nil,genericparams);
             insert_generic_parameter_types(pd,nil,genericparams);
             { the list is no longer required }
             { the list is no longer required }

+ 4 - 0
compiler/pdecvar.pas

@@ -1707,6 +1707,10 @@ implementation
                    hdef:=generrordef;
                    hdef:=generrordef;
                end;
                end;
 
 
+             { field type is a generic param so set a flag in the struct }
+             if assigned(hdef.typesym) and (sp_generic_para in hdef.typesym.symoptions) then
+               include(current_structdef.defoptions,df_has_generic_fields);
+
              { Process procvar directives }
              { Process procvar directives }
              if maybe_parse_proc_directives(hdef) then
              if maybe_parse_proc_directives(hdef) then
                semicoloneaten:=true;
                semicoloneaten:=true;

+ 15 - 2
compiler/pexpr.pas

@@ -447,6 +447,9 @@ implementation
                   { no packed bit support for these things }
                   { no packed bit support for these things }
                   if l=in_bitsizeof_x then
                   if l=in_bitsizeof_x then
                     statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sizesinttype,true));
                     statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sizesinttype,true));
+                  { type sym is a generic parameter }
+                  if assigned(p1.resultdef.typesym) and (sp_generic_para in p1.resultdef.typesym.symoptions) then
+                    include(statement_syssym.flags,nf_generic_para);
                 end
                 end
               else
               else
                begin
                begin
@@ -467,6 +470,9 @@ implementation
                    end
                    end
                  else
                  else
                    statement_syssym:=cordconstnode.create(p1.resultdef.packedbitsize,sizesinttype,true);
                    statement_syssym:=cordconstnode.create(p1.resultdef.packedbitsize,sizesinttype,true);
+                 { type def is a struct with generic fields }
+                 if df_has_generic_fields in p1.resultdef.defoptions then
+                    include(statement_syssym.flags,nf_generic_para);
                  { p1 not needed !}
                  { p1 not needed !}
                  p1.destroy;
                  p1.destroy;
                end;
                end;
@@ -4247,7 +4253,10 @@ implementation
                 gendef:=generate_specialization_phase2(spezcontext,tstoreddef(gendef),false,'');
                 gendef:=generate_specialization_phase2(spezcontext,tstoreddef(gendef),false,'');
                 spezcontext.free;
                 spezcontext.free;
                 spezcontext:=nil;
                 spezcontext:=nil;
-                gensym:=gendef.typesym;
+                if gendef.typ=errordef then
+                  gensym:=generrorsym
+                else
+                  gensym:=gendef.typesym;
               end;
               end;
             procdef:
             procdef:
               begin
               begin
@@ -4601,7 +4610,7 @@ implementation
          filepos : tfileposinfo;
          filepos : tfileposinfo;
          oldafterassignment,
          oldafterassignment,
          updatefpos          : boolean;
          updatefpos          : boolean;
-
+         oldflags : tnodeflags;
       begin
       begin
          oldafterassignment:=afterassignment;
          oldafterassignment:=afterassignment;
          p1:=sub_expr(opcompare,[ef_accept_equal],nil);
          p1:=sub_expr(opcompare,[ef_accept_equal],nil);
@@ -4658,10 +4667,14 @@ implementation
           else
           else
             updatefpos:=false;
             updatefpos:=false;
          end;
          end;
+         oldflags:=p1.flags;
          { get the resultdef for this expression }
          { get the resultdef for this expression }
          if not assigned(p1.resultdef) and
          if not assigned(p1.resultdef) and
             dotypecheck then
             dotypecheck then
           do_typecheckpass(p1);
           do_typecheckpass(p1);
+         { transfer generic paramter flag }
+         if nf_generic_para in oldflags then
+           include(p1.flags,nf_generic_para);
          afterassignment:=oldafterassignment;
          afterassignment:=oldafterassignment;
          if updatefpos then
          if updatefpos then
            p1.fileinfo:=filepos;
            p1.fileinfo:=filepos;

+ 3 - 3
compiler/pgentype.pas

@@ -42,7 +42,7 @@ type
 
 
   tspecializationcontext=class
   tspecializationcontext=class
   public
   public
-    genericdeflist : tfpobjectlist;
+    paramlist : tfpobjectlist;
     poslist : tfplist;
     poslist : tfplist;
     prettyname : ansistring;
     prettyname : ansistring;
     specializename : ansistring;
     specializename : ansistring;
@@ -58,7 +58,7 @@ implementation
 
 
 constructor tspecializationcontext.create;
 constructor tspecializationcontext.create;
 begin
 begin
-  genericdeflist:=tfpobjectlist.create(false);
+  paramlist:=tfpobjectlist.create(false);
   poslist:=tfplist.create;
   poslist:=tfplist.create;
 end;
 end;
 
 
@@ -66,7 +66,7 @@ destructor tspecializationcontext.destroy;
 var
 var
   i : longint;
   i : longint;
 begin
 begin
-  genericdeflist.free;
+  paramlist.free;
   for i:=0 to poslist.count-1 do
   for i:=0 to poslist.count-1 do
     dispose(pfileposinfo(poslist[i]));
     dispose(pfileposinfo(poslist[i]));
   poslist.free;
   poslist.free;

+ 492 - 203
compiler/pgenutil.pas

@@ -42,9 +42,9 @@ uses
     function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;symname:string):tdef;inline;
     function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;symname:string):tdef;inline;
     function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;parsedpos:tfileposinfo):tdef;
     function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;symname:string;parsedpos:tfileposinfo):tdef;
     function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;_prettyname:ansistring):tdef;
     function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;_prettyname:ansistring):tdef;
-    function check_generic_constraints(genericdef:tstoreddef;paradeflist:tfpobjectlist;poslist:tfplist):boolean;
+    function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
     function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
     function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
-    function parse_generic_specialization_types(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
+    function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
     procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
     procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
     procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
     procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
     function generate_generic_name(const name:tidstring;specializename:ansistring;owner_hierarchy:string):tidstring;
     function generate_generic_name(const name:tidstring;specializename:ansistring;owner_hierarchy:string):tidstring;
@@ -65,16 +65,148 @@ uses
   { common }
   { common }
   cutils,fpccrc,
   cutils,fpccrc,
   { global }
   { global }
-  globals,tokens,verbose,finput,
+  globals,tokens,verbose,finput,constexp,
   { symtable }
   { symtable }
-  symconst,symsym,symtable,defcmp,procinfo,
+  symconst,symsym,symtable,defcmp,defutil,procinfo,
   { modules }
   { modules }
   fmodule,
   fmodule,
-  node,nobj,
+  node,nobj,ncon,
   { parser }
   { parser }
   scanner,
   scanner,
   pbase,pexpr,pdecsub,ptype,psub,pparautl;
   pbase,pexpr,pdecsub,ptype,psub,pparautl;
 
 
+  type
+    tdeftypeset = set of tdeftyp;
+  const
+    tgeneric_param_const_types : tdeftypeset = [orddef,stringdef,arraydef,floatdef,setdef,pointerdef,enumdef];
+    tgeneric_param_nodes : tnodetypeset = [typen,ordconstn,stringconstn,realconstn,setconstn,niln];
+
+    function get_generic_param_def(sym:tsym):tdef;
+      begin
+        if sym.typ=constsym then
+          result:=tconstsym(sym).constdef
+        else
+          result:=ttypesym(sym).typedef;
+      end;
+
+    function compare_orddef_by_range(param1,param2:torddef;value:tconstvalue):boolean;
+      begin
+        if (value.valueord<param2.low) or (value.valueord>param2.high) then
+          result:=false
+        else
+          result:=true;
+      end;
+
+    function compare_generic_params(param1,param2:tdef;constparamsym:tconstsym):boolean;
+      begin
+        if (param1.typ=orddef) and (param2.typ=orddef) then
+          begin
+            if is_boolean(param2) then
+              result:=is_boolean(param1)
+            else if is_char(param2) then
+              result:=is_char(param1)
+            else if compare_orddef_by_range(torddef(param1),torddef(param2),constparamsym.value) then
+              result:=true
+            else
+              result:=false;
+          end
+        { arraydef is string constant so it's compatible with stringdef }
+        else if (param1.typ=arraydef) and (param2.typ=stringdef) then
+          result:=true
+        { integer ords are compatible with float }
+        else if (param1.typ=orddef) and is_integer(param1) and (param2.typ=floatdef) then
+          result:=true
+        { undefined def is compatible with all types }
+        else if param2.typ=undefineddef then
+          result:=true
+        { sets require stricter checks }
+        else if is_set(param2) then
+          result:=equal_defs(param1,param2)
+        else
+          result:=param1.typ=param2.typ;
+      end;
+
+    function create_generic_constsym(fromdef:tdef;node:tnode;out prettyname:string):tconstsym;
+      const
+        undefinedname = 'undefined';
+      var
+        sym : tconstsym;
+        setdef : tsetdef;
+        enumsym : tsym;
+        enumname : string;
+        sp : pchar;
+        ps : ^tconstset;
+        pd : ^bestreal;
+        i : integer;
+      begin
+        if node=nil then
+          internalerror(2020011401);
+        case node.nodetype of
+          ordconstn:
+            begin
+              sym:=cconstsym.create_ord(undefinedname,constord,tordconstnode(node).value,fromdef);
+              prettyname:=tostr(tordconstnode(node).value.svalue);
+            end;
+          stringconstn:
+            begin
+              getmem(sp,tstringconstnode(node).len+1);
+              move(tstringconstnode(node).value_str^,sp^,tstringconstnode(node).len+1);
+              sym:=cconstsym.create_string(undefinedname,conststring,sp,tstringconstnode(node).len,fromdef);
+              prettyname:=''''+tstringconstnode(node).value_str+'''';
+            end;
+          realconstn:
+            begin
+              new(pd);
+              pd^:=trealconstnode(node).value_real;
+              sym:=cconstsym.create_ptr(undefinedname,constreal,pd,fromdef);
+              prettyname:=realtostr(trealconstnode(node).value_real);
+            end;
+          setconstn:
+            begin
+              new(ps);
+              ps^:=tsetconstnode(node).value_set^;
+              sym:=cconstsym.create_ptr(undefinedname,constset,ps,fromdef);
+              setdef:=tsetdef(tsetconstnode(node).resultdef);
+              prettyname:='[';
+              for i := setdef.setbase to setdef.setmax do
+                if i in tsetconstnode(node).value_set^ then
+                  begin
+                    if setdef.elementdef.typ=enumdef then
+                      enumsym:=tenumdef(setdef.elementdef).int2enumsym(i)
+                    else
+                      enumsym:=nil;
+                    if assigned(enumsym) then
+                      enumname:=enumsym.realname
+                    else if setdef.elementdef.typ=orddef then
+                      begin
+                        if torddef(setdef.elementdef).ordtype=uchar then
+                          enumname:=chr(i)
+                        else
+                          enumname:=tostr(i);
+                      end
+                    else
+                      enumname:=tostr(i);
+                    if length(prettyname) > 1 then
+                      prettyname:=prettyname+','+enumname
+                    else
+                      prettyname:=prettyname+enumname;
+                  end;
+              prettyname:=prettyname+']';
+            end;
+          niln:
+            begin
+              { only "nil" is available for pointer constants }
+              sym:=cconstsym.create_ord(undefinedname,constnil,0,fromdef);
+              prettyname:='nil';
+            end;
+          else
+            internalerror(2019021601);
+        end;
+        { the sym needs an owner for later checks so use the typeparam owner }
+        sym.owner:=fromdef.owner;
+        include(sym.symoptions,sp_generic_const);
+        result:=sym;
+      end;
 
 
     procedure maybe_add_waiting_unit(tt:tdef);
     procedure maybe_add_waiting_unit(tt:tdef);
       var
       var
@@ -104,203 +236,231 @@ uses
           end;
           end;
       end;
       end;
 
 
-    function check_generic_constraints(genericdef:tstoreddef;paradeflist:tfpobjectlist;poslist:tfplist):boolean;
+    function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
       var
       var
         i,j,
         i,j,
         intfcount : longint;
         intfcount : longint;
         formaldef,
         formaldef,
         paradef : tstoreddef;
         paradef : tstoreddef;
+        genparadef : tdef;
         objdef,
         objdef,
         paraobjdef,
         paraobjdef,
         formalobjdef : tobjectdef;
         formalobjdef : tobjectdef;
         intffound : boolean;
         intffound : boolean;
         filepos : tfileposinfo;
         filepos : tfileposinfo;
+        is_const : boolean;
       begin
       begin
         { check whether the given specialization parameters fit to the eventual
         { check whether the given specialization parameters fit to the eventual
           constraints of the generic }
           constraints of the generic }
         if not assigned(genericdef.genericparas) or (genericdef.genericparas.count=0) then
         if not assigned(genericdef.genericparas) or (genericdef.genericparas.count=0) then
           internalerror(2012101001);
           internalerror(2012101001);
-        if genericdef.genericparas.count<>paradeflist.count then
+        if genericdef.genericparas.count<>paramlist.count then
           internalerror(2012101002);
           internalerror(2012101002);
-        if paradeflist.count<>poslist.count then
+        if paramlist.count<>poslist.count then
           internalerror(2012120801);
           internalerror(2012120801);
         result:=true;
         result:=true;
         for i:=0 to genericdef.genericparas.count-1 do
         for i:=0 to genericdef.genericparas.count-1 do
           begin
           begin
             filepos:=pfileposinfo(poslist[i])^;
             filepos:=pfileposinfo(poslist[i])^;
-            formaldef:=tstoreddef(ttypesym(genericdef.genericparas[i]).typedef);
-            if formaldef.typ=undefineddef then
-              { the parameter is of unspecified type, so no need to check }
-              continue;
-            if not (df_genconstraint in formaldef.defoptions) or
-                not assigned(formaldef.genconstraintdata) then
-              internalerror(2013021602);
-            paradef:=tstoreddef(paradeflist[i]);
-            { undefineddef is compatible with anything }
-            if formaldef.typ=undefineddef then
-              continue;
-            if paradef.typ<>formaldef.typ then
+            paradef:=tstoreddef(get_generic_param_def(tsym(paramlist[i])));
+            is_const:=tsym(paramlist[i]).typ=constsym;
+            genparadef:=genericdef.get_generic_param_def(i);
+            { validate const params }
+            if not genericdef.is_generic_param_const(i) and is_const then
               begin
               begin
-                case formaldef.typ of
-                  recorddef:
-                    { delphi has own fantasy about record constraint
-                      (almost non-nullable/non-nilable value type) }
-                    if m_delphi in current_settings.modeswitches then
-                      case paradef.typ of
-                        floatdef,enumdef,orddef:
-                          continue;
-                        objectdef:
-                          if tobjectdef(paradef).objecttype=odt_object then
-                            continue
-                          else
-                            MessagePos(filepos,type_e_record_type_expected);
+                MessagePos(filepos,type_e_mismatch);
+                exit(false);
+              end
+            else if genericdef.is_generic_param_const(i) then
+              begin
+                { param type mismatch (type <> const) }
+                 if genericdef.is_generic_param_const(i)<>is_const then
+                   begin
+                    MessagePos(filepos,type_e_mismatch);
+                    exit(false);
+                  end;
+                { type constrained param doesn't match type }
+                if not compare_generic_params(paradef,genericdef.get_generic_param_def(i),tconstsym(paramlist[i])) then
+                  begin
+                    MessagePos2(filepos,type_e_incompatible_types,FullTypeName(paradef,genparadef),FullTypeName(genparadef,paradef));
+                    exit(false);
+                  end;
+              end;
+            { test constraints for non-const params }
+            if not genericdef.is_generic_param_const(i) then
+              begin
+                formaldef:=tstoreddef(ttypesym(genericdef.genericparas[i]).typedef);
+                if formaldef.typ=undefineddef then
+                  { the parameter is of unspecified type, so no need to check }
+                  continue;
+                if not (df_genconstraint in formaldef.defoptions) or
+                    not assigned(formaldef.genconstraintdata) then
+                  internalerror(2013021602);
+                { undefineddef is compatible with anything }
+                if formaldef.typ=undefineddef then
+                  continue;
+                if paradef.typ<>formaldef.typ then
+                  begin
+                    case formaldef.typ of
+                      recorddef:
+                        { delphi has own fantasy about record constraint
+                          (almost non-nullable/non-nilable value type) }
+                        if m_delphi in current_settings.modeswitches then
+                          case paradef.typ of
+                            floatdef,enumdef,orddef:
+                              continue;
+                            objectdef:
+                              if tobjectdef(paradef).objecttype=odt_object then
+                                continue
+                              else
+                                MessagePos(filepos,type_e_record_type_expected);
+                            else
+                              MessagePos(filepos,type_e_record_type_expected);
+                          end
                         else
                         else
                           MessagePos(filepos,type_e_record_type_expected);
                           MessagePos(filepos,type_e_record_type_expected);
-                      end
-                    else
-                      MessagePos(filepos,type_e_record_type_expected);
-                  objectdef:
-                    case tobjectdef(formaldef).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);
+                      objectdef:
+                        case tobjectdef(formaldef).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
                       else
-                        internalerror(2012101003);
+                        internalerror(2012101004);
                     end;
                     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 formaldef.typ=objectdef then
+                    result:=false;
+                  end
+                else
                   begin
                   begin
-                    paraobjdef:=tobjectdef(paradef);
-                    formalobjdef:=tobjectdef(formaldef);
-                    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
+                    { the paradef types are the same, so do special checks for the
+                      cases in which they are needed }
+                    if formaldef.typ=objectdef then
                       begin
                       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:
-                            begin
-                              if (oo_is_forward in paraobjdef.objectoptions) and
-                                  (paraobjdef.objecttype=formalobjdef.objecttype) and
-                                  (df_genconstraint in formalobjdef.defoptions) and
-                                  (
-                                    (formalobjdef.objecttype=odt_interfacecom) and
-                                    (formalobjdef.childof=interface_iunknown)
-                                  )
-                                  or
-                                  (
-                                    (formalobjdef.objecttype=odt_interfacecorba) and
-                                    (formalobjdef.childof=nil)
-                                  ) then
-                                continue;
-                              if not def_is_related(paraobjdef,formalobjdef.childof) then
+                        paraobjdef:=tobjectdef(paradef);
+                        formalobjdef:=tobjectdef(formaldef);
+                        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:
                                 begin
                                 begin
-                                  MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
-                                  result:=false;
+                                  if (oo_is_forward in paraobjdef.objectoptions) and
+                                      (paraobjdef.objecttype=formalobjdef.objecttype) and
+                                      (df_genconstraint in formalobjdef.defoptions) and
+                                      (
+                                        (formalobjdef.objecttype=odt_interfacecom) and
+                                        (formalobjdef.childof=interface_iunknown)
+                                      )
+                                      or
+                                      (
+                                        (formalobjdef.objecttype=odt_interfacecorba) and
+                                        (formalobjdef.childof=nil)
+                                      ) then
+                                    continue;
+                                  if not def_is_related(paraobjdef,formalobjdef.childof) then
+                                    begin
+                                      MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
+                                      result:=false;
+                                    end;
                                 end;
                                 end;
-                            end;
-                          odt_class,
-                          odt_javaclass:
-                            begin
-                              objdef:=paraobjdef;
-                              intffound:=false;
-                              while assigned(objdef) do
+                              odt_class,
+                              odt_javaclass:
                                 begin
                                 begin
-                                  for j:=0 to objdef.implementedinterfaces.count-1 do
-                                    if timplementedinterface(objdef.implementedinterfaces[j]).intfdef=formalobjdef.childof then
-                                      begin
-                                        intffound:=true;
+                                  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.childof then
+                                          begin
+                                            intffound:=true;
+                                            break;
+                                          end;
+                                      if intffound then
                                         break;
                                         break;
-                                      end;
-                                  if intffound then
-                                    break;
-                                  objdef:=objdef.childof;
+                                      objdef:=objdef.childof;
+                                    end;
+                                  result:=intffound;
+                                  if not result then
+                                    MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,formalobjdef.childof.typename);
+                                end;
+                              else
+                                begin
+                                  MessagePos1(filepos,type_e_class_or_interface_type_expected,paraobjdef.typename);
+                                  result:=false;
                                 end;
                                 end;
-                              result:=intffound;
-                              if not result then
-                                MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,formalobjdef.childof.typename);
-                            end;
-                          else
-                            begin
-                              MessagePos1(filepos,type_e_class_or_interface_type_expected,paraobjdef.typename);
-                              result:=false;
                             end;
                             end;
-                        end;
-                      end
-                    else
-                      begin
-                        { this is either a "class" or a concrete instance with
-                          or without implemented 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;
-                        { for forward declared classes we allow pure TObject/class declarations }
-                        if (oo_is_forward in paraobjdef.objectoptions) and
-                            (df_genconstraint in formaldef.defoptions) then
-                          begin
-                            if (formalobjdef.childof=class_tobject) and
-                                not formalobjdef.implements_any_interfaces then
-                              continue;
-                          end;
-                        if assigned(formalobjdef.childof) and
-                            not def_is_related(paradef,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
+                          end
+                        else
                           begin
                           begin
-                            objdef:=paraobjdef;
-                            while assigned(objdef) do
+                            { this is either a "class" or a concrete instance with
+                              or without implemented 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;
+                            { for forward declared classes we allow pure TObject/class declarations }
+                            if (oo_is_forward in paraobjdef.objectoptions) and
+                                (df_genconstraint in formaldef.defoptions) then
                               begin
                               begin
-                                intffound:=assigned(
-                                             find_implemented_interface(objdef,
-                                               timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef
-                                             )
-                                           );
+                                if (formalobjdef.childof=class_tobject) and
+                                    not formalobjdef.implements_any_interfaces then
+                                  continue;
+                              end;
+                            if assigned(formalobjdef.childof) and
+                                not def_is_related(paradef,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(
+                                                 find_implemented_interface(objdef,
+                                                   timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef
+                                                 )
+                                               );
+                                    if intffound then
+                                      break;
+                                    objdef:=objdef.childof;
+                                  end;
                                 if intffound then
                                 if intffound then
-                                  break;
-                                objdef:=objdef.childof;
+                                  inc(intfcount)
+                                else
+                                  MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef.typename);
                               end;
                               end;
-                            if intffound then
-                              inc(intfcount)
-                            else
-                              MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef.typename);
+                            if intfcount<>formalobjdef.implementedinterfaces.count then
+                              result:=false;
                           end;
                           end;
-                        if intfcount<>formalobjdef.implementedinterfaces.count then
-                          result:=false;
                       end;
                       end;
                   end;
                   end;
               end;
               end;
           end;
           end;
       end;
       end;
 
 
-
-    function parse_generic_specialization_types_internal(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring;parsedtype:tdef;parsedpos:tfileposinfo):boolean;
+    function parse_generic_specialization_types_internal(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring;parsedtype:tdef;parsedpos:tfileposinfo):boolean;
       var
       var
         old_block_type : tblock_type;
         old_block_type : tblock_type;
         first : boolean;
         first : boolean;
@@ -310,9 +470,11 @@ uses
         namepart : string;
         namepart : string;
         prettynamepart : ansistring;
         prettynamepart : ansistring;
         module : tmodule;
         module : tmodule;
+        constprettyname : string;
+        validparam : boolean;
       begin
       begin
         result:=true;
         result:=true;
-        if genericdeflist=nil then
+        if paramlist=nil then
           internalerror(2012061401);
           internalerror(2012061401);
         { set the block type to type, so that the parsed type are returned as
         { 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
           ttypenode (e.g. classes are in non type-compatible blocks returned as
@@ -324,7 +486,7 @@ uses
         first:=not assigned(parsedtype);
         first:=not assigned(parsedtype);
         if assigned(parsedtype) then
         if assigned(parsedtype) then
           begin
           begin
-            genericdeflist.Add(parsedtype);
+            paramlist.Add(parsedtype.typesym);
             module:=find_module_from_symtable(parsedtype.owner);
             module:=find_module_from_symtable(parsedtype.owner);
             if not assigned(module) then
             if not assigned(module) then
               internalerror(2016112801);
               internalerror(2016112801);
@@ -350,8 +512,10 @@ uses
               consume(_COMMA);
               consume(_COMMA);
             block_type:=bt_type;
             block_type:=bt_type;
             tmpparampos:=current_filepos;
             tmpparampos:=current_filepos;
-            typeparam:=factor(false,[ef_type_only]);
-            if typeparam.nodetype=typen then
+            typeparam:=factor(false,[ef_accept_equal]);
+            { determine if the typeparam node is a valid type or const }
+            validparam:=typeparam.nodetype in tgeneric_param_nodes;
+            if validparam then
               begin
               begin
                 if tstoreddef(typeparam.resultdef).is_generic and
                 if tstoreddef(typeparam.resultdef).is_generic and
                     (
                     (
@@ -367,31 +531,46 @@ uses
                   end;
                   end;
                 if typeparam.resultdef.typ<>errordef then
                 if typeparam.resultdef.typ<>errordef then
                   begin
                   begin
-                    if not assigned(typeparam.resultdef.typesym) then
+                    if (typeparam.nodetype=typen) and not assigned(typeparam.resultdef.typesym) then
                       message(type_e_generics_cannot_reference_itself)
                       message(type_e_generics_cannot_reference_itself)
                     else if (typeparam.resultdef.typ<>errordef) then
                     else if (typeparam.resultdef.typ<>errordef) then
                       begin
                       begin
-                        genericdeflist.Add(typeparam.resultdef);
+                        { all non-type nodes are considered const }
+                        if typeparam.nodetype<>typen then
+                          paramlist.Add(create_generic_constsym(typeparam.resultdef,typeparam,constprettyname))
+                        else
+                          begin
+                            constprettyname:='';
+                            paramlist.Add(typeparam.resultdef.typesym);
+                          end;
                         module:=find_module_from_symtable(typeparam.resultdef.owner);
                         module:=find_module_from_symtable(typeparam.resultdef.owner);
                         if not assigned(module) then
                         if not assigned(module) then
                           internalerror(2016112802);
                           internalerror(2016112802);
                         namepart:='_$'+hexstr(module.moduleid,8)+'$$'+typeparam.resultdef.unique_id_str;
                         namepart:='_$'+hexstr(module.moduleid,8)+'$$'+typeparam.resultdef.unique_id_str;
+                        if constprettyname<>'' then
+                          namepart:=namepart+'$$'+constprettyname;
                         { we use the full name of the type to uniquely identify it }
                         { we use the full name of the type to uniquely identify it }
-                        if (symtablestack.top.symtabletype=parasymtable) and
-                            (symtablestack.top.defowner.typ=procdef) and
-                            (typeparam.resultdef.owner=symtablestack.top) then
+                        if typeparam.nodetype=typen then
                           begin
                           begin
-                            { special handling for specializations inside generic function declarations }
-                            prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
-                          end
-                        else
-                          begin
-                            prettynamepart:=typeparam.resultdef.fullownerhierarchyname(true);
+                            if (symtablestack.top.symtabletype=parasymtable) and
+                                (symtablestack.top.defowner.typ=procdef) and
+                                (typeparam.resultdef.owner=symtablestack.top) then
+                              begin
+                                { special handling for specializations inside generic function declarations }
+                                prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
+                              end
+                            else
+                              begin
+                                prettynamepart:=typeparam.resultdef.fullownerhierarchyname(true);
+                              end;
                           end;
                           end;
                         specializename:=specializename+namepart;
                         specializename:=specializename+namepart;
                         if not first then
                         if not first then
                           prettyname:=prettyname+',';
                           prettyname:=prettyname+',';
-                        prettyname:=prettyname+prettynamepart+typeparam.resultdef.typesym.prettyname;
+                        if constprettyname<>'' then
+                          prettyname:=prettyname+constprettyname
+                        else
+                          prettyname:=prettyname+prettynamepart+typeparam.resultdef.typesym.prettyname;
                       end;
                       end;
                   end
                   end
                 else
                 else
@@ -411,12 +590,12 @@ uses
       end;
       end;
 
 
 
 
-    function parse_generic_specialization_types(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
+    function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
       var
       var
         dummypos : tfileposinfo;
         dummypos : tfileposinfo;
       begin
       begin
         FillChar(dummypos, SizeOf(tfileposinfo), 0);
         FillChar(dummypos, SizeOf(tfileposinfo), 0);
-        result:=parse_generic_specialization_types_internal(genericdeflist,poslist,prettyname,specializename,nil,dummypos);
+        result:=parse_generic_specialization_types_internal(paramlist,poslist,prettyname,specializename,nil,dummypos);
       end;
       end;
 
 
 
 
@@ -502,7 +681,7 @@ uses
         context:=tspecializationcontext.create;
         context:=tspecializationcontext.create;
 
 
         { Parse type parameters }
         { Parse type parameters }
-        err:=not parse_generic_specialization_types_internal(context.genericdeflist,context.poslist,context.prettyname,context.specializename,parsedtype,parsedpos);
+        err:=not parse_generic_specialization_types_internal(context.paramlist,context.poslist,context.prettyname,context.specializename,parsedtype,parsedpos);
         if err then
         if err then
           begin
           begin
             if not try_to_consume(_GT) then
             if not try_to_consume(_GT) then
@@ -556,7 +735,7 @@ uses
 
 
         { search a generic with the given count of params }
         { search a generic with the given count of params }
         countstr:='';
         countstr:='';
-        str(context.genericdeflist.Count,countstr);
+        str(context.paramlist.Count,countstr);
 
 
         genname:=genname+'$'+countstr;
         genname:=genname+'$'+countstr;
         ugenname:=upper(genname);
         ugenname:=upper(genname);
@@ -681,6 +860,8 @@ uses
         tempst : tglobalsymtable;
         tempst : tglobalsymtable;
         psym,
         psym,
         srsym : tsym;
         srsym : tsym;
+        paramdef1,
+        paramdef2,
         def : tdef;
         def : tdef;
         old_block_type : tblock_type;
         old_block_type : tblock_type;
         state : tspecializationstate;
         state : tspecializationstate;
@@ -708,7 +889,7 @@ uses
 
 
         pd:=nil;
         pd:=nil;
 
 
-        if not check_generic_constraints(genericdef,context.genericdeflist,context.poslist) then
+        if not check_generic_constraints(genericdef,context.paramlist,context.poslist) then
           begin
           begin
             { the parameters didn't fit the constraints, so don't continue with the
             { the parameters didn't fit the constraints, so don't continue with the
               specialization }
               specialization }
@@ -724,20 +905,19 @@ uses
         else
         else
           prettyname:=genericdef.typesym.prettyname;
           prettyname:=genericdef.typesym.prettyname;
         prettyname:=prettyname+'<'+context.prettyname+'>';
         prettyname:=prettyname+'<'+context.prettyname+'>';
-
         generictypelist:=tfphashobjectlist.create(false);
         generictypelist:=tfphashobjectlist.create(false);
 
 
         { build the list containing the types for the generic params }
         { build the list containing the types for the generic params }
         if not assigned(genericdef.genericparas) then
         if not assigned(genericdef.genericparas) then
           internalerror(2013092601);
           internalerror(2013092601);
-        if context.genericdeflist.count<>genericdef.genericparas.count then
+        if context.paramlist.count<>genericdef.genericparas.count then
           internalerror(2013092603);
           internalerror(2013092603);
         for i:=0 to genericdef.genericparas.Count-1 do
         for i:=0 to genericdef.genericparas.Count-1 do
           begin
           begin
             srsym:=tsym(genericdef.genericparas[i]);
             srsym:=tsym(genericdef.genericparas[i]);
             if not (sp_generic_para in srsym.symoptions) then
             if not (sp_generic_para in srsym.symoptions) then
               internalerror(2013092602);
               internalerror(2013092602);
-            generictypelist.add(srsym.realname,tdef(context.genericdeflist[i]).typesym);
+            generictypelist.add(srsym.realname,context.paramlist[i]);
           end;
           end;
 
 
         { Special case if we are referencing the current defined object }
         { Special case if we are referencing the current defined object }
@@ -792,11 +972,33 @@ uses
                         allequal:=true;
                         allequal:=true;
                         for i:=0 to generictypelist.count-1 do
                         for i:=0 to generictypelist.count-1 do
                           begin
                           begin
-                            if not equal_defs(ttypesym(generictypelist[i]).typedef,ttypesym(tstoreddef(def).genericparas[i]).typedef) then
+                            if tsym(generictypelist[i]).typ<>tsym(tstoreddef(def).genericparas[i]).typ then
+                              begin
+                                allequal:=false;
+                                break;
+                              end;
+                            if tsym(generictypelist[i]).typ=constsym then
+                              paramdef1:=tconstsym(generictypelist[i]).constdef
+                            else
+                              paramdef1:=ttypesym(generictypelist[i]).typedef;
+                            if tsym(tstoreddef(def).genericparas[i]).typ=constsym then
+                              paramdef2:=tconstsym(tstoreddef(def).genericparas[i]).constdef
+                            else
+                              paramdef2:=ttypesym(tstoreddef(def).genericparas[i]).typedef;
+                            if not equal_defs(paramdef2,paramdef2) then
                               begin
                               begin
                                 allequal:=false;
                                 allequal:=false;
                                 break;
                                 break;
                               end;
                               end;
+                            if (tsym(generictypelist[i]).typ=constsym) and
+                                (
+                                  (tconstsym(generictypelist[i]).consttyp<>tconstsym(tstoreddef(def).genericparas[i]).consttyp) or
+                                  not same_constvalue(tconstsym(generictypelist[i]).consttyp,tconstsym(generictypelist[i]).value,tconstsym(tstoreddef(def).genericparas[i]).value)
+                                ) then
+                                begin
+                                  allequal:=false;
+                                  break;
+                                end;
                           end;
                           end;
                         if allequal then
                         if allequal then
                           begin
                           begin
@@ -1159,25 +1361,43 @@ uses
 
 
     function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
     function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
       var
       var
-        generictype : ttypesym;
-        i,firstidx : longint;
+        generictype : tstoredsym;
+        i,firstidx,const_list_index : longint;
         srsymtable : tsymtable;
         srsymtable : tsymtable;
         basedef,def : tdef;
         basedef,def : tdef;
         defname : tidstring;
         defname : tidstring;
+        allowconst,
         allowconstructor,
         allowconstructor,
+        is_const,
         doconsume : boolean;
         doconsume : boolean;
         constraintdata : tgenericconstraintdata;
         constraintdata : tgenericconstraintdata;
         old_block_type : tblock_type;
         old_block_type : tblock_type;
         fileinfo : tfileposinfo;
         fileinfo : tfileposinfo;
+        last_token : ttoken;
+        last_type_pos : tfileposinfo;
       begin
       begin
         result:=tfphashobjectlist.create(false);
         result:=tfphashobjectlist.create(false);
         firstidx:=0;
         firstidx:=0;
+        const_list_index:=0;
         old_block_type:=block_type;
         old_block_type:=block_type;
         block_type:=bt_type;
         block_type:=bt_type;
+        allowconst:=true;
+        is_const:=false;
+        last_token:=NOTOKEN;
+        last_type_pos:=current_filepos;
         repeat
         repeat
+          if allowconst and try_to_consume(_CONST) then
+            begin
+              allowconst:=false;
+              is_const:=true;
+              const_list_index:=result.count;
+            end;
           if token=_ID then
           if token=_ID then
             begin
             begin
-              generictype:=ctypesym.create(orgpattern,cundefinedtype);
+              if is_const then
+                generictype:=cconstsym.create_undefined(orgpattern,cundefinedtype)
+              else
+                generictype:=ctypesym.create(orgpattern,cundefinedtype);
               { type parameters need to be added as strict private }
               { type parameters need to be added as strict private }
               generictype.visibility:=vis_strictprivate;
               generictype.visibility:=vis_strictprivate;
               include(generictype.symoptions,sp_generic_para);
               include(generictype.symoptions,sp_generic_para);
@@ -1185,7 +1405,43 @@ uses
             end;
             end;
           consume(_ID);
           consume(_ID);
           fileinfo:=current_tokenpos;
           fileinfo:=current_tokenpos;
-          if try_to_consume(_COLON) then
+          { const restriction }
+          if is_const and try_to_consume(_COLON) then
+            begin
+              def:=nil;
+              { parse the type and assign the const type to generictype  }
+              single_type(def,[]);
+              for i:=const_list_index to result.count-1 do
+                begin
+                  { finalize constant information once type is known }
+                  if assigned(def) and (def.typ in tgeneric_param_const_types) then
+                    begin
+                      case def.typ of
+                        orddef,
+                        enumdef:
+                          tconstsym(result[i]).consttyp:=constord;
+                        stringdef:
+                          tconstsym(result[i]).consttyp:=conststring;
+                        floatdef:
+                          tconstsym(result[i]).consttyp:=constreal;
+                        setdef:
+                          tconstsym(result[i]).consttyp:=constset;
+                        { pointer always refers to nil with constants }
+                        pointerdef:
+                          tconstsym(result[i]).consttyp:=constnil;
+                        else
+                          internalerror(2020011402);
+                      end;
+                      tconstsym(result[i]).constdef:=def;
+                    end
+                  else
+                    Message(type_e_mismatch);
+                end;
+              { after type restriction const list terminates }
+              is_const:=false;
+            end
+          { type restriction }
+          else if try_to_consume(_COLON) then
             begin
             begin
               if not allowconstraints then
               if not allowconstraints then
                 Message(parser_e_generic_constraints_not_allowed_here);
                 Message(parser_e_generic_constraints_not_allowed_here);
@@ -1302,6 +1558,7 @@ uses
                     basedef:=cobjectdef.create(tobjectdef(def).objecttype,defname,tobjectdef(def),false);
                     basedef:=cobjectdef.create(tobjectdef(def).objecttype,defname,tobjectdef(def),false);
                     constraintdata.interfaces.delete(0);
                     constraintdata.interfaces.delete(0);
                   end;
                   end;
+
               if basedef.typ<>errordef then
               if basedef.typ<>errordef then
                 with tstoreddef(basedef) do
                 with tstoreddef(basedef) do
                   begin
                   begin
@@ -1328,21 +1585,34 @@ uses
                 begin
                 begin
                   { two different typeless parameters are considered as incompatible }
                   { two different typeless parameters are considered as incompatible }
                   for i:=firstidx to result.count-1 do
                   for i:=firstidx to result.count-1 do
-                    begin
-                      ttypesym(result[i]).typedef:=cundefineddef.create(false);
-                      ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
-                    end;
+                    if tsym(result[i]).typ<>constsym then
+                      begin
+                        ttypesym(result[i]).typedef:=cundefineddef.create(false);
+                        ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
+                      end;
                   { a semicolon terminates a type parameter group }
                   { a semicolon terminates a type parameter group }
                   firstidx:=result.count;
                   firstidx:=result.count;
                 end;
                 end;
             end;
             end;
+          if token=_SEMICOLON then
+            begin
+              is_const:=false;
+              allowconst:=true;
+            end;
+          last_token:=token;
+          last_type_pos:=current_filepos;
         until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
         until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
+        { if the constant parameter is not terminated then the type restriction was
+          not specified and we need to give an error }
+        if is_const then
+          consume(_COLON);
         { two different typeless parameters are considered as incompatible }
         { two different typeless parameters are considered as incompatible }
         for i:=firstidx to result.count-1 do
         for i:=firstidx to result.count-1 do
-          begin
-            ttypesym(result[i]).typedef:=cundefineddef.create(false);
-            ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
-          end;
+          if tsym(result[i]).typ<>constsym then
+            begin
+              ttypesym(result[i]).typedef:=cundefineddef.create(false);
+              ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
+            end;
         block_type:=old_block_type;
         block_type:=old_block_type;
       end;
       end;
 
 
@@ -1350,7 +1620,9 @@ uses
     procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
     procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
       var
       var
         i : longint;
         i : longint;
-        generictype,sym : ttypesym;
+        generictype : tstoredsym;
+        generictypedef : tdef;
+        sym : tsym;
         st : tsymtable;
         st : tsymtable;
       begin
       begin
         def.genericdef:=genericdef;
         def.genericdef:=genericdef;
@@ -1375,10 +1647,23 @@ uses
           def.genericparas:=tfphashobjectlist.create(false);
           def.genericparas:=tfphashobjectlist.create(false);
         for i:=0 to genericlist.count-1 do
         for i:=0 to genericlist.count-1 do
           begin
           begin
-            generictype:=ttypesym(genericlist[i]);
+            generictype:=tstoredsym(genericlist[i]);
             if assigned(generictype.owner) then
             if assigned(generictype.owner) then
               begin
               begin
-                sym:=ctypesym.create(genericlist.nameofindex(i),generictype.typedef);
+                if generictype.typ=typesym then
+                  sym:=ctypesym.create(genericlist.nameofindex(i),ttypesym(generictype).typedef)
+                else if generictype.typ=constsym then
+                  { generictype is a constsym that was created in create_generic_constsym
+                    during phase 1 so we pass this directly without copying }
+                  begin
+                    sym:=generictype;
+                    { the sym name is still undefined so we set it to match
+                      the generic param name so it's accessible }
+                    sym.realname:=genericlist.nameofindex(i);
+                    include(sym.symoptions,sp_generic_const);
+                  end
+                else
+                  internalerror(2019021602);
                 { type parameters need to be added as strict private }
                 { type parameters need to be added as strict private }
                 sym.visibility:=vis_strictprivate;
                 sym.visibility:=vis_strictprivate;
                 st.insert(sym);
                 st.insert(sym);
@@ -1386,13 +1671,17 @@ uses
               end
               end
             else
             else
               begin
               begin
-                if (generictype.typedef.typ=undefineddef) and (generictype.typedef<>cundefinedtype) then
+                if generictype.typ=typesym then
                   begin
                   begin
-                    { the generic parameters were parsed before the genericdef existed thus the
-                      undefineddefs were added as part of the parent symtable }
-                    if assigned(generictype.typedef.owner) then
-                      generictype.typedef.owner.DefList.Extract(generictype.typedef);
-                    generictype.typedef.changeowner(st);
+                    generictypedef:=ttypesym(generictype).typedef;
+                    if (generictypedef.typ=undefineddef) and (generictypedef<>cundefinedtype) then
+                      begin
+                        { the generic parameters were parsed before the genericdef existed thus the
+                          undefineddefs were added as part of the parent symtable }
+                        if assigned(generictypedef.owner) then
+                          generictypedef.owner.DefList.Extract(generictypedef);
+                        generictypedef.changeowner(st);
+                      end;
                   end;
                   end;
                 st.insert(generictype);
                 st.insert(generictype);
                 include(generictype.symoptions,sp_generic_para);
                 include(generictype.symoptions,sp_generic_para);

+ 60 - 15
compiler/pparautl.pas

@@ -631,27 +631,48 @@ implementation
       function check_generic_parameters(fwpd,currpd:tprocdef):boolean;
       function check_generic_parameters(fwpd,currpd:tprocdef):boolean;
         var
         var
           i : longint;
           i : longint;
-          fwtype,
-          currtype : ttypesym;
+          fwsym,
+          currsym : tsym;
+          currtype : ttypesym absolute currsym;
+          fileinfo : tfileposinfo;
         begin
         begin
           result:=true;
           result:=true;
           if fwpd.genericparas.count<>currpd.genericparas.count then
           if fwpd.genericparas.count<>currpd.genericparas.count then
             internalerror(2018090101);
             internalerror(2018090101);
           for i:=0 to fwpd.genericparas.count-1 do
           for i:=0 to fwpd.genericparas.count-1 do
             begin
             begin
-              fwtype:=ttypesym(fwpd.genericparas[i]);
-              currtype:=ttypesym(currpd.genericparas[i]);
-              if fwtype.name<>currtype.name then
+              fwsym:=tsym(fwpd.genericparas[i]);
+              currsym:=tsym(currpd.genericparas[i]);
+              if fwsym.name<>currsym.name then
                 begin
                 begin
-                  messagepos1(currtype.fileinfo,sym_e_generic_type_param_mismatch,currtype.realname);
-                  messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
+                  messagepos1(currsym.fileinfo,sym_e_generic_type_param_mismatch,currsym.realname);
+                  messagepos1(fwsym.fileinfo,sym_e_generic_type_param_decl,fwsym.realname);
                   result:=false;
                   result:=false;
                 end;
                 end;
-              if (fwpd.interfacedef or assigned(fwpd.struct)) and (df_genconstraint in currtype.typedef.defoptions) then
+              if (fwpd.interfacedef or assigned(fwpd.struct)) and
+                 (
+                   ((currsym.typ=typesym) and (df_genconstraint in currtype.typedef.defoptions)) or
+                   (currsym.typ=constsym)
+                 ) then
                 begin
                 begin
-                  messagepos(tstoreddef(currtype.typedef).genconstraintdata.fileinfo,parser_e_generic_constraints_not_allowed_here);
+                  if currsym.typ=constsym then
+                    fileinfo:=currsym.fileinfo
+                  else
+                    fileinfo:=tstoreddef(currtype.typedef).genconstraintdata.fileinfo;
+                  messagepos(fileinfo,parser_e_generic_constraints_not_allowed_here);
                   result:=false;
                   result:=false;
                 end;
                 end;
+              if not fwpd.interfacedef and not assigned(fwpd.struct) and
+                 (fwsym.typ=constsym) then
+                begin
+                  { without modeswitch RepeatForward we need to check here
+                    if the type of the constants match }
+                  if (currsym.typ<>constsym) or not equal_defs(tconstsym(fwsym).constdef,tconstsym(currsym).constdef) then
+                    begin
+                      messagepos1(currpd.fileinfo,parser_e_header_dont_match_forward,currpd.fullprocname(false));
+                      result:=false;
+                    end;
+                end;
             end;
             end;
         end;
         end;
 
 
@@ -659,8 +680,10 @@ implementation
       function equal_generic_procdefs(fwpd,currpd:tprocdef):boolean;
       function equal_generic_procdefs(fwpd,currpd:tprocdef):boolean;
         var
         var
           i : longint;
           i : longint;
-          fwtype,
-          currtype : ttypesym;
+          fwsym,
+          currsym : tsym;
+          fwtype : ttypesym absolute fwsym;
+          currtype : ttypesym absolute currsym;
           foundretdef : boolean;
           foundretdef : boolean;
         begin
         begin
           result:=false;
           result:=false;
@@ -677,14 +700,36 @@ implementation
           foundretdef:=false;
           foundretdef:=false;
           for i:=0 to fwpd.genericparas.count-1 do
           for i:=0 to fwpd.genericparas.count-1 do
             begin
             begin
-              fwtype:=ttypesym(fwpd.genericparas[i]);
-              currtype:=ttypesym(currpd.genericparas[i]);
+              fwsym:=tsym(fwpd.genericparas[i]);
+              currsym:=tsym(currpd.genericparas[i]);
               { if the type in the currpd isn't a pure undefineddef (thus there
               { if the type in the currpd isn't a pure undefineddef (thus there
                 are constraints and the fwpd was declared in the interface, then
                 are constraints and the fwpd was declared in the interface, then
                 we can stop right there }
                 we can stop right there }
-              if fwpd.interfacedef and ((currtype.typedef.typ<>undefineddef) or (df_genconstraint in currtype.typedef.defoptions)) then
+              if fwpd.interfacedef and
+                 (
+                   (currsym.typ=constsym) or
+                   ((currsym.typ=typesym) and
+                     (
+                       (currtype.typedef.typ<>undefineddef) or
+                       (df_genconstraint in currtype.typedef.defoptions)
+                     )
+                   )
+                 )then
                 exit;
                 exit;
-              if not foundretdef then
+              if not fwpd.interfacedef then
+                begin
+                  if (fwsym.typ=constsym) and (currsym.typ=constsym) then
+                    begin
+                      { check whether the constant type for forward functions match }
+                      if not equal_defs(tconstsym(fwsym).constdef,tconstsym(currsym).constdef) then
+                        exit;
+                    end
+                  else if (fwsym.typ=constsym) then
+                    { if the forward sym is a constant, the implementation needs to be one
+                      as well }
+                    exit;
+                end;
+              if not foundretdef and (fwsym.typ=typesym) then
                 begin
                 begin
                   { if the returndef is the same as this parameter's def then this
                   { if the returndef is the same as this parameter's def then this
                     needs to be the case for both procdefs }
                     needs to be the case for both procdefs }

+ 1 - 1
compiler/ppu.pas

@@ -50,7 +50,7 @@ const
   CurrentPPUVersion = 207;
   CurrentPPUVersion = 207;
   { for any other changes to the ppu format, increase this version number
   { for any other changes to the ppu format, increase this version number
     (it's a cardinal) }
     (it's a cardinal) }
-  CurrentPPULongVersion = 8;
+  CurrentPPULongVersion = 9;
 
 
 { unit flags }
 { unit flags }
   uf_big_endian          = $000004;
   uf_big_endian          = $000004;

+ 3 - 1
compiler/pstatmnt.pas

@@ -361,7 +361,9 @@ implementation
         procedure check_range(hp:tnode; fordef: tdef);
         procedure check_range(hp:tnode; fordef: tdef);
           begin
           begin
             if (hp.nodetype=ordconstn) and
             if (hp.nodetype=ordconstn) and
-               (fordef.typ<>errordef) then
+               (fordef.typ<>errordef) and
+               { the node was derived from a generic parameter so ignore range check }
+               not(nf_generic_para in hp.flags) then
               adaptrange(fordef,tordconstnode(hp).value,false,false,true);
               adaptrange(fordef,tordconstnode(hp).value,false,false,true);
           end;
           end;
 
 

+ 11 - 1
compiler/ptype.pas

@@ -1316,6 +1316,7 @@ implementation
 
 
       procedure array_dec(is_packed:boolean;genericdef:tstoreddef;genericlist:tfphashobjectlist);
       procedure array_dec(is_packed:boolean;genericdef:tstoreddef;genericlist:tfphashobjectlist);
         var
         var
+          isgeneric : boolean;
           lowval,
           lowval,
           highval   : TConstExprInt;
           highval   : TConstExprInt;
           indexdef  : tdef;
           indexdef  : tdef;
@@ -1362,6 +1363,7 @@ implementation
                   lowval:=0;
                   lowval:=0;
                   highval:=1;
                   highval:=1;
                   indexdef:=def;
                   indexdef:=def;
+                  isgeneric:=true;
                 end;
                 end;
               else
               else
                 Message(sym_e_error_in_type_def);
                 Message(sym_e_error_in_type_def);
@@ -1409,6 +1411,7 @@ implementation
              begin
              begin
                 { defaults }
                 { defaults }
                 indexdef:=generrordef;
                 indexdef:=generrordef;
+                isgeneric:=false;
                 { use defaults which don't overflow the compiler }
                 { use defaults which don't overflow the compiler }
                 lowval:=0;
                 lowval:=0;
                 highval:=0;
                 highval:=0;
@@ -1424,12 +1427,15 @@ implementation
                   else
                   else
                    begin
                    begin
                      pt:=expr(true);
                      pt:=expr(true);
+                     isgeneric:=false;
                      if pt.nodetype=typen then
                      if pt.nodetype=typen then
                        setdefdecl(pt.resultdef)
                        setdefdecl(pt.resultdef)
                      else
                      else
                        begin
                        begin
                          if pt.nodetype=rangen then
                          if pt.nodetype=rangen then
                            begin
                            begin
+                             if nf_generic_para in pt.flags then
+                               isgeneric:=true;
                              { pure ordconstn expressions can be checked for
                              { pure ordconstn expressions can be checked for
                                generics as well, but don't give an error in case
                                generics as well, but don't give an error in case
                                of parsing a generic if that isn't yet the case }
                                of parsing a generic if that isn't yet the case }
@@ -1446,7 +1452,9 @@ implementation
                                  highval:=tordconstnode(trangenode(pt).right).value;
                                  highval:=tordconstnode(trangenode(pt).right).value;
                                  if highval<lowval then
                                  if highval<lowval then
                                   begin
                                   begin
-                                    Message(parser_e_array_lower_less_than_upper_bound);
+                                    { ignore error if node is generic param }
+                                    if not (nf_generic_para in pt.flags) then
+                                      Message(parser_e_array_lower_less_than_upper_bound);
                                     highval:=lowval;
                                     highval:=lowval;
                                   end
                                   end
                                  else if (lowval<int64(low(asizeint))) or
                                  else if (lowval<int64(low(asizeint))) or
@@ -1494,6 +1502,8 @@ implementation
                     end;
                     end;
                   if is_packed then
                   if is_packed then
                     include(arrdef.arrayoptions,ado_IsBitPacked);
                     include(arrdef.arrayoptions,ado_IsBitPacked);
+                  if isgeneric then
+                    include(arrdef.arrayoptions,ado_IsGeneric);
 
 
                   if token=_COMMA then
                   if token=_COMMA then
                     consume(_COMMA)
                     consume(_COMMA)

+ 8 - 3
compiler/symconst.pas

@@ -212,8 +212,9 @@ type
                               generic is encountered to ease inline
                               generic is encountered to ease inline
                               specializations, etc; those symbols can be
                               specializations, etc; those symbols can be
                               "overridden" with a completely different symbol }
                               "overridden" with a completely different symbol }
-    sp_explicitrename       { this is used to keep track of type renames created
+    sp_explicitrename,      { this is used to keep track of type renames created
                               by the user }
                               by the user }
+    sp_generic_const
   );
   );
   tsymoptions=set of tsymoption;
   tsymoptions=set of tsymoption;
 
 
@@ -241,7 +242,10 @@ type
     { internal def that's not for any export }
     { internal def that's not for any export }
     df_internal,
     df_internal,
     { the local def is referenced from a public function }
     { the local def is referenced from a public function }
-    df_has_global_ref
+    df_has_global_ref,
+    { the def was derived with generic type or const fields so the size
+      of the def can not be determined }
+    df_has_generic_fields
   );
   );
   tdefoptions=set of tdefoption;
   tdefoptions=set of tdefoption;
 
 
@@ -567,7 +571,8 @@ type
     ado_IsArrayOfConst,     // array of const
     ado_IsArrayOfConst,     // array of const
     ado_IsConstString,      // string constant
     ado_IsConstString,      // string constant
     ado_IsBitPacked,        // bitpacked array
     ado_IsBitPacked,        // bitpacked array
-    ado_IsVector            // Vector
+    ado_IsVector,           // Vector
+    ado_IsGeneric           // the index of the array is generic (meaning that the size is not yet known)
   );
   );
   tarraydefoptions=set of tarraydefoption;
   tarraydefoptions=set of tarraydefoption;
 
 

+ 41 - 9
compiler/symdef.pas

@@ -175,6 +175,9 @@ interface
           function is_generic:boolean;
           function is_generic:boolean;
           { same as above for specializations }
           { same as above for specializations }
           function is_specialization:boolean;
           function is_specialization:boolean;
+          { generic utilities }
+          function is_generic_param_const(index:integer):boolean;inline;
+          function get_generic_param_def(index:integer):tdef;inline;
           { registers this def in the unit's deflist; no-op if already registered }
           { registers this def in the unit's deflist; no-op if already registered }
           procedure register_def; override;
           procedure register_def; override;
           { add the def to the top of the symtable stack if it's not yet owned
           { add the def to the top of the symtable stack if it's not yet owned
@@ -2407,14 +2410,32 @@ implementation
          for i:=0 to genericparas.count-1 do
          for i:=0 to genericparas.count-1 do
            begin
            begin
              sym:=tsym(genericparas[i]);
              sym:=tsym(genericparas[i]);
-             if sym.typ<>symconst.typesym then
+             { sym must be either a type or const }
+             if not (sym.typ in [symconst.typesym,symconst.constsym]) then
                internalerror(2014050903);
                internalerror(2014050903);
              if sym.owner.defowner<>self then
              if sym.owner.defowner<>self then
                exit(false);
                exit(false);
+             if (sym.typ=symconst.constsym) and (sp_generic_const in sym.symoptions) then
+               exit(false);
            end;
            end;
      end;
      end;
 
 
 
 
+   function tstoreddef.is_generic_param_const(index:integer):boolean;
+     begin
+       result:=tsym(genericparas[index]).typ=constsym;
+     end;
+
+
+   function tstoreddef.get_generic_param_def(index:integer):tdef;
+     begin
+       if tsym(genericparas[index]).typ=constsym then
+         result:=tconstsym(genericparas[index]).constdef
+       else
+         result:=ttypesym(genericparas[index]).typedef;
+     end;
+
+
    function tstoreddef.is_specialization: boolean;
    function tstoreddef.is_specialization: boolean;
      var
      var
        i : longint;
        i : longint;
@@ -2430,10 +2451,13 @@ implementation
            for i:=0 to genericparas.count-1 do
            for i:=0 to genericparas.count-1 do
              begin
              begin
                sym:=tsym(genericparas[i]);
                sym:=tsym(genericparas[i]);
-               if sym.typ<>symconst.typesym then
+               { sym must be either a type or const }
+               if not (sym.typ in [symconst.typesym,symconst.constsym]) then
                  internalerror(2014050904);
                  internalerror(2014050904);
                if sym.owner.defowner<>self then
                if sym.owner.defowner<>self then
                  exit(true);
                  exit(true);
+               if (sym.typ=symconst.constsym) and (sp_generic_const in sym.symoptions) then
+                 exit(true);
              end;
              end;
            result:=false;
            result:=false;
          end;
          end;
@@ -4179,7 +4203,7 @@ implementation
          ppufile.getderef(rangedefderef);
          ppufile.getderef(rangedefderef);
          lowrange:=ppufile.getasizeint;
          lowrange:=ppufile.getasizeint;
          highrange:=ppufile.getasizeint;
          highrange:=ppufile.getasizeint;
-         ppufile.getset(tppuset1(arrayoptions));
+         ppufile.getset(tppuset2(arrayoptions));
          ppuload_platform(ppufile);
          ppuload_platform(ppufile);
          symtable:=tarraysymtable.create(self);
          symtable:=tarraysymtable.create(self);
          tarraysymtable(symtable).ppuload(ppufile)
          tarraysymtable(symtable).ppuload(ppufile)
@@ -4219,7 +4243,7 @@ implementation
          ppufile.putderef(rangedefderef);
          ppufile.putderef(rangedefderef);
          ppufile.putasizeint(lowrange);
          ppufile.putasizeint(lowrange);
          ppufile.putasizeint(highrange);
          ppufile.putasizeint(highrange);
-         ppufile.putset(tppuset1(arrayoptions));
+         ppufile.putset(tppuset2(arrayoptions));
          writeentry(ppufile,ibarraydef);
          writeentry(ppufile,ibarraydef);
          tarraysymtable(symtable).ppuwrite(ppufile);
          tarraysymtable(symtable).ppuwrite(ppufile);
       end;
       end;
@@ -4339,6 +4363,7 @@ implementation
                (ado_IsDynamicArray in arrayoptions) or
                (ado_IsDynamicArray in arrayoptions) or
                (ado_IsConvertedPointer in arrayoptions) or
                (ado_IsConvertedPointer in arrayoptions) or
                (ado_IsConstructor in arrayoptions) or
                (ado_IsConstructor in arrayoptions) or
+               (ado_IsGeneric in arrayoptions) or
                (highrange<lowrange)
                (highrange<lowrange)
 	      ) and
 	      ) and
            (size=-1) then
            (size=-1) then
@@ -4543,7 +4568,8 @@ implementation
             fullparas,
             fullparas,
             paramname : ansistring;
             paramname : ansistring;
             module : tmodule;
             module : tmodule;
-            sym : ttypesym;
+            sym : tsym;
+            def : tdef;
             i : longint;
             i : longint;
           begin
           begin
             { we want at least enough space for an ellipsis }
             { we want at least enough space for an ellipsis }
@@ -4552,15 +4578,21 @@ implementation
             fullparas:='';
             fullparas:='';
             for i:=0 to genericparas.count-1 do
             for i:=0 to genericparas.count-1 do
               begin
               begin
-                sym:=ttypesym(genericparas[i]);
+                sym:=tsym(genericparas[i]);
                 module:=find_module_from_symtable(sym.owner);
                 module:=find_module_from_symtable(sym.owner);
                 if not assigned(module) then
                 if not assigned(module) then
                   internalerror(2014121202);
                   internalerror(2014121202);
+                if not (sym.typ in [constsym,symconst.typesym]) then
+                  internalerror(2020042501);
+                if sym.typ=constsym then
+                  def:=tconstsym(sym).constdef
+                else
+                  def:=ttypesym(sym).typedef;
                 paramname:=module.realmodulename^;
                 paramname:=module.realmodulename^;
-                if sym.typedef.typ in [objectdef,recorddef] then
-                  paramname:=paramname+'.'+tabstractrecorddef(sym.typedef).rttiname
+                if def.typ in [objectdef,recorddef] then
+                  paramname:=paramname+'.'+tabstractrecorddef(def).rttiname
                 else
                 else
-                  paramname:=paramname+'.'+sym.typedef.typename;
+                  paramname:=paramname+'.'+def.typename;
                 if length(fullparas)+commacount[i>0]+length(paramname)>maxlength then
                 if length(fullparas)+commacount[i>0]+length(paramname)>maxlength then
                   begin
                   begin
                     if i>0 then
                     if i>0 then

+ 36 - 1
compiler/symsym.pas

@@ -401,6 +401,7 @@ interface
           constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);virtual;
           constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef);virtual;
           constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def:tdef);virtual;
           constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint;def:tdef);virtual;
           constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);virtual;
           constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring);virtual;
+          constructor create_undefined(const n : string;def:tdef);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
           destructor  destroy;override;
           procedure buildderef;override;
           procedure buildderef;override;
@@ -491,6 +492,8 @@ interface
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);inline;
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);inline;
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring;filepos:tfileposinfo);
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring;filepos:tfileposinfo);
 
 
+    function same_constvalue(consttyp:tconsttyp;const value1,value2:tconstvalue):boolean;
+
 implementation
 implementation
 
 
     uses
     uses
@@ -528,6 +531,30 @@ implementation
       end;
       end;
 
 
 
 
+    function same_constvalue(consttyp:tconsttyp;const value1,value2:tconstvalue):boolean;
+      begin
+        case consttyp of
+          constnone,
+          constnil:
+            result:=true;
+          constord:
+            result:=value1.valueord=value2.valueord;
+          constpointer:
+            result:=value1.valueordptr=value2.valueordptr;
+          conststring,
+          constreal,
+          constset,
+          constresourcestring,
+          constwstring,
+          constguid: begin
+            if value1.len<>value2.len then
+              exit(false);
+            result:=CompareByte(value1.valueptr^,value2.valueptr^,value1.len)=0;
+          end;
+        end;
+      end;
+
+
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);
     procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring);
       begin
       begin
         check_hints(srsym,symoptions,deprecatedmsg,current_filepos);
         check_hints(srsym,symoptions,deprecatedmsg,current_filepos);
@@ -1618,7 +1645,6 @@ implementation
           tparasymtable(parast).ppuwrite(ppufile);
           tparasymtable(parast).ppuwrite(ppufile);
       end;
       end;
 
 
-
 {****************************************************************************
 {****************************************************************************
                             TABSTRACTVARSYM
                             TABSTRACTVARSYM
 ****************************************************************************}
 ****************************************************************************}
@@ -2426,6 +2452,15 @@ implementation
       end;
       end;
 
 
 
 
+    constructor tconstsym.create_undefined(const n : string;def: tdef);
+      begin
+        inherited create(constsym,n);
+        fillchar(value,sizeof(value),#0);
+        consttyp:=constnone;
+        constdef:=def;
+      end;
+
+
     constructor tconstsym.ppuload(ppufile:tcompilerppufile);
     constructor tconstsym.ppuload(ppufile:tcompilerppufile);
       var
       var
          pd : pbestreal;
          pd : pbestreal;

+ 7 - 4
compiler/utils/ppuutils/ppudump.pp

@@ -1683,7 +1683,8 @@ const
      (mask:sp_generic_para;       str:'Generic Parameter'),
      (mask:sp_generic_para;       str:'Generic Parameter'),
      (mask:sp_has_deprecated_msg; str:'Has Deprecated Message'),
      (mask:sp_has_deprecated_msg; str:'Has Deprecated Message'),
      (mask:sp_generic_dummy;      str:'Generic Dummy'),
      (mask:sp_generic_dummy;      str:'Generic Dummy'),
-     (mask:sp_explicitrename;     str:'Explicit Rename')
+     (mask:sp_explicitrename;     str:'Explicit Rename'),
+     (mask:sp_generic_const;      str:'Generic Constant Parameter')
   );
   );
 var
 var
   symoptions : tsymoptions;
   symoptions : tsymoptions;
@@ -2739,7 +2740,8 @@ const
      (mask:df_not_registered_no_free;  str:'Unregistered/No free (invalid)'),
      (mask:df_not_registered_no_free;  str:'Unregistered/No free (invalid)'),
      (mask:df_llvm_no_struct_packing;  str:'LLVM unpacked struct'),
      (mask:df_llvm_no_struct_packing;  str:'LLVM unpacked struct'),
      (mask:df_internal;       str:'Internal'),
      (mask:df_internal;       str:'Internal'),
-     (mask:df_has_global_ref; str:'Has Global Ref')
+     (mask:df_has_global_ref; str:'Has Global Ref'),
+     (mask:df_has_generic_fields; str:'Has generic fields')
   );
   );
   defstate : array[1..ord(high(tdefstate))] of tdefstateinfo=(
   defstate : array[1..ord(high(tdefstate))] of tdefstateinfo=(
      (mask:ds_vmt_written;           str:'VMT Written'),
      (mask:ds_vmt_written;           str:'VMT Written'),
@@ -3263,14 +3265,15 @@ const
    { ado_IsArrayOfConst     } 'ArrayOfConst',
    { ado_IsArrayOfConst     } 'ArrayOfConst',
    { ado_IsConstString      } 'ConstString',
    { ado_IsConstString      } 'ConstString',
    { ado_IsBitPacked        } 'BitPacked',
    { ado_IsBitPacked        } 'BitPacked',
-   { ado_IsVector           } 'Vector'
+   { ado_IsVector           } 'Vector',
+   { ado_IsGeneric          } 'Generic'
   );
   );
 var
 var
   symoptions: tarraydefoptions;
   symoptions: tarraydefoptions;
   i: tarraydefoption;
   i: tarraydefoption;
   first: boolean;
   first: boolean;
 begin
 begin
-  ppufile.getset(tppuset1(symoptions));
+  ppufile.getset(tppuset2(symoptions));
   if symoptions<>[] then
   if symoptions<>[] then
    begin
    begin
      if ado_IsDynamicArray in symoptions then Include(ArrayDef.Options, aoDynamic);
      if ado_IsDynamicArray in symoptions then Include(ArrayDef.Options, aoDynamic);

+ 39 - 0
tests/test/tgenconst1.pp

@@ -0,0 +1,39 @@
+{ %NORUN }
+{$mode objfpc}
+{
+	test all possible constants
+}
+program tgenconst1;
+
+type
+	TEnums = (Blaise, Pascal);
+	kNames = set of TEnums;
+	kChars = set of char;
+ 
+type
+	generic TBoolean<const U: boolean> = record end;
+	generic TString<const U: string> = record end;
+	generic TFloat<const U: single> = record end;
+	generic TInteger<const U: integer> = record end;
+	generic TChar<const U: char> = record end;
+	generic TByte<const U: byte> = record end;
+	generic TQWord<const U: QWord> = record end;
+	generic TEnum<const U: TEnums> = record end;
+	generic TNames<const U: kNames> = record end;
+	generic TChars<const U: kChars> = record end;
+	generic TPointer<const U: pointer> = record end;
+
+var
+	a: specialize TBoolean<true>;
+	b: specialize TString<'string'>;
+	c: specialize TFloat<1>;
+	d: specialize TInteger<10>;
+	e: specialize TByte<255>;
+	f: specialize TChar<'a'>;
+	g: specialize TEnum<Pascal>;
+	h: specialize TNames<[Blaise,Pascal]>;
+	i: specialize TChars<['a','b']>;
+	j: specialize TQWord<10>;
+	k: specialize TPointer<nil>;
+begin
+end.

+ 14 - 0
tests/test/tgenconst10.pp

@@ -0,0 +1,14 @@
+{%FAIL}
+{$mode objfpc}
+{
+  test type mismatch when specializing generic type with constant value
+}
+program tgenconst10;
+
+type
+	generic TByte<T> = record end;
+	
+var
+	a: specialize TByte<10>;
+begin
+end.

+ 13 - 0
tests/test/tgenconst11.pp

@@ -0,0 +1,13 @@
+{%FAIL}
+{$mode objfpc}
+{
+	test def compare fail with specialized types
+}
+program tgenconst11;
+type
+	generic TConst<const U: integer> = class end;
+var
+	a:specialize TConst<10>;
+begin
+	a:=specialize TConst<'string'>.Create;
+end

+ 15 - 0
tests/test/tgenconst12.pp

@@ -0,0 +1,15 @@
+{ %NORUN }
+{$mode objfpc}
+{
+  test def compare with specialized types
+}
+program tgenconst12;
+
+type
+  generic TTest<const U: integer> = class
+  end;
+
+type
+	ATest = specialize TTest<100>;
+begin 
+end.

+ 51 - 0
tests/test/tgenconst13.pp

@@ -0,0 +1,51 @@
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{
+	test advanced record constants assigned from generic constant values
+}
+program tgenconst13;
+
+type
+	kNames = set of (Blaise,Pascal);
+	kChars = set of char;
+type
+	generic TBoolean<const U: boolean> = record const value = U; end;
+	generic TString<const U: string> = record const value = U; end;
+	generic TFloat<const U: single> = record const value = U; end;
+	generic TInteger<const U: integer> = record const value = U; end;
+	generic TByte<const U: byte> = record const value = U; end;
+	generic TChar<const U: char> = record const value = U; end;
+	generic TQWord<const U: QWord> = record const value = U; end;
+	generic TNames<const U: kNames> = record const value = U; end;
+	generic TChars<const U: kChars> = record const value = U; end;
+
+procedure Test(failed: boolean); inline;
+begin
+	if failed then
+		begin
+			writeln('failed!');
+			halt(-1);
+		end;
+end;
+
+var
+	g0: specialize TBoolean<true>;
+	g1: specialize TString<'string'>;
+	g2: specialize TFloat<10.5>;
+	g3: specialize TInteger<10>;
+	g4: specialize TByte<255>;
+	g5: specialize TChar<'a'>;
+	g6: specialize TQWord<1000000000>;
+	g7: specialize TNames<[Blaise,Pascal]>;
+	g8: specialize TChars<['a','b']>;
+begin
+	Test(g0.value <> true);
+	Test(g1.value <> 'string');
+	Test(g2.value <> 10.5);
+	Test(g3.value <> 10);
+	Test(g4.value <> 255);
+	Test(g5.value <> 'a');
+	Test(g6.value <> 1000000000);
+	Test(g7.value <> [Blaise,Pascal]);
+	Test(g8.value <> ['a','b']);
+end.

+ 42 - 0
tests/test/tgenconst14.pp

@@ -0,0 +1,42 @@
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{
+  test binary operators with generic constant params
+}
+program tgenconst14;
+
+type
+  generic TBinaryOp<const I: Integer> = record
+    const
+    	d0 = I + I;
+    	d1 = I - I; 
+    	d2 = I * I; 
+    	d3 = I / I; 
+    	d4 = I div I; 
+    	d5 = I mod I; 
+    	d6 = I and I;
+    	d7 = I or I;
+      d8 = I shl 2;
+      d9 = I shr 2;
+  end;
+
+procedure Check(aExpected, aActual: Integer; aErrorCode: LongInt);
+begin
+  if aExpected <> aActual then
+    Halt(aErrorCode);
+end;
+
+var
+	op: specialize TBinaryOp<100>;
+begin
+  Check(op.d0, 100 + 100, 1);
+  Check(op.d1, 100 - 100, 2);
+  Check(op.d2, 100 * 100, 3);
+  Check(Trunc(op.d3), Trunc(100 / 100), 4);
+  Check(op.d4, 100 div 100, 5);
+  Check(op.d5, 100 mod 100, 6);
+  Check(op.d6, 100 and 100, 7);
+  Check(op.d7, 100 or 100, 8);
+  Check(op.d8, 100 shl 2, 9);
+  Check(op.d9, 100 shr 2, 10);
+end.

+ 15 - 0
tests/test/tgenconst15.pp

@@ -0,0 +1,15 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{
+  test binary operator error with wrong constant type
+}
+program tgenconst15;
+
+type
+  generic TInt<const I: string> = record
+    const c = I div I;
+  end;
+
+begin
+end.

+ 79 - 0
tests/test/tgenconst16.pp

@@ -0,0 +1,79 @@
+{ %NORUN }
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{
+  various operator tests
+}
+program tgenconst16;
+
+type
+  Day = (mon,tue,wed,thu,fri,sat,sun);  
+  Days = set of Day;  
+  generic TSet<const I: Days> = record
+    const
+      d0 = I + I;   // Union
+      d1 = I - I;   // Difference
+      d2 = I * I;   // Intersection
+      d3 = I >< I;  // Symmetric difference
+      d4 = I <= I;  // Contains
+      d5 = mon in I;
+  end;
+  generic TArray<const I: integer> = record
+    type
+      t0 = array[0..I - 1] of integer;
+      t1 = array[0..high(I)] of integer;
+      t2 = array[0..low(I)] of integer;
+      t3 = array[0..sizeof(I)] of integer;
+    public
+      d0: array[0..I - 1] of integer;
+      d1: array[0..high(I)] of integer;
+      d2: array[0..low(I)] of integer;
+      d3: array[0..sizeof(I)] of integer;
+  end;
+  generic TUnaryOp<const I: integer> = record
+    const
+      d0 = -I;
+      d1 = +I;
+      d2 = not I;
+  end;
+  generic TBinaryOp<const I: integer> = record
+    const
+      // Arithmetic operators
+      // https://freepascal.org/docs-html/ref/refsu45.html
+      d0 = I + I;
+      d1 = I - I;
+      d2 = I * I; 
+      d3 = I / I; 
+      d4 = I div I; 
+      d5 = I mod I; 
+      // Boolean operators
+      // https://freepascal.org/docs-html/ref/refsu47.html
+      d6 = I and I;
+      d7 = I or I;
+      d8 = I xor I;
+      // Logical operators
+      // https://freepascal.org/docs-html/ref/refsu46.html
+      d9 = I shl I;
+      d10 = I shr I;
+      d11 = I << I;
+      d12 = I >> I;
+      // Relational operators
+      // https://freepascal.org/docs-html/ref/refsu50.html#x153-17500012.8.6
+      d13 = I <> I;
+      d14 = I < I;
+      d15 = I > I;
+      d16 = I <= I;
+      d17 = I >= I;
+      d18 = I = I;
+  end;
+  generic TOther<const I: integer> = record
+    procedure DoThis(param: integer = I);
+  end;
+
+procedure TOther.DoThis(param: integer = I);
+begin
+  writeln(param, ' default:', I);
+end;
+
+begin
+end.

+ 27 - 0
tests/test/tgenconst17.pp

@@ -0,0 +1,27 @@
+{ %NORUN }
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{ 
+  testing range checking for arrays and for-loops
+}
+
+program tgenconst17;
+
+type
+	generic TStaticList<T; const Length: SizeUInt> = record
+	  Values: array[0..Length - 1] of T;
+	  procedure Display;
+	end;
+
+procedure TStaticList.Display;
+var 
+	I, n: SizeUInt;
+begin
+  for I := 0 to Length - 1 do
+  	WriteLn(Values[I]);
+end;
+
+var
+	list: specialize TStaticList<Integer, 20>;
+begin
+end.

+ 12 - 0
tests/test/tgenconst18.pp

@@ -0,0 +1,12 @@
+{%FAIL}
+{$mode objfpc}
+{
+  test undefined constants which must be typed
+}
+program tgenconst18;
+
+type
+	generic TUndefined<const U> = record end;
+
+begin
+end.

+ 24 - 0
tests/test/tgenconst19.pp

@@ -0,0 +1,24 @@
+{ %NORUN }
+unit tgenconst19;
+
+{$mode objfpc}
+
+interface
+
+generic procedure Test<const A, B: LongInt>;
+generic procedure Test2<const A, B: LongInt>;
+
+implementation
+
+{ currently it does not matter whether , or ; is used in the definition (Delphi
+  compatible) }
+
+generic procedure Test<A, B>;
+begin
+end;
+
+generic procedure Test2<A; B>;
+begin
+end;
+
+end.

+ 14 - 0
tests/test/tgenconst2.pp

@@ -0,0 +1,14 @@
+{ %NORUN }
+{$mode objfpc}
+{
+  test lists of types/contants
+}
+program tgenconst2;
+
+type
+	generic TMoreThanOne<T1,T2;const U1,U2:integer> = record end;
+	
+var
+	a: specialize TMoreThanOne<integer,string,10,10>;
+begin
+end.

+ 24 - 0
tests/test/tgenconst20.pp

@@ -0,0 +1,24 @@
+{ %NORUN }
+unit tgenconst20;
+
+{$mode delphi}
+
+interface
+
+procedure Test<const A, B: LongInt>;
+procedure Test2<const A, B: LongInt>;
+
+implementation
+
+{ currently it does not matter whether , or ; is used in the definition (Delphi
+  compatible) }
+
+procedure Test<A, B>;
+begin
+end;
+
+procedure Test2<A; B>;
+begin
+end;
+
+end.

+ 16 - 0
tests/test/tgenconst21.pp

@@ -0,0 +1,16 @@
+unit tgenconst21;
+
+{$mode objfpc}
+
+interface
+
+implementation
+
+generic procedure Test<A; const N: LongInt>; forward;
+
+generic procedure Test<A; const N: LongInt>;
+begin
+end;
+
+end.
+

+ 16 - 0
tests/test/tgenconst22.pp

@@ -0,0 +1,16 @@
+unit tgenconst22;
+
+{$mode delphi}
+
+interface
+
+implementation
+
+procedure Test<A; const N: LongInt>; forward;
+
+procedure Test<A; const N: LongInt>;
+begin
+end;
+
+end.
+

+ 19 - 0
tests/test/tgenconst23.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+unit tgenconst23;
+
+{$mode objfpc}
+
+interface
+
+implementation
+
+generic procedure Test<A; const N: LongInt>; forward;
+
+generic procedure Test<A; const N: String>;
+begin
+end;
+
+
+end.
+

+ 19 - 0
tests/test/tgenconst24.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+unit tgenconst24;
+
+{$mode delphi}
+
+interface
+
+implementation
+
+procedure Test<A; const N: LongInt>; forward;
+
+procedure Test<A; const N: String>;
+begin
+end;
+
+
+end.
+

+ 18 - 0
tests/test/tgenconst25.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+unit tgenconst25;
+
+{$mode objfpc}
+
+interface
+
+implementation
+
+generic procedure Test<A; const N: LongInt>; forward;
+
+generic procedure Test<A; N>;
+begin
+end;
+
+end.
+

+ 18 - 0
tests/test/tgenconst26.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+unit tgenconst26;
+
+{$mode delphi}
+
+interface
+
+implementation
+
+procedure Test<A; const N: LongInt>; forward;
+
+procedure Test<A; N>;
+begin
+end;
+
+end.
+

+ 17 - 0
tests/test/tgenconst27.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+unit tgenconst27;
+
+{$mode objfpc}
+
+interface
+
+generic procedure Test<const A: LongInt>;
+
+implementation
+
+generic procedure Test<const A: LongInt>;
+begin
+end;
+
+end.

+ 17 - 0
tests/test/tgenconst28.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+unit tgenconst28;
+
+{$mode delphi}
+
+interface
+
+procedure Test<const A: LongInt>;
+
+implementation
+
+procedure Test<const A: LongInt>;
+begin
+end;
+
+end.

+ 14 - 0
tests/test/tgenconst29.pp

@@ -0,0 +1,14 @@
+{ %NORUN }
+program tgenconst29;
+
+{$mode objfpc}
+
+type
+  TRange = 3..4;
+
+  generic TTest<const U: TRange> = record end;
+
+var
+  t: specialize TTest<3>;
+begin
+end.

+ 20 - 0
tests/test/tgenconst3.pp

@@ -0,0 +1,20 @@
+{ %NORUN }
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{
+  test integer constants in static array ranges
+}
+program tgenconst3;
+
+type
+	generic TList<T;const U:integer> = record
+		const
+			max = U;
+		public
+			m_list: array[0..max-1] of T;
+	end;
+
+var
+	list: specialize TList<integer,128>;
+begin
+end.

+ 14 - 0
tests/test/tgenconst30.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+program tgenconst30;
+
+{$mode objfpc}
+
+type
+  TRange = 3..4;
+
+  generic TTest<const U: TRange> = record end;
+
+var
+  t: specialize TTest<2>;
+begin
+end.

+ 15 - 0
tests/test/tgenconst4.pp

@@ -0,0 +1,15 @@
+{ %NORUN }
+{$mode objfpc}
+{
+  test constants in generic procedures
+}
+program tgenconst4;
+
+generic procedure DoThis<T;const U:string>(msg: string = U);
+begin
+	writeln(msg, ' sizeof:',sizeof(t), ' default: ', U);
+end;
+
+begin
+	specialize DoThis<integer,'genparam'>('hello world');
+end.

+ 28 - 0
tests/test/tgenconst5.pp

@@ -0,0 +1,28 @@
+{ %NORUN }
+{$mode objfpc}
+{
+	test nested generic records with constants
+}
+program tgenconst5;
+
+type
+	generic THelperA<const U:integer> = record
+		list: array[0..U-1] of byte;
+	end;
+
+type
+	generic THelperB<T> = record
+		value: T;
+	end;
+
+type
+	generic TList<T; const U:integer> = record
+		helperA: specialize THelperA<U>;
+		helperB: specialize THelperB<T>;
+	end;
+
+var
+	list: specialize TList<integer,32>;
+begin
+	writeln('sizeof:',sizeof(list));
+end.

+ 25 - 0
tests/test/tgenconst6.pp

@@ -0,0 +1,25 @@
+{ %NORUN }
+{$mode delphi}
+{
+  test delphi mode
+}
+program tgenconst6;
+
+type
+	TList<T; const U: integer> = class
+		list: array[0..U-1] of T;
+		function capacity: integer;
+	end;
+
+function TList<T; U>.capacity: integer;
+begin
+	result := U;	
+end;	
+
+var
+	nums:TList<integer,16>;
+	strs:TList<string,16>;
+begin
+	nums := TList<integer,16>.Create;
+	strs := TList<string,16>.Create;
+end.

+ 14 - 0
tests/test/tgenconst7.pp

@@ -0,0 +1,14 @@
+{%FAIL}
+{$mode objfpc}
+{
+  test type mismatch when specializing constant values
+}
+program tgenconst7;
+
+type
+	generic TInteger<const U: integer> = record end;
+
+var
+	a: specialize TInteger<'string'>;
+begin
+end.

+ 14 - 0
tests/test/tgenconst8.pp

@@ -0,0 +1,14 @@
+{%FAIL}
+{$mode objfpc}
+{
+  test out of range error with constants
+}
+program tgenconst8;
+
+type
+	generic TByte<const U: Byte> = record end;
+	
+var
+	a: specialize TByte<300>;
+begin
+end.

+ 12 - 0
tests/test/tgenconst9.pp

@@ -0,0 +1,12 @@
+{%FAIL}
+{$mode objfpc}
+{
+  test type mismatch when specializing constants with types
+}
+program tgenconst9;
+type
+	generic TByte<const U: Byte> = record end;
+var
+	a: specialize TByte<string>;
+begin
+end.