* basic support for generic classes

git-svn-id: trunk@2020 -

.gitattributes

@@ -5578,6 +5578,11 @@ tests/test/tfpu3.pp svneol=native#text/plain
 tests/test/tfpu4.pp svneol=native#text/plain
 tests/test/tfpu5.pp svneol=native#text/plain
 tests/test/tfpuover.pp svneol=native#text/plain
+tests/test/tgeneric1.pp svneol=native#text/plain
+tests/test/tgeneric2.pp svneol=native#text/plain
+tests/test/tgeneric3.pp svneol=native#text/plain
+tests/test/tgeneric4.pp svneol=native#text/plain
+tests/test/tgeneric5.pp svneol=native#text/plain
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/thintdir.pp svneol=native#text/plain
@@ -5666,6 +5671,8 @@ tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8
 tests/test/twide1.pp svneol=native#text/plain
 tests/test/twide2.pp svneol=native#text/plain
 tests/test/uabstrcl.pp svneol=native#text/plain
+tests/test/ugeneric3.pp svneol=native#text/plain
+tests/test/ugeneric4.pp svneol=native#text/plain
 tests/test/uimpluni1.pp svneol=native#text/plain
 tests/test/uimpluni2.pp svneol=native#text/plain
 tests/test/uinline4a.pp svneol=native#text/plain

compiler/cgobj.pas

@@ -1434,20 +1434,7 @@ implementation
          if is_interfacecom(t) then
           incrfunc:='FPC_INTF_INCR_REF'
          else if is_ansistring(t) then
-       {$ifdef ansistring_bits}
-           begin
-             case Tstringdef(t).string_typ of
-               st_ansistring16:
-                 incrfunc:='FPC_ANSISTR16_INCR_REF';
-               st_ansistring32:
-                 incrfunc:='FPC_ANSISTR32_INCR_REF';
-               st_ansistring64:
-                 incrfunc:='FPC_ANSISTR64_INCR_REF';
-             end;
-           end
-       {$else}
-            incrfunc:='FPC_ANSISTR_INCR_REF'
-       {$endif}
+          incrfunc:='FPC_ANSISTR_INCR_REF'
          else if is_widestring(t) then
           incrfunc:='FPC_WIDESTR_INCR_REF'
          else if is_dynamic_array(t) then
@@ -1499,20 +1486,7 @@ implementation
         if is_interfacecom(t) then
           decrfunc:='FPC_INTF_DECR_REF'
         else if is_ansistring(t) then
-       {$ifdef ansistring_bits}
-           begin
-             case Tstringdef(t).string_typ of
-               st_ansistring16:
-                 decrfunc:='FPC_ANSISTR16_DECR_REF';
-               st_ansistring32:
-                 decrfunc:='FPC_ANSISTR32_DECR_REF';
-               st_ansistring64:
-                 decrfunc:='FPC_ANSISTR64_DECR_REF';
-             end;
-           end
-       {$else}
-            decrfunc:='FPC_ANSISTR_DECR_REF'
-       {$endif}
+          decrfunc:='FPC_ANSISTR_DECR_REF'
          else if is_widestring(t) then
           decrfunc:='FPC_WIDESTR_DECR_REF'
          else if is_dynamic_array(t) then

compiler/dbgstabs.pas

@@ -730,7 +730,11 @@ implementation
             result:=strpnew('*f'+def_stab_number(tprocvardef(def).rettype.def));
           objectdef :
             result:=objectdef_stabstr(tobjectdef(def));
+          undefineddef :
+            result:=def_stabstr_evaluate(def,'formal${numberstring};',[]);
         end;
+        if result=nil then
+          internalerror(200512203);
       end;
 
 
@@ -798,10 +802,15 @@ implementation
       var
         anc : tobjectdef;
         oldtypesym : tsym;
-//        nb  : string[12];
       begin
         if (def.stab_state in [stab_state_writing,stab_state_written]) then
           exit;
+        { never write generic template defs }
+        if df_generic in def.defoptions then
+          begin
+            def.stab_state:=stab_state_written;
+            exit;
+          end;
         { to avoid infinite loops }
         def.stab_state := stab_state_writing;
         { write dependencies first }
@@ -857,31 +866,7 @@ implementation
               tobjectdef(def).symtable.foreach(@method_write_defs,list);
             end;
         end;
-(*
-        { Handle pointerdefs to records and objects to avoid recursion }
-        if (def.deftype=pointerdef) and
-           (tpointerdef(def).pointertype.def.deftype in [recorddef,objectdef]) then
-          begin
-            def.stab_state:=stab_state_used;
-            write_def_stabstr(list,def);
-            {to avoid infinite recursion in record with next-like fields }
-            if tdef(tpointerdef(def).pointertype.def).stab_state=stab_state_writing then
-              begin
-                if assigned(tpointerdef(def).pointertype.def.typesym) then
-                  begin
-                    if is_class(tpointerdef(def).pointertype.def) then
-                      nb:=def_stab_classnumber(tobjectdef(tpointerdef(def).pointertype.def))
-                    else
-                      nb:=def_stab_number(tpointerdef(def).pointertype.def);
-                    list.concat(Tai_stab.create(stab_stabs,def_stabstr_evaluate(
-                            def,'"${sym_name}:t${numberstring}=*$1=xs$2:",${N_LSYM},0,0,0',
-                            [nb,tpointerdef(def).pointertype.def.typesym.name])));
-                  end;
-                def.stab_state:=stab_state_written;
-              end
-          end
-        else
-*)
+
         case def.deftype of
           objectdef :
             begin

compiler/defcmp.pas

@@ -186,6 +186,24 @@ implementation
             exit;
           end;
 
+         { undefined def? then mark it as equal }
+         if (def_from.deftype=undefineddef) or
+            (def_to.deftype=undefineddef) then
+          begin
+            doconv:=tc_equal;
+            compare_defs_ext:=te_equal;
+            exit;
+          end;
+
+         { undefined def? then mark it as equal }
+         if (def_from.deftype=undefineddef) or
+            (def_to.deftype=undefineddef) then
+          begin
+            doconv:=tc_equal;
+            compare_defs_ext:=te_equal;
+            exit;
+          end;
+
          { we walk the wanted (def_to) types and check then the def_from
            types if there is a conversion possible }
          case def_to.deftype of

compiler/defutil.pas

@@ -525,21 +525,12 @@ implementation
                         );
       end;
 
-{$ifdef ansistring_bits}
-    { true if p is an ansi string def }
-    function is_ansistring(p : tdef) : boolean;
-      begin
-         is_ansistring:=(p.deftype=stringdef) and
-                        (tstringdef(p).string_typ in [st_ansistring16,st_ansistring32,st_ansistring64]);
-      end;
-{$else}
     { true if p is an ansi string def }
     function is_ansistring(p : tdef) : boolean;
       begin
          is_ansistring:=(p.deftype=stringdef) and
                         (tstringdef(p).string_typ=st_ansistring);
       end;
-{$endif}
 
     { true if p is an long string def }
     function is_longstring(p : tdef) : boolean;

compiler/globals.pas

@@ -210,9 +210,6 @@ interface
         Initsetalloc,                            {0=fixed, 1 =var}
        {$ENDIF}
        initpackenum       : shortint;
-     {$ifdef ansistring_bits}
-       initansistring_bits: Tstringbits;
-     {$endif}
        initalignment      : talignmentinfo;
        initoptprocessor,
        initspecificoptprocessor : tprocessors;
@@ -234,9 +231,6 @@ interface
        {$ENDIF}
        aktpackrecords,
        aktpackenum        : shortint;
-     {$ifdef ansistring_bits}
-       aktansistring_bits : Tstringbits;
-     {$endif}
        aktmaxfpuregisters : longint;
        aktalignment       : talignmentinfo;
        aktoptprocessor,
@@ -1820,11 +1814,11 @@ end;
         p := @r;
 {$ifdef CPU_ARM}
         inc(p,4);
-{$else}   
+{$else}
 {$ifdef FPC_LITTLE_ENDIAN}
         inc(p,sizeof(r)-1);
-{$endif}          
-{$endif}             
+{$endif}
+{$endif}
         if (p^ and $80) = 0 then
           result := 1
         else

compiler/globtype.pas

@@ -244,10 +244,6 @@ than 255 characters. That's why using Ansi Strings}
        );
        tprocinfoflags=set of tprocinfoflag;
 
-{$ifdef ansistring_bits}
-       Tstringbits=(sb_16,sb_32,sb_64);
-{$endif}
-
      const
        proccalloptionStr : array[tproccalloption] of string[14]=('',
            'CDecl',

compiler/ncgmem.pas

@@ -575,11 +575,7 @@ implementation
                        case tstringdef(left.resulttype.def).string_typ of
                          { it's the same for ansi- and wide strings }
                          st_widestring,
-                       {$ifdef ansistring_bits}
-                         st_ansistring16,st_ansistring32,st_ansistring64:
-                       {$else}
                          st_ansistring:
-                       {$endif}
                            begin
                               paramanager.getintparaloc(pocall_default,1,paraloc1);
                               paramanager.getintparaloc(pocall_default,2,paraloc2);
@@ -713,11 +709,7 @@ implementation
                       case tstringdef(left.resulttype.def).string_typ of
                          { it's the same for ansi- and wide strings }
                          st_widestring,
-                       {$ifdef ansistring_bits}
-                         st_ansistring16,st_ansistring32,st_ansistring64:
-                       {$else}
                          st_ansistring:
-                       {$endif}
                            begin
                               paramanager.getintparaloc(pocall_default,1,paraloc1);
                               paramanager.getintparaloc(pocall_default,2,paraloc2);

compiler/nld.pas

@@ -245,20 +245,7 @@ implementation
            constsym:
              begin
                if tconstsym(symtableentry).consttyp=constresourcestring then
-                 begin
-                 {$ifdef ansistring_bits}
-                   case aktansistring_bits of
-                     sb_16:
-                       resulttype:=cansistringtype16;
-                     sb_32:
-                       resulttype:=cansistringtype32;
-                     sb_64:
-                       resulttype:=cansistringtype64;
-                   end;
-                 {$else}
-                   resulttype:=cansistringtype
-                 {$endif}
-                 end
+                 resulttype:=cansistringtype
                else
                  internalerror(22799);
              end;

compiler/nmem.pas

@@ -714,11 +714,7 @@ implementation
                 case tstringdef(left.resulttype.def).string_typ of
                    st_widestring :
                      resulttype:=cwidechartype;
-                 {$ifdef ansistring_bits}
-                   st_ansistring16,st_ansistring32,st_ansistring64 :
-                 {$else}
                    st_ansistring :
-                 {$endif}
                      resulttype:=cchartype;
                    st_longstring :
                      resulttype:=cchartype;

compiler/parser.pas

@@ -184,7 +184,7 @@ implementation
          current_module.scanner:=current_scanner;
        { loop until EOF is found }
          repeat
-           current_scanner^.readtoken;
+           current_scanner^.readtoken(true);
            preprocfile^.AddSpace;
            case token of
              _ID :
@@ -465,7 +465,7 @@ implementation
          macrosymtablestack:= current_module.localmacrosymtable;
 
          { read the first token }
-         current_scanner.readtoken;
+         current_scanner.readtoken(false);
 
          { init code generator for a new module }
          init_module;

compiler/pbase.pas

@@ -134,7 +134,7 @@ implementation
           begin
             if token=_END then
               last_endtoken_filepos:=akttokenpos;
-            current_scanner.readtoken;
+            current_scanner.readtoken(true);
           end;
       end;
 
@@ -147,7 +147,7 @@ implementation
            try_to_consume:=true;
            if token=_END then
             last_endtoken_filepos:=akttokenpos;
-           current_scanner.readtoken;
+           current_scanner.readtoken(true);
          end;
       end;
 

compiler/pdecl.pas

@@ -194,7 +194,7 @@ implementation
                    block_type:=bt_type;
                    consume(_COLON);
                    ignore_equal:=true;
-                   read_type(tt,'',false);
+                   read_anon_type(tt,false);
                    ignore_equal:=false;
                    block_type:=bt_const;
                    skipequal:=false;
@@ -369,6 +369,22 @@ implementation
 
     { reads a type declaration to the symbol table }
     procedure type_dec;
+
+        function parse_generic_parameters:tsinglelist;
+        var
+          generictype : ttypesym;
+        begin
+          result:=tsinglelist.create;
+          repeat
+            if token=_ID then
+              begin
+                generictype:=ttypesym.create(orgpattern,cundefinedtype);
+                result.insert(generictype);
+              end;
+            consume(_ID);
+          until not try_to_consume(_COMMA) ;
+        end;
+
       var
          typename,orgtypename : stringid;
          newtype  : ttypesym;
@@ -379,22 +395,46 @@ implementation
          defpos,storetokenpos : tfileposinfo;
          old_block_type : tblock_type;
          ch       : tclassheader;
-         unique,istyperenaming : boolean;
-
+         isunique,
+         istyperenaming : boolean;
+         generictypelist : tsinglelist;
+         generictokenbuf : tdynamicarray;
       begin
          old_block_type:=block_type;
          block_type:=bt_type;
          consume(_TYPE);
          typecanbeforward:=true;
          repeat
-           typename:=pattern;
-           orgtypename:=orgpattern;
            defpos:=akttokenpos;
            istyperenaming:=false;
+           generictypelist:=nil;
+           generictokenbuf:=nil;
+
+           typename:=pattern;
+           orgtypename:=orgpattern;
            consume(_ID);
+
+{$ifdef GENERICSHARPBRACKET}
+           { Generic type declaration? }
+           if try_to_consume(_LSHARPBRACKET) then
+             begin
+               generictypelist:=parse_generic_parameters;
+               consume(_RSHARPBRACKET);
+             end;
+{$endif GENERICSHARPBRACKET}
+
            consume(_EQUAL);
+
            { support 'ttype=type word' syntax }
-           unique:=try_to_consume(_TYPE);
+           isunique:=try_to_consume(_TYPE);
+
+           { Generic type declaration? }
+           if try_to_consume(_GENERIC) then
+             begin
+               consume(_LKLAMMER);
+               generictypelist:=parse_generic_parameters;
+               consume(_RKLAMMER);
+             end;
 
            { MacPas object model is more like Delphi's than like TP's, but }
            { uses the object keyword instead of class                      }
@@ -402,6 +442,13 @@ implementation
               (token = _OBJECT) then
              token := _CLASS;
 
+           { Start recording a generic template }
+           if assigned(generictypelist) then
+             begin
+               generictokenbuf:=tdynamicarray.create(256);
+               current_scanner.startrecordtokens(generictokenbuf);
+             end;
+
            { is the type already defined? }
            searchsym(typename,sym,srsymtable);
            newtype:=nil;
@@ -418,7 +465,7 @@ implementation
                   begin
                     { we can ignore the result   }
                     { the definition is modified }
-                    object_dec(orgtypename,tobjectdef(ttypesym(sym).restype.def));
+                    object_dec(orgtypename,nil,nil,tobjectdef(ttypesym(sym).restype.def));
                     newtype:=ttypesym(sym);
                     tt:=newtype.restype;
                   end
@@ -439,14 +486,14 @@ implementation
               akttokenpos:=defpos;
               akttokenpos:=storetokenpos;
               { read the type definition }
-              read_type(tt,orgtypename,false);
+              read_named_type(tt,orgtypename,nil,generictypelist,false);
               { update the definition of the type }
               newtype.restype:=tt;
               if assigned(tt.sym) then
                 istyperenaming:=true
               else
                 tt.sym:=newtype;
-              if unique and assigned(tt.def) then
+              if isunique and assigned(tt.def) then
                 begin
                    tt.setdef(tstoreddef(tt.def).getcopy);
                    include(tt.def.defoptions,df_unique);
@@ -496,6 +543,15 @@ implementation
               end;
             end;
 
+           { Stop recording a generic template }
+           if assigned(generictypelist) then
+             begin
+               current_scanner.stoprecordtokens;
+               tstoreddef(tt.def).generictokenbuf:=generictokenbuf;
+               { Generic is never a type renaming }
+               tt.def.typesym:=newtype;
+             end;
+
            { Write tables if we are the typesym that defines
              this type. This will not be done for simple type renamings }
            if (tt.def.typesym=newtype) then

compiler/pdecobj.pas

@@ -26,15 +26,16 @@ unit pdecobj;
 interface
 
     uses
+      cclasses,
       globtype,symtype,symdef;
 
     { parses a object declaration }
-    function object_dec(const n : stringid;fd : tobjectdef) : tdef;
+    function object_dec(const n : stringid;genericdef:tstoreddef;genericlist:tsinglelist;fd : tobjectdef) : tdef;
 
 implementation
 
     uses
-      cutils,cclasses,
+      cutils,
       globals,verbose,systems,tokens,
       symconst,symbase,symsym,
       node,nld,nmem,ncon,ncnv,ncal,
@@ -49,7 +50,7 @@ implementation
       current_procinfo = 'error';
 
 
-    function object_dec(const n : stringid;fd : tobjectdef) : tdef;
+    function object_dec(const n : stringid;genericdef:tstoreddef;genericlist:tsinglelist;fd : tobjectdef) : tdef;
     { this function parses an object or class declaration }
       var
          there_is_a_destructor : boolean;
@@ -498,6 +499,7 @@ implementation
       var
         pd : tprocdef;
         dummysymoptions : tsymoptions;
+        generictype : ttypesym;
       begin
          old_object_option:=current_object_option;
 
@@ -540,6 +542,22 @@ implementation
          symtablestack:=aktobjectdef.symtable;
          testcurobject:=1;
 
+         { add generic type parameters }
+         aktobjectdef.genericdef:=genericdef;
+         if assigned(genericlist) then
+           begin
+             generictype:=ttypesym(genericlist.first);
+             while assigned(generictype) do
+               begin
+                 if generictype.restype.def.deftype=undefineddef then
+                   include(aktobjectdef.defoptions,df_generic)
+                 else
+                   include(aktobjectdef.defoptions,df_specialization);
+                 symtablestack.insert(generictype);
+                 generictype:=ttypesym(generictype.listnext);
+               end;
+           end;
+
          { short class declaration ? }
          if (classtype<>odt_class) or (token<>_SEMICOLON) then
           begin

compiler/pdecsub.pas

@@ -639,6 +639,7 @@ implementation
         orgsp,sp : stringid;
         sym : tsym;
         srsym : tsym;
+        oldsymtablestack,
         srsymtable : tsymtable;
         storepos,
         procstartfilepos : tfileposinfo;
@@ -838,6 +839,31 @@ implementation
         pd._class:=aclass;
         pd.procsym:=aprocsym;
         pd.proctypeoption:=potype;
+
+        { methods inherit df_generic or df_specialization from the objectdef }
+        if assigned(pd._class) then
+          begin
+            if (df_generic in pd._class.defoptions) then
+              include(pd.defoptions,df_generic);
+            if (df_specialization in pd._class.defoptions) then
+              begin
+                include(pd.defoptions,df_specialization);
+                { Find corresponding genericdef, we need it later to
+                  replay the tokens to generate the body }
+                if not assigned(pd._class.genericdef) then
+                  internalerror(200512113);
+                st:=pd._class.genericdef.getsymtable(gs_record);
+                if not assigned(st) then
+                  internalerror(200512114);
+                { We are parsing the same objectdef, the def index numbers
+                  are the same }
+                pd.genericdef:=tstoreddef(st.getdefnr(pd.indexnr));
+                if not assigned(pd.genericdef) or
+                   (pd.genericdef.deftype<>procdef) then
+                  internalerror(200512115);
+              end;
+          end;
+
         { methods need to be exported }
         if assigned(aclass) and
            (
@@ -852,7 +878,25 @@ implementation
 
         { parse parameters }
         if token=_LKLAMMER then
-          parse_parameter_dec(pd);
+          begin
+            { Add objectsymtable to be able to find generic type definitions }
+            oldsymtablestack:=symtablestack;
+            if assigned(pd._class) and
+               (pd.parast.symtablelevel=normal_function_level) and
+               (symtablestack.symtabletype<>objectsymtable) then
+              begin
+                pd._class.symtable.next:=symtablestack;
+                symtablestack:=pd._class.symtable;
+              end;
+            { Add parameter symtable }
+            if pd.parast.symtabletype<>staticsymtable then
+              begin
+                 pd.parast.next:=symtablestack;
+                 symtablestack:=pd.parast;
+              end;
+            parse_parameter_dec(pd);
+            symtablestack:=oldsymtablestack;
+          end;
 
         result:=true;
       end;

compiler/pdecvar.pas

@@ -768,17 +768,20 @@ implementation
              { this is needed for Delphi mode at least
                but should be OK for all modes !! (PM) }
              ignore_equal:=true;
-             if options*[vd_record,vd_object]<>[] then
+             if ((vd_record in options) or
+                 (vd_object in options)) and
+                not(df_generic in tdef(symtablestack.defowner).defoptions) and
+                not(df_specialization in tdef(symtablestack.defowner).defoptions) then
               begin
                 { for records, don't search the recordsymtable for
                   the symbols of the types }
                 oldsymtablestack:=symtablestack;
                 symtablestack:=symtablestack.next;
-                read_type(tt,'',false);
+                read_anon_type(tt,false);
                 symtablestack:=oldsymtablestack;
               end
              else
-              read_type(tt,'',false);
+              read_anon_type(tt,false);
              ignore_equal:=false;
              { Process procvar directives }
              if (tt.def.deftype=procvardef) and
@@ -1209,7 +1212,7 @@ implementation
                    the symbols of the types }
                  oldsymtablestack:=symtablestack;
                  symtablestack:=symtablestack.next;
-                 read_type(casetype,'',true);
+                 read_anon_type(casetype,true);
                  symtablestack:=oldsymtablestack;
                end
               else
@@ -1220,7 +1223,7 @@ implementation
                     the symbols of the types }
                   oldsymtablestack:=symtablestack;
                   symtablestack:=symtablestack.next;
-                  read_type(casetype,'',true);
+                  read_anon_type(casetype,true);
                   symtablestack:=oldsymtablestack;
                   fieldvs:=tfieldvarsym.create(sorg,vs_value,casetype,[]);
                   tabstractrecordsymtable(symtablestack).insertfield(fieldvs,true);

compiler/pexpr.pas

@@ -75,7 +75,7 @@ implementation
        nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
        { parser }
        scanner,
-       pbase,pinline,
+       pbase,pinline,ptype,
        { codegen }
        cgbase,procinfo,cpuinfo
        ;
@@ -139,18 +139,7 @@ implementation
           else
             begin
                if cs_ansistrings in aktlocalswitches then
-                 {$ifdef ansistring_bits}
-                 case aktansistring_bits of
-                   sb_16:
-                     t:=cansistringtype16;
-                   sb_32:
-                     t:=cansistringtype32;
-                   sb_64:
-                     t:=cansistringtype64;
-                 end
-                 {$else}
                  t:=cansistringtype
-                 {$endif}
                else
                  t:=cshortstringtype;
             end;
@@ -1323,7 +1312,8 @@ implementation
                        if (htype.def=cvarianttype.def) and
                           not(cs_compilesystem in aktmoduleswitches) then
                          current_module.flags:=current_module.flags or uf_uses_variants;
-                       if try_to_consume(_LKLAMMER) then
+                       if (block_type<>bt_type) and
+                          try_to_consume(_LKLAMMER) then
                         begin
                           p1:=comp_expr(true);
                           consume(_RKLAMMER);
@@ -1450,18 +1440,7 @@ implementation
                         begin
                           p1:=cloadnode.create(srsym,srsymtable);
                           do_resulttypepass(p1);
-                        {$ifdef ansistring_bits}
-                          case aktansistring_bits of
-                            sb_16:
-                              p1.resulttype:=cansistringtype16;
-                            sb_32:
-                              p1.resulttype:=cansistringtype32;
-                            sb_64:
-                              p1.resulttype:=cansistringtype64;
-                          end;
-                        {$else}
                           p1.resulttype:=cansistringtype;
-                        {$endif}
                         end;
                       constguid :
                         p1:=cguidconstnode.create(pguid(tconstsym(srsym).value.valueptr)^);
@@ -2425,9 +2404,10 @@ implementation
 
            else
              begin
+               Message(parser_e_illegal_expression);
                p1:=cerrornode.create;
+               { recover }
                consume(token);
-               Message(parser_e_illegal_expression);
              end;
         end;
 

compiler/pinline.pas

@@ -110,7 +110,7 @@ implementation
               end;
 
             do_member_read(classh,false,sym,p2,again,[]);
-            
+
             { we need the real called method }
             do_resulttypepass(p2);
 
@@ -127,7 +127,7 @@ implementation
                   end
                 else
                   begin
-                   { Free is not a destructor 
+                   { Free is not a destructor
                     if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then
                       Message(parser_e_expr_have_to_be_destructor_call);
                    }
@@ -678,9 +678,6 @@ implementation
         ppn     : tcallparanode;
         paradef : tdef;
         counter : integer;
-{$ifdef ansistring_bits}
-        mode    : byte;
-{$endif ansistring_bits}
       begin
         { for easy exiting if something goes wrong }
         result := cerrornode.create;
@@ -704,40 +701,12 @@ implementation
            ppn:=tcallparanode(ppn.right);
          end;
         paradef:=ppn.left.resulttype.def;
-{$ifdef ansistring_bits}
-        if is_ansistring(paradef) then
-          case Tstringdef(paradef).string_typ of
-            st_ansistring16:
-              mode:=16;
-            st_ansistring32:
-              mode:=32;
-            st_ansistring64:
-              mode:=64;
-          end;
-        if (is_chararray(paradef) and (paradef.size>255)) or
-           ((cs_ansistrings in aktlocalswitches) and is_pchar(paradef)) then
-          case aktansistring_bits of
-            sb_16:
-              mode:=16;
-            sb_32:
-              mode:=32;
-            sb_64:
-              mode:=64;
-          end;
-        if mode=16 then
-          copynode:=ccallnode.createintern('fpc_ansistr16_copy',paras)
-        else if mode=32 then
-          copynode:=ccallnode.createintern('fpc_ansistr32_copy',paras)
-        else if mode=64 then
-          copynode:=ccallnode.createintern('fpc_ansistr64_copy',paras)
-{$else}
         if is_ansistring(paradef) or
            (is_chararray(paradef) and
             (paradef.size>255)) or
            ((cs_ansistrings in aktlocalswitches) and
             is_pchar(paradef)) then
           copynode:=ccallnode.createintern('fpc_ansistr_copy',paras)
-{$endif}
         else
          if is_widestring(paradef) or
             is_widechararray(paradef) or

compiler/pmodules.pas

@@ -1091,6 +1091,9 @@ implementation
              release_main_proc(pd);
            end;
 
+         { Generate specializations of objectdefs methods }
+         generate_specialization_procs;
+
          { if the unit contains ansi/widestrings, initialization and
            finalization code must be forced }
          force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
@@ -1405,6 +1408,9 @@ implementation
          current_module.mainfilepos:=current_procinfo.entrypos;
          release_main_proc(pd);
 
+         { Generate specializations of objectdefs methods }
+         generate_specialization_procs;
+
          { should we force unit initialization? }
          if tstaticsymtable(current_module.localsymtable).needs_init_final then
            begin

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=50;
+  CurrentPPUVersion=51;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -116,15 +116,10 @@ const
   ibfloatdef       = 52;
   ibclassrefdef    = 53;
   iblongstringdef  = 54;
-{$ifdef ansistring_bits}
-  ibansistring16def  = 58;
-  ibansistring32def  = 55;
-  ibansistring64def  = 59;
-{$else}
   ibansistringdef  = 55;
-{$endif}
   ibwidestringdef  = 56;
   ibvariantdef     = 57;
+  ibundefineddef   = 58;
   {implementation/objectdata}
   ibnodetree       = 80;
   ibasmsymbols     = 81;

compiler/psub.pas

@@ -65,6 +65,7 @@ interface
     { reads declarations in the interface part of a unit }
     procedure read_interface_declarations;
 
+    procedure generate_specialization_procs;
 
 
 implementation
@@ -622,6 +623,10 @@ implementation
         if Errorcount<>0 then
           exit;
 
+        { No code can be generated for generic template }
+        if (df_generic in procdef.defoptions) then
+          internalerror(200511152);
+
         { The RA and Tempgen shall not be available yet }
         if assigned(tg) then
           internalerror(200309201);
@@ -672,7 +677,7 @@ implementation
         add_entry_exit_code;
 
         { only do secondpass if there are no errors }
-        if ErrorCount=0 then
+        if (ErrorCount=0) then
           begin
             { set the start offset to the start of the temp area in the stack }
             tg:=ttgobj.create;
@@ -991,9 +996,13 @@ implementation
       var
          oldprocinfo : tprocinfo;
          oldblock_type : tblock_type;
+         oldconstsymtable : tsymtable;
+         st : tsymtable;
       begin
          oldprocinfo:=current_procinfo;
          oldblock_type:=block_type;
+         oldconstsymtable:=constsymtable;
+
          { reset break and continue labels }
          block_type:=bt_body;
 
@@ -1027,8 +1036,31 @@ implementation
          entrypos:=aktfilepos;
          entryswitches:=aktlocalswitches;
 
+         if (df_generic in procdef.defoptions) then
+           begin
+             { start token recorder for generic template }
+             procdef.initgeneric;
+             current_scanner.startrecordtokens(procdef.generictokenbuf);
+           end;
+
          { parse the code ... }
          code:=block(current_module.islibrary);
+
+         if (df_generic in procdef.defoptions) then
+           begin
+             { stop token recorder for generic template }
+             current_scanner.stoprecordtokens;
+
+             { Give a warning for accesses in the static symtable that aren't visible
+               outside the current unit }
+             st:=procdef.owner;
+             while (st.symtabletype=objectsymtable) do
+               st:=st.defowner.owner;
+             if (pi_uses_static_symtable in flags) and
+                (st.symtabletype<>staticsymtable) then
+               Comment(V_Warning,'Global Generic template references static symtable');
+           end;
+
          { save exit info }
          exitswitches:=aktlocalswitches;
          exitpos:=last_endtoken_filepos;
@@ -1096,6 +1128,8 @@ implementation
            allow_only_static:=false;
          current_procinfo:=oldprocinfo;
 
+         { Restore old state }
+         constsymtable:=oldconstsymtable;
          block_type:=oldblock_type;
       end;
 
@@ -1117,6 +1151,115 @@ implementation
       end;
 
 
+
+    procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef);
+      {
+        Parses the procedure directives, then parses the procedure body, then
+        generates the code for it
+      }
+
+      procedure do_generate_code(pi:tcgprocinfo);
+        var
+          hpi : tcgprocinfo;
+        begin
+          { generate code for this procedure }
+          pi.generate_code;
+          { process nested procs }
+          hpi:=tcgprocinfo(pi.nestedprocs.first);
+          while assigned(hpi) do
+           begin
+             do_generate_code(hpi);
+             hpi:=tcgprocinfo(hpi.next);
+           end;
+          pi.resetprocdef;
+        end;
+
+      var
+        oldfailtokenmode : tmodeswitch;
+        isnestedproc     : boolean;
+      begin
+        Message1(parser_d_procedure_start,pd.fullprocname(false));
+
+        { create a new procedure }
+        current_procinfo:=cprocinfo.create(old_current_procinfo);
+        current_module.procinfo:=current_procinfo;
+        current_procinfo.procdef:=pd;
+        isnestedproc:=(current_procinfo.procdef.parast.symtablelevel>normal_function_level);
+
+        { Insert mangledname }
+        pd.aliasnames.insert(pd.mangledname);
+
+        { Handle Export of this procedure }
+        if (po_exports in pd.procoptions) and
+           (target_info.system in [system_i386_os2,system_i386_emx]) then
+          begin
+            pd.aliasnames.insert(pd.procsym.realname);
+            if cs_link_deffile in aktglobalswitches then
+              deffile.AddExport(pd.mangledname);
+          end;
+
+        { Insert result variables in the localst }
+        insert_funcret_local(pd);
+
+        { check if there are para's which require initing -> set }
+        { pi_do_call (if not yet set)                            }
+        if not(pi_do_call in current_procinfo.flags) then
+          pd.parast.foreach_static(@check_init_paras,nil);
+
+        { set _FAIL as keyword if constructor }
+        if (pd.proctypeoption=potype_constructor) then
+         begin
+           oldfailtokenmode:=tokeninfo^[_FAIL].keyword;
+           tokeninfo^[_FAIL].keyword:=m_all;
+         end;
+
+        tcgprocinfo(current_procinfo).parse_body;
+
+        { When it's a nested procedure then defer the code generation,
+          when back at normal function level then generate the code
+          for all defered nested procedures and the current procedure }
+        if isnestedproc then
+          tcgprocinfo(current_procinfo.parent).nestedprocs.insert(current_procinfo)
+        else
+          begin
+            { We can't support inlining for procedures that have nested
+              procedures because the nested procedures use a fixed offset
+              for accessing locals in the parent procedure (PFV) }
+            if (tcgprocinfo(current_procinfo).nestedprocs.count>0) then
+              begin
+                if (df_generic in current_procinfo.procdef.defoptions) then
+{$warning TODO Add error message for nested procs in generics}
+                  internalerror(200511151)
+                else if (po_inline in current_procinfo.procdef.procoptions) then
+                  begin
+                    Message1(parser_w_not_supported_for_inline,'nested procedures');
+                    Message(parser_w_inlining_disabled);
+                    current_procinfo.procdef.proccalloption:=pocall_default;
+                  end;
+              end;
+            if not(df_generic in current_procinfo.procdef.defoptions) then
+              do_generate_code(tcgprocinfo(current_procinfo));
+          end;
+
+        { reset _FAIL as _SELF normal }
+        if (pd.proctypeoption=potype_constructor) then
+          tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
+
+        { release procinfo }
+        if tprocinfo(current_module.procinfo)<>current_procinfo then
+          internalerror(200304274);
+        current_module.procinfo:=current_procinfo.parent;
+        if not isnestedproc then
+          current_procinfo.free;
+
+        { For specialization we didn't record the last semicolon. Moving this parsing
+          into the parse_body routine is not done because of having better file position
+          information available }
+        if not(df_specialization in current_procinfo.procdef.defoptions) then
+          consume(_SEMICOLON);
+      end;
+
+
     procedure read_proc;
       {
         Parses the procedure directives, then parses the procedure body, then
@@ -1141,15 +1284,11 @@ implementation
 
       var
         old_current_procinfo : tprocinfo;
-        oldconstsymtable : tsymtable;
-        oldfailtokenmode : tmodeswitch;
         pdflags          : tpdflags;
         pd               : tprocdef;
-        isnestedproc     : boolean;
         s                : string;
       begin
          { save old state }
-         oldconstsymtable:=constsymtable;
          old_current_procinfo:=current_procinfo;
 
          { reset current_procinfo.procdef to nil to be sure that nothing is writing
@@ -1233,75 +1372,7 @@ implementation
          { compile procedure when a body is needed }
          if (pd_body in pdflags) then
            begin
-             Message1(parser_d_procedure_start,pd.fullprocname(false));
-
-             { create a new procedure }
-             current_procinfo:=cprocinfo.create(old_current_procinfo);
-             current_module.procinfo:=current_procinfo;
-             current_procinfo.procdef:=pd;
-             isnestedproc:=(current_procinfo.procdef.parast.symtablelevel>normal_function_level);
-
-             { Insert mangledname }
-             pd.aliasnames.insert(pd.mangledname);
-
-             { Handle Export of this procedure }
-             if (po_exports in pd.procoptions) and
-                (target_info.system in [system_i386_os2,system_i386_emx]) then
-               begin
-                 pd.aliasnames.insert(pd.procsym.realname);
-                 if cs_link_deffile in aktglobalswitches then
-                   deffile.AddExport(pd.mangledname);
-               end;
-
-             { Insert result variables in the localst }
-             insert_funcret_local(pd);
-
-             { check if there are para's which require initing -> set }
-             { pi_do_call (if not yet set)                            }
-             if not(pi_do_call in current_procinfo.flags) then
-               pd.parast.foreach_static(@check_init_paras,nil);
-
-             { set _FAIL as keyword if constructor }
-             if (pd.proctypeoption=potype_constructor) then
-              begin
-                oldfailtokenmode:=tokeninfo^[_FAIL].keyword;
-                tokeninfo^[_FAIL].keyword:=m_all;
-              end;
-
-             tcgprocinfo(current_procinfo).parse_body;
-
-             { When it's a nested procedure then defer the code generation,
-               when back at normal function level then generate the code
-               for all defered nested procedures and the current procedure }
-             if isnestedproc then
-               tcgprocinfo(current_procinfo.parent).nestedprocs.insert(current_procinfo)
-             else
-               begin
-                 { We can't support inlining for procedures that have nested
-                   procedures because the nested procedures use a fixed offset
-                   for accessing locals in the parent procedure (PFV) }
-                 if (po_inline in current_procinfo.procdef.procoptions) and
-                    (tcgprocinfo(current_procinfo).nestedprocs.count>0) then
-                   begin
-                     Message1(parser_w_not_supported_for_inline,'nested procedures');
-                     Message(parser_w_inlining_disabled);
-                     current_procinfo.procdef.proccalloption:=pocall_default;
-                   end;
-                 do_generate_code(tcgprocinfo(current_procinfo));
-               end;
-
-             { reset _FAIL as _SELF normal }
-             if (pd.proctypeoption=potype_constructor) then
-               tokeninfo^[_FAIL].keyword:=oldfailtokenmode;
-
-             { release procinfo }
-             if tprocinfo(current_module.procinfo)<>current_procinfo then
-               internalerror(200304274);
-             current_module.procinfo:=current_procinfo.parent;
-             if not isnestedproc then
-               current_procinfo.free;
-
-             consume(_SEMICOLON);
+             read_proc_body(old_current_procinfo,pd);
            end
          else
            begin
@@ -1348,9 +1419,6 @@ implementation
                end;
            end;
 
-         { Restore old state }
-         constsymtable:=oldconstsymtable;
-
          current_procinfo:=old_current_procinfo;
       end;
 
@@ -1483,4 +1551,60 @@ implementation
       end;
 
 
+{****************************************************************************
+                      SPECIALIZATION BODY GENERATION
+****************************************************************************}
+
+
+    procedure specialize_objectdefs(p:tnamedindexitem;arg:pointer);
+      var
+        hp : tdef;
+        oldaktfilepos : tfileposinfo;
+      begin
+        if not((tsym(p).typ=typesym) and
+               (ttypesym(p).restype.def.deftype=objectdef) and
+               (df_specialization in ttypesym(p).restype.def.defoptions)
+              ) then
+          exit;
+
+        { definitions }
+        hp:=tdef(tobjectdef(ttypesym(p).restype.def).symtable.defindex.first);
+        while assigned(hp) do
+         begin
+           if hp.deftype=procdef then
+             begin
+               if not(
+                      assigned(tprocdef(hp).genericdef) and
+                      (tprocdef(hp).genericdef.deftype=procdef) and
+                      assigned(tprocdef(tprocdef(hp).genericdef).generictokenbuf)
+                     ) then
+                 internalerror(200512111);
+               oldaktfilepos:=aktfilepos;
+               aktfilepos:=tprocdef(tprocdef(hp).genericdef).fileinfo;
+               akttokenpos:=aktfilepos;
+               current_scanner.startreplaytokens(tprocdef(tprocdef(hp).genericdef).generictokenbuf);
+               read_proc_body(nil,tprocdef(hp));
+               aktfilepos:=oldaktfilepos;
+             end;
+           hp:=tdef(hp.indexnext);
+         end;
+      end;
+
+
+    procedure generate_specialization_procs;
+      var
+        oldsymtablestack : tsymtable;
+      begin
+        if assigned(current_module.globalsymtable) then
+          current_module.globalsymtable.foreach_static(@specialize_objectdefs,nil);
+        if assigned(current_module.localsymtable) then
+          begin
+            oldsymtablestack:=symtablestack;
+            current_module.localsymtable.next:=symtablestack;
+            symtablestack:=current_module.localsymtable;
+            current_module.localsymtable.foreach_static(@specialize_objectdefs,nil);
+            symtablestack:=oldsymtablestack;
+          end;
+      end;
+
 end.

compiler/psystem.pas

@@ -158,13 +158,7 @@ implementation
 {$ifdef support_longstring}
         addtype('LongString',clongstringtype);
 {$endif support_longstring}
-{$ifdef ansistring_bits}
-        addtype('AnsiString',cansistringtype16);
-        addtype('AnsiString',cansistringtype32);
-        addtype('AnsiString',cansistringtype64);
-{$else}
         addtype('AnsiString',cansistringtype);
-{$endif}
         addtype('WideString',cwidestringtype);
         addtype('Boolean',booltype);
         addtype('ByteBool',booltype);
@@ -185,6 +179,7 @@ implementation
         addtype('Variant',cvarianttype);
         addtype('OleVariant',colevarianttype);
         { Internal types }
+        addtype('$undefined',cundefinedtype);
         addtype('$formal',cformaltype);
         addtype('$void',voidtype);
         addtype('$byte',u8inttype);
@@ -199,13 +194,7 @@ implementation
         addtype('$widechar',cwidechartype);
         addtype('$shortstring',cshortstringtype);
         addtype('$longstring',clongstringtype);
-      {$ifdef ansistring_bits}
-        addtype('$ansistring16',cansistringtype16);
-        addtype('$ansistring32',cansistringtype32);
-        addtype('$ansistring64',cansistringtype64);
-      {$else}
         addtype('$ansistring',cansistringtype);
-      {$endif}
         addtype('$widestring',cwidestringtype);
         addtype('$openshortstring',openshortstringtype);
         addtype('$boolean',booltype);
@@ -277,19 +266,14 @@ implementation
         loadtype('longint',s32inttype);
         loadtype('qword',u64inttype);
         loadtype('int64',s64inttype);
+        loadtype('undefined',cundefinedtype);
         loadtype('formal',cformaltype);
         loadtype('void',voidtype);
         loadtype('char',cchartype);
         loadtype('widechar',cwidechartype);
         loadtype('shortstring',cshortstringtype);
         loadtype('longstring',clongstringtype);
-      {$ifdef ansistring_bits}
-        loadtype('ansistring16',cansistringtype16);
-        loadtype('ansistring32',cansistringtype32);
-        loadtype('ansistring64',cansistringtype64);
-      {$else}
         loadtype('ansistring',cansistringtype);
-      {$endif}
         loadtype('widestring',cwidestringtype);
         loadtype('openshortstring',openshortstringtype);
         loadtype('openchararray',openchararraytype);
@@ -332,6 +316,7 @@ implementation
         { create definitions for constants }
         oldregisterdef:=registerdef;
         registerdef:=false;
+        cundefinedtype.setdef(tundefineddef.create);
         cformaltype.setdef(tformaldef.create);
         voidtype.setdef(torddef.create(uvoid,0,0));
         u8inttype.setdef(torddef.create(u8bit,0,255));
@@ -348,13 +333,7 @@ implementation
         cshortstringtype.setdef(tstringdef.createshort(255));
         { should we give a length to the default long and ansi string definition ?? }
         clongstringtype.setdef(tstringdef.createlong(-1));
-      {$ifdef ansistring_bits}
-        cansistringtype16.setdef(tstringdef.createansi(-1,sb_16));
-        cansistringtype32.setdef(tstringdef.createansi(-1,sb_32));
-        cansistringtype64.setdef(tstringdef.createansi(-1,sb_64));
-      {$else}
         cansistringtype.setdef(tstringdef.createansi(-1));
-      {$endif}
         cwidestringtype.setdef(tstringdef.createwide(-1));
         { length=0 for shortstring is open string (needed for readln(string) }
         openshortstringtype.setdef(tstringdef.createshort(0));

compiler/ptype.pas

@@ -26,7 +26,7 @@ unit ptype;
 interface
 
     uses
-       globtype,symtype;
+       globtype,cclasses,symtype,symdef;
 
     const
        { forward types should only be possible inside a TYPE statement }
@@ -41,7 +41,8 @@ interface
     { tdef }
     procedure single_type(var tt:ttype;isforwarddef:boolean);
 
-    procedure read_type(var tt:ttype;const name : stringid;parseprocvardir:boolean);
+    procedure read_named_type(var tt:ttype;const name : stringid;genericdef:tstoreddef;genericlist:tsinglelist;parseprocvardir:boolean);
+    procedure read_anon_type(var tt : ttype;parseprocvardir:boolean);
 
     { reads a type definition }
     { to a appropriating tdef, s gets the name of   }
@@ -60,7 +61,7 @@ implementation
        { target }
        paramgr,
        { symtable }
-       symconst,symbase,symdef,symsym,symtable,
+       symconst,symbase,symsym,symtable,
        defutil,defcmp,
        { pass 1 }
        node,
@@ -70,6 +71,101 @@ implementation
        pbase,pexpr,pdecsub,pdecvar,pdecobj;
 
 
+    procedure generate_specialization(var pt1:tnode;const name:string);
+      var
+        st  : tsymtable;
+        pt2 : tnode;
+        first,
+        err : boolean;
+        sym : tsym;
+        genericdef : tstoreddef;
+        generictype : ttypesym;
+        generictypelist : tsinglelist;
+      begin
+        { retrieve generic def that we are going to replace }
+        genericdef:=tstoreddef(pt1.resulttype.def);
+        pt1.resulttype.reset;
+        if not(df_generic in genericdef.defoptions) then
+          begin
+            Comment(V_Error,'Specialization is only supported for generic types');
+            pt1.resulttype:=generrortype;
+            { recover }
+{$ifdef GENERICSHARPBRACKET}
+            consume(_LSHARPBRACKET);
+{$endif GENERICSHARPBRACKET}
+            consume(_LKLAMMER);
+            repeat
+              pt2:=factor(false);
+              pt2.free;
+            until not try_to_consume(_COMMA);
+{$ifdef GENERICSHARPBRACKET}
+            consume(_RSHARPBRACKET);
+{$endif GENERICSHARPBRACKET}
+            consume(_RKLAMMER);
+            exit;
+          end;
+{$ifdef GENERICSHARPBRACKET}
+        consume(_LSHARPBRACKET);
+{$endif GENERICSHARPBRACKET}
+        consume(_LKLAMMER);
+        { Parse generic parameters, for each undefineddef in the symtable of
+          the genericdef we need to have a new def }
+        err:=false;
+        first:=true;
+        generictypelist:=tsinglelist.create;
+        case genericdef.deftype of
+          procdef :
+            st:=genericdef.getsymtable(gs_para);
+          objectdef,
+          recorddef :
+            st:=genericdef.getsymtable(gs_record);
+        end;
+        if not assigned(st) then
+          internalerror(200511182);
+        sym:=tsym(st.symindex.first);
+        while assigned(sym) do
+          begin
+            if (sym.typ=typesym) and
+               (ttypesym(sym).restype.def.deftype=undefineddef) then
+              begin
+                if not first then
+                  begin
+                    consume(_COMMA);
+                    first:=false;
+                  end;
+                pt2:=factor(false);
+                if pt2.nodetype=typen then
+                  begin
+                    generictype:=ttypesym.create(sym.realname,pt2.resulttype);
+                    generictypelist.insert(generictype);
+                  end
+                else
+                  begin
+                    Message(type_e_type_id_expected);
+                    err:=true;
+                  end;
+                pt2.free;
+              end;
+            sym:=tsym(sym.indexnext);
+          end;
+        { Reparse the original type definition }
+        if not err then
+          begin
+            if not assigned(genericdef.generictokenbuf) then
+              internalerror(200511171);
+            current_scanner.startreplaytokens(genericdef.generictokenbuf);
+            read_named_type(pt1.resulttype,name,genericdef,generictypelist,false);
+            { Consume the semicolon if it is also recorded }
+            try_to_consume(_SEMICOLON);
+          end;
+        generictypelist.free;
+{$ifdef GENERICSHARPBRACKET}
+        consume(_RSHARPBRACKET);
+{$endif GENERICSHARPBRACKET}
+        consume(_RKLAMMER);
+      end;
+
+
     procedure id_type(var tt : ttype;isforwarddef:boolean);
     { reads a type definition }
     { to a appropriating tdef, s gets the name of   }
@@ -188,6 +284,7 @@ implementation
           case token of
             _STRING:
               string_dec(tt);
+
             _FILE:
               begin
                  consume(_FILE);
@@ -200,8 +297,10 @@ implementation
                  else
                    tt:=cfiletype;
               end;
+
             _ID:
               id_type(tt,isforwarddef);
+
             else
               begin
                 message(type_e_type_id_expected);
@@ -244,7 +343,7 @@ implementation
 
 
     { reads a type definition and returns a pointer to it }
-    procedure read_type(var tt : ttype;const name : stringid;parseprocvardir:boolean);
+    procedure read_named_type(var tt : ttype;const name : stringid;genericdef:tstoreddef;genericlist:tsinglelist;parseprocvardir:boolean);
       var
         pt : tnode;
         tt2 : ttype;
@@ -259,6 +358,7 @@ implementation
         var
            pt1,pt2 : tnode;
            lv,hv   : TConstExprInt;
+           ispecialization : boolean;
         begin
            { use of current parsed object:
               - classes can be used also in classes
@@ -275,6 +375,8 @@ implementation
                tt.setdef(aktobjectdef);
                exit;
              end;
+           { Generate a specialization? }
+           ispecialization:=try_to_consume(_SPECIALIZE);
            { we can't accept a equal in type }
            pt1:=comp_expr(not(ignore_equal));
            if (token=_POINTPOINT) then
@@ -322,9 +424,13 @@ implementation
              end
            else
              begin
-               { a simple type renaming }
+               { a simple type renaming or generic specialization }
                if (pt1.nodetype=typen) then
-                 tt:=ttypenode(pt1).resulttype
+                 begin
+                   if ispecialization then
+                     generate_specialization(pt1,name);
+                   tt:=ttypenode(pt1).resulttype;
+                 end
                else
                  Message(sym_e_error_in_type_def);
              end;
@@ -390,7 +496,7 @@ implementation
                     be parsed by readtype (PFV) }
                   if token=_LKLAMMER then
                    begin
-                     read_type(ht,'',true);
+                     read_anon_type(ht,true);
                      setdefdecl(ht);
                    end
                   else
@@ -458,7 +564,7 @@ implementation
                 tt.setdef(ap);
              end;
            consume(_OF);
-           read_type(tt2,'',true);
+           read_anon_type(tt2,true);
            { if no error, set element type }
            if assigned(ap) then
              ap.setelementtype(tt2);
@@ -544,7 +650,7 @@ implementation
               begin
                 consume(_SET);
                 consume(_OF);
-                read_type(tt2,'',true);
+                read_anon_type(tt2,true);
                 if assigned(tt2.def) then
                  begin
                    case tt2.def.deftype of
@@ -591,7 +697,7 @@ implementation
                     oldaktpackrecords:=aktpackrecords;
                     aktpackrecords:=1;
                     if token in [_CLASS,_OBJECT] then
-                      tt.setdef(object_dec(name,nil))
+                      tt.setdef(object_dec(name,genericdef,genericlist,nil))
                     else
                       tt.setdef(record_dec);
                     aktpackrecords:=oldaktpackrecords;
@@ -602,7 +708,7 @@ implementation
             _INTERFACE,
             _OBJECT:
               begin
-                tt.setdef(object_dec(name,nil));
+                tt.setdef(object_dec(name,genericdef,genericlist,nil));
               end;
             _PROCEDURE,
             _FUNCTION:
@@ -646,4 +752,11 @@ implementation
           tt:=generrortype;
       end;
 
+
+    procedure read_anon_type(var tt : ttype;parseprocvardir:boolean);
+      begin
+        read_named_type(tt,'',nil,nil,parseprocvardir);
+      end;
+
+
 end.

compiler/scanner.pas

@@ -83,6 +83,10 @@ interface
           lasttoken,
           nexttoken    : ttoken;
 
+          replaysavetoken : ttoken;
+          replaytokenbuf,
+          recordtokenbuf : tdynamicarray;
+
           comment_level,
           yylexcount     : longint;
           lastasmgetchar : char;
@@ -121,6 +125,11 @@ interface
           procedure handleconditional(p:tdirectiveitem);
           procedure handledirectives;
           procedure linebreak;
+          procedure recordtoken;
+          procedure startrecordtokens(buf:tdynamicarray);
+          procedure stoprecordtokens;
+          procedure replaytoken;
+          procedure startreplaytokens(buf:tdynamicarray);
           procedure readchar;
           procedure readstring;
           procedure readnumber;
@@ -136,7 +145,7 @@ interface
           procedure skipcomment;
           procedure skipdelphicomment;
           procedure skipoldtpcomment;
-          procedure readtoken;
+          procedure readtoken(allowrecordtoken:boolean);
           function  readpreproc:ttoken;
           function  asmgetcharstart : char;
           function  asmgetchar:char;
@@ -1741,6 +1750,119 @@ compile time variables as the old format (0/1), continue to work.
       end;
 
 
+    procedure tscannerfile.startrecordtokens(buf:tdynamicarray);
+      begin
+        if not assigned(buf) then
+          internalerror(200511172);
+        if assigned(recordtokenbuf) then
+          internalerror(200511173);
+        recordtokenbuf:=buf;
+      end;
+
+
+    procedure tscannerfile.stoprecordtokens;
+      begin
+        if not assigned(recordtokenbuf) then
+          internalerror(200511174);
+        recordtokenbuf:=nil;
+      end;
+
+
+    procedure tscannerfile.recordtoken;
+      begin
+        if not assigned(recordtokenbuf) then
+          internalerror(200511176);
+        recordtokenbuf.write(token,1);
+        if token=_ID then
+          recordtokenbuf.write(idtoken,1);
+        case token of
+          _CWCHAR,
+          _CWSTRING :
+            begin
+              recordtokenbuf.write(patternw^.len,sizeof(sizeint));
+              recordtokenbuf.write(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
+            end;
+          _CCHAR,
+          _CSTRING,
+          _INTCONST,
+          _REALNUMBER :
+            begin
+              recordtokenbuf.write(pattern[0],1);
+              recordtokenbuf.write(pattern[1],length(pattern));
+            end;
+          _ID :
+            begin
+              recordtokenbuf.write(orgpattern[0],1);
+              recordtokenbuf.write(orgpattern[1],length(orgpattern));
+            end;
+        end;
+      end;
+
+
+    procedure tscannerfile.startreplaytokens(buf:tdynamicarray);
+      begin
+        if not assigned(buf) then
+          internalerror(200511175);
+        { save current token }
+        if token in [_CWCHAR,_CWSTRING,_CCHAR,_CSTRING,_INTCONST,_REALNUMBER,_ID] then
+          internalerror(200511178);
+        replaysavetoken:=token;
+        dec(inputpointer);
+        { install buffer }
+        replaytokenbuf:=buf;
+        { reload next token }
+        replaytokenbuf.seek(0);
+        replaytoken;
+      end;
+
+
+    procedure tscannerfile.replaytoken;
+      var
+        wlen : sizeint;
+      begin
+        if not assigned(replaytokenbuf) then
+          internalerror(200511177);
+        { End of replay buffer? Then load the next char from the file again }
+        if replaytokenbuf.pos>=replaytokenbuf.size then
+          begin
+            replaytokenbuf:=nil;
+            c:=inputpointer^;
+            inc(inputpointer);
+            token:=replaysavetoken;
+            exit;
+          end;
+        { load token from the buffer }
+        replaytokenbuf.read(token,1);
+        if token=_ID then
+          replaytokenbuf.read(idtoken,1);
+        case token of
+          _CWCHAR,
+          _CWSTRING :
+            begin
+              replaytokenbuf.read(wlen,sizeof(SizeInt));
+              setlengthwidestring(patternw,wlen);
+              replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
+              pattern:='';
+            end;
+          _CCHAR,
+          _CSTRING,
+          _INTCONST,
+          _REALNUMBER :
+            begin
+              replaytokenbuf.read(pattern[0],1);
+              replaytokenbuf.read(pattern[1],length(pattern));
+              orgpattern:='';
+            end;
+          _ID :
+            begin
+              replaytokenbuf.read(orgpattern[0],1);
+              replaytokenbuf.read(orgpattern[1],length(orgpattern));
+              pattern:=upper(orgpattern);
+            end;
+        end;
+      end;
+
+
     procedure tscannerfile.addfile(hp:tinputfile);
       begin
         saveinputfile;
@@ -2776,7 +2898,7 @@ compile time variables as the old format (0/1), continue to work.
                                Token Scanner
 ****************************************************************************}
 
-    procedure tscannerfile.readtoken;
+    procedure tscannerfile.readtoken(allowrecordtoken:boolean);
       var
         code    : integer;
         len,
@@ -2795,6 +2917,19 @@ compile time variables as the old format (0/1), continue to work.
             aktlocalswitches:=nextaktlocalswitches;
             localswitcheschanged:=false;
           end;
+
+        { record tokens? }
+        if allowrecordtoken and
+           assigned(recordtokenbuf) then
+          recordtoken;
+
+        { replay tokens? }
+        if assigned(replaytokenbuf) then
+          begin
+            replaytoken;
+            goto exit_label;
+          end;
+
       { was there already a token read, then return that token }
         if nexttoken<>NOTOKEN then
          begin
@@ -2885,7 +3020,7 @@ compile time variables as the old format (0/1), continue to work.
                      { handle empty macros }
                        if c=#0 then
                          reload;
-                       readtoken;
+                       readtoken(false);
                        { that's all folks }
                        dec(yylexcount);
                        exit;
@@ -3028,7 +3163,7 @@ compile time variables as the old format (0/1), continue to work.
                      begin
                        c:=#0;{Signal skipoldtpcomment to reload a char }
                        skipoldtpcomment;
-                       readtoken;
+                       readtoken(false);
                        exit;
                      end;
                    '.' :
@@ -3123,7 +3258,7 @@ compile time variables as the old format (0/1), continue to work.
                    '/' :
                      begin
                        skipdelphicomment;
-                       readtoken;
+                       readtoken(false);
                        exit;
                      end;
                  end;
@@ -3422,54 +3557,64 @@ compile time variables as the old format (0/1), continue to work.
              '>' :
                begin
                  readchar;
-                 case c of
-                   '=' :
-                     begin
-                       readchar;
-                       token:=_GTE;
-                       goto exit_label;
-                     end;
-                   '>' :
-                     begin
-                       readchar;
-                       token:=_OP_SHR;
-                       goto exit_label;
-                     end;
-                   '<' :
-                     begin { >< is for a symetric diff for sets }
-                       readchar;
-                       token:=_SYMDIF;
-                       goto exit_label;
+                 if (block_type=bt_type) then
+                   token:=_RSHARPBRACKET
+                 else
+                   begin
+                     case c of
+                       '=' :
+                         begin
+                           readchar;
+                           token:=_GTE;
+                           goto exit_label;
+                         end;
+                       '>' :
+                         begin
+                           readchar;
+                           token:=_OP_SHR;
+                           goto exit_label;
+                         end;
+                       '<' :
+                         begin { >< is for a symetric diff for sets }
+                           readchar;
+                           token:=_SYMDIF;
+                           goto exit_label;
+                         end;
                      end;
-                 end;
-                 token:=_GT;
+                     token:=_GT;
+                   end;
                  goto exit_label;
                end;
 
              '<' :
                begin
                  readchar;
-                 case c of
-                   '>' :
-                     begin
-                       readchar;
-                       token:=_UNEQUAL;
-                       goto exit_label;
-                     end;
-                   '=' :
-                     begin
-                       readchar;
-                       token:=_LTE;
-                       goto exit_label;
-                     end;
-                   '<' :
-                     begin
-                       readchar;
-                       token:=_OP_SHL;
-                       goto exit_label;
+                 if (block_type=bt_type) then
+                   token:=_LSHARPBRACKET
+                 else
+                   begin
+                     case c of
+                       '>' :
+                         begin
+                           readchar;
+                           token:=_UNEQUAL;
+                           goto exit_label;
+                         end;
+                       '=' :
+                         begin
+                           readchar;
+                           token:=_LTE;
+                           goto exit_label;
+                         end;
+                       '<' :
+                         begin
+                           readchar;
+                           token:=_OP_SHL;
+                           goto exit_label;
+                         end;
                      end;
-                 end;
-                 token:=_LT;
+                     token:=_LT;
+                   end;
                  goto exit_label;
                end;
 

compiler/symconst.pas

@@ -43,11 +43,7 @@ const
   tkSString  = 7;
   tkString   = tkSString;
   tkLString  = 8;
-{$ifdef ansistring_bits}
-  tkA32String  = 9;
-{$else}
   tkAString  = 9;
-{$endif}
   tkWString  = 10;
   tkVariant  = 11;
   tkArray    = 12;
@@ -61,11 +57,7 @@ const
   tkQWord    = 20;
   tkDynArray = 21;
   tkInterfaceCorba = 22;
-{$ifdef ansistring_bits}
-  tkA16string = 23;
-  tkA64string = 24;
-{$endif}
-  tkprocvar  = 25;
+  tkProcVar  = 23;
 
   otSByte    = 0;
   otUByte    = 1;
@@ -159,7 +151,11 @@ type
     { rtti data has been generated }
     df_has_rttitable,
     { type is unique, i.e. declared with type = type <tdef>; }
-    df_unique
+    df_unique,
+    { type is a generic }
+    df_generic,
+    { type is a specialization of a generic type }
+    df_specialization
   );
   tdefoptions=set of tdefoption;
 
@@ -353,7 +349,7 @@ type
   tdeftype = (abstractdef,arraydef,recorddef,pointerdef,orddef,
               stringdef,enumdef,procdef,objectdef,errordef,
               filedef,formaldef,setdef,procvardef,floatdef,
-              classrefdef,forwarddef,variantdef);
+              classrefdef,forwarddef,variantdef,undefineddef);
 
   { possible types for symtable entries }
   tsymtyp = (abstractsym,globalvarsym,localvarsym,paravarsym,fieldvarsym,
@@ -421,7 +417,7 @@ const
        'abstractdef','arraydef','recorddef','pointerdef','orddef',
        'stringdef','enumdef','procdef','objectdef','errordef',
        'filedef','formaldef','setdef','procvardef','floatdef',
-       'classrefdef','forwarddef','variantdef'
+       'classrefdef','forwarddef','variantdef','undefineddef'
      );
 
      EqualTypeName : array[tequaltype] of string[16] = (

compiler/symdef.pas

@@ -59,12 +59,16 @@ interface
           inittablesymderef : tderef;
           { local (per module) rtti and init tables }
           localrttilab  : array[trttitype] of tasmlabel;
-          { linked list of global definitions }
 {$ifdef EXTDEBUG}
           fileinfo   : tfileposinfo;
 {$endif}
+          { generic support }
+          genericdef      : tstoreddef;
+          genericdefderef : tderef;
+          generictokenbuf : tdynamicarray;
           constructor create;
           constructor ppuloaddef(ppufile:tcompilerppufile);
+          destructor  destroy;override;
           procedure reset;virtual;
           function getcopy : tstoreddef;virtual;
           procedure ppuwritedef(ppufile:tcompilerppufile);
@@ -86,6 +90,8 @@ interface
           { regvars }
           function is_intregable : boolean;
           function is_fpuregable : boolean;
+          { generics }
+          procedure initgeneric;
        private
           savesize  : aint;
        end;
@@ -136,6 +142,13 @@ interface
           function  gettypename:string;override;
        end;
 
+       tundefineddef = class(tstoreddef)
+          constructor create;
+          constructor ppuload(ppufile:tcompilerppufile);
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function  gettypename:string;override;
+       end;
+
        terrordef = class(tstoreddef)
           constructor create;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -552,13 +565,8 @@ interface
           constructor loadshort(ppufile:tcompilerppufile);
           constructor createlong(l : aint);
           constructor loadlong(ppufile:tcompilerppufile);
-       {$ifdef ansistring_bits}
-          constructor createansi(l:aint;bits:Tstringbits);
-          constructor loadansi(ppufile:tcompilerppufile;bits:Tstringbits);
-       {$else}
           constructor createansi(l : aint);
           constructor loadansi(ppufile:tcompilerppufile);
-       {$endif}
           constructor createwide(l : aint);
           constructor loadwide(ppufile:tcompilerppufile);
           function getcopy : tstoreddef;override;
@@ -634,6 +642,7 @@ interface
        charpointertype,           { pointer for Char-Pointerdef }
        widecharpointertype,       { pointer for WideChar-Pointerdef }
        voidfarpointertype,
+       cundefinedtype,
        cformaltype,               { unique formal definition }
        voidtype,                  { Void (procedure) }
        cchartype,                 { Char }
@@ -653,13 +662,7 @@ interface
        s64currencytype,           { pointer to a currency type }
        cshortstringtype,          { pointer to type of short string const   }
        clongstringtype,           { pointer to type of long string const   }
-{$ifdef ansistring_bits}
-       cansistringtype16,         { pointer to type of ansi string const  }
-       cansistringtype32,         { pointer to type of ansi string const  }
-       cansistringtype64,         { pointer to type of ansi string const  }
-{$else}
        cansistringtype,           { pointer to type of ansi string const  }
-{$endif}
        cwidestringtype,           { pointer to type of wide string const  }
        openshortstringtype,       { pointer to type of an open shortstring,
                                     needed for readln() }
@@ -899,10 +902,23 @@ implementation
          if registerdef then
            symtablestack.registerdef(self);
          fillchar(localrttilab,sizeof(localrttilab),0);
+         generictokenbuf:=nil;
+         genericdef:=nil;
+      end;
+
+
+    destructor tstoreddef.destroy;
+      begin
+        if assigned(generictokenbuf) then
+          generictokenbuf.free;
+        inherited destroy;
       end;
 
 
     constructor tstoreddef.ppuloaddef(ppufile:tcompilerppufile);
+      var
+        sizeleft,i : longint;
+        buf  : array[0..255] of byte;
       begin
          inherited create;
 {$ifdef EXTDEBUG}
@@ -917,6 +933,23 @@ implementation
           ppufile.getderef(rttitablesymderef);
          if df_has_inittable in defoptions then
           ppufile.getderef(inittablesymderef);
+         if df_generic in defoptions then
+           begin
+             sizeleft:=ppufile.getlongint;
+             initgeneric;
+             while sizeleft>0 do
+               begin
+                 if sizeleft>sizeof(buf) then
+                   i:=sizeof(buf)
+                 else
+                   i:=sizeleft;
+                 ppufile.getdata(buf,i);
+                 generictokenbuf.write(buf,i);
+                 dec(sizeleft,i);
+               end;
+           end;
+        if df_specialization in defoptions then
+          ppufile.getderef(genericdefderef);
       end;
 
 
@@ -939,6 +972,10 @@ implementation
 
 
     procedure tstoreddef.ppuwritedef(ppufile:tcompilerppufile);
+      var
+        sizeleft,i : longint;
+        buf  : array[0..255] of byte;
+        oldintfcrc : boolean;
       begin
         ppufile.putword(indexnr);
         ppufile.putderef(typesymderef);
@@ -947,6 +984,32 @@ implementation
          ppufile.putderef(rttitablesymderef);
         if df_has_inittable in defoptions then
          ppufile.putderef(inittablesymderef);
+        if df_generic in defoptions then
+          begin
+            oldintfcrc:=ppufile.do_interface_crc;
+            ppufile.do_interface_crc:=false;
+            if assigned(generictokenbuf) then
+              begin
+                sizeleft:=generictokenbuf.size;
+                generictokenbuf.seek(0);
+              end
+            else
+              sizeleft:=0;
+            ppufile.putlongint(sizeleft);
+            while sizeleft>0 do
+              begin
+                if sizeleft>sizeof(buf) then
+                  i:=sizeof(buf)
+                else
+                  i:=sizeleft;
+                generictokenbuf.read(buf,i);
+                ppufile.putdata(buf,i);
+                dec(sizeleft,i);
+              end;
+            ppufile.do_interface_crc:=oldintfcrc;
+          end;
+        if df_specialization in defoptions then
+          ppufile.putderef(genericdefderef);
       end;
 
 
@@ -955,6 +1018,7 @@ implementation
         typesymderef.build(typesym);
         rttitablesymderef.build(rttitablesym);
         inittablesymderef.build(inittablesym);
+        genericdefderef.build(genericdef);
       end;
 
 
@@ -970,6 +1034,8 @@ implementation
           rttitablesym:=trttisym(rttitablesymderef.resolve);
         if df_has_inittable in defoptions then
           inittablesym:=trttisym(inittablesymderef.resolve);
+        if df_specialization in defoptions then
+          genericdef:=tstoreddef(genericdefderef.resolve);
       end;
 
 
@@ -1091,6 +1157,13 @@ implementation
      end;
 
 
+   procedure tstoreddef.initgeneric;
+     begin
+       if assigned(generictokenbuf) then
+         internalerror(200512131);
+       generictokenbuf:=tdynamicarray.create(256);
+     end;
+
 
 {****************************************************************************
                                Tstringdef
@@ -1135,40 +1208,7 @@ implementation
          savesize:=sizeof(aint);
       end;
 
-{$ifdef ansistring_bits}
-    constructor tstringdef.createansi(l:aint;bits:Tstringbits);
-      begin
-         inherited create;
-         case bits of
-           sb_16:
-             string_typ:=st_ansistring16;
-           sb_32:
-             string_typ:=st_ansistring32;
-           sb_64:
-             string_typ:=st_ansistring64;
-         end;
-         deftype:=stringdef;
-         len:=l;
-         savesize:=POINTER_SIZE;
-      end;
-
 
-    constructor tstringdef.loadansi(ppufile:tcompilerppufile;bits:Tstringbits);
-      begin
-         inherited ppuloaddef(ppufile);
-         deftype:=stringdef;
-         case bits of
-           sb_16:
-             string_typ:=st_ansistring16;
-           sb_32:
-             string_typ:=st_ansistring32;
-           sb_64:
-             string_typ:=st_ansistring64;
-         end;
-         len:=ppufile.getaint;
-         savesize:=POINTER_SIZE;
-      end;
-{$else}
     constructor tstringdef.createansi(l:aint);
       begin
          inherited create;
@@ -1180,7 +1220,6 @@ implementation
 
 
     constructor tstringdef.loadansi(ppufile:tcompilerppufile);
-
       begin
          inherited ppuloaddef(ppufile);
          deftype:=stringdef;
@@ -1188,7 +1227,7 @@ implementation
          len:=ppufile.getaint;
          savesize:=sizeof(aint);
       end;
-{$endif}
+
 
     constructor tstringdef.createwide(l : aint);
       begin
@@ -1221,17 +1260,10 @@ implementation
 
 
     function tstringdef.stringtypname:string;
-{$ifdef ansistring_bits}
-      const
-        typname:array[tstringtype] of string[9]=('',
-          'shortstr','longstr','ansistr16','ansistr32','ansistr64','widestr'
-        );
-{$else}
       const
         typname:array[tstringtype] of string[8]=('',
           'shortstr','longstr','ansistr','widestr'
         );
-{$endif}
       begin
         stringtypname:=typname[string_typ];
       end;
@@ -1252,13 +1284,7 @@ implementation
          case string_typ of
             st_shortstring : ppufile.writeentry(ibshortstringdef);
             st_longstring : ppufile.writeentry(iblongstringdef);
-         {$ifdef ansistring_bits}
-            st_ansistring16 : ppufile.writeentry(ibansistring16def);
-            st_ansistring32 : ppufile.writeentry(ibansistring32def);
-            st_ansistring64 : ppufile.writeentry(ibansistring64def);
-         {$else}
             st_ansistring : ppufile.writeentry(ibansistringdef);
-         {$endif}
             st_widestring : ppufile.writeentry(ibwidestringdef);
          end;
       end;
@@ -1266,24 +1292,14 @@ implementation
 
     function tstringdef.needs_inittable : boolean;
       begin
-      {$ifdef ansistring_bits}
-         needs_inittable:=string_typ in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring];
-      {$else}
          needs_inittable:=string_typ in [st_ansistring,st_widestring];
-      {$endif}
       end;
 
 
     function tstringdef.gettypename : string;
-{$ifdef ansistring_bits}
-      const
-         names : array[tstringtype] of string[20] = ('',
-           'shortstring','longstring','ansistring16','ansistring32','ansistring64','widestring');
-{$else}
       const
          names : array[tstringtype] of string[20] = ('',
            'ShortString','LongString','AnsiString','WideString');
-{$endif}
       begin
          gettypename:=names[string_typ];
       end;
@@ -1312,29 +1328,11 @@ implementation
     procedure tstringdef.write_rtti_data(rt:trttitype);
       begin
          case string_typ of
-          {$ifdef ansistring_bits}
-            st_ansistring16:
-              begin
-                 asmlist[al_rtti].concat(Tai_const.Create_8bit(tkA16String));
-                 write_rtti_name;
-              end;
-            st_ansistring32:
-              begin
-                 asmlist[al_rtti].concat(Tai_const.Create_8bit(tkA32String));
-                 write_rtti_name;
-              end;
-            st_ansistring64:
-              begin
-                 asmlist[al_rtti].concat(Tai_const.Create_8bit(tkA64String));
-                 write_rtti_name;
-              end;
-          {$else}
             st_ansistring:
               begin
                  asmlist[al_rtti].concat(Tai_const.Create_8bit(tkAString));
                  write_rtti_name;
               end;
-          {$endif}
             st_widestring:
               begin
                  asmlist[al_rtti].concat(Tai_const.Create_8bit(tkWString));
@@ -5380,6 +5378,36 @@ implementation
       end;
 
 
+{****************************************************************************
+                               TUNDEFINEDDEF
+****************************************************************************}
+
+   constructor tundefineddef.create;
+     begin
+        inherited create;
+        deftype:=undefineddef;
+     end;
+
+
+    constructor tundefineddef.ppuload(ppufile:tcompilerppufile);
+      begin
+         inherited ppuloaddef(ppufile);
+         deftype:=undefineddef;
+      end;
+
+    function tundefineddef.gettypename:string;
+      begin
+        gettypename:='<undefined type>';
+      end;
+
+
+    procedure tundefineddef.ppuwrite(ppufile:tcompilerppufile);
+      begin
+         inherited ppuwritedef(ppufile);
+         ppufile.writeentry(ibundefineddef);
+      end;
+
+
 {****************************************************************************
                                   TERRORDEF
 ****************************************************************************}

compiler/symtable.pas

@@ -314,13 +314,7 @@ implementation
                  ibprocdef : hp:=tprocdef.ppuload(ppufile);
           ibshortstringdef : hp:=tstringdef.loadshort(ppufile);
            iblongstringdef : hp:=tstringdef.loadlong(ppufile);
-{$ifdef ansistring_bits}
-         ibansistring16def : hp:=tstringdef.loadansi(ppufile,sb_16);
-         ibansistring32def : hp:=tstringdef.loadansi(ppufile,sb_32);
-         ibansistring64def : hp:=tstringdef.loadansi(ppufile,sb_64);
-{$else}
            ibansistringdef : hp:=tstringdef.loadansi(ppufile);
-{$endif}
            ibwidestringdef : hp:=tstringdef.loadwide(ppufile);
                ibrecorddef : hp:=trecorddef.ppuload(ppufile);
                ibobjectdef : hp:=tobjectdef.ppuload(ppufile);
@@ -331,6 +325,7 @@ implementation
              ibclassrefdef : hp:=tclassrefdef.ppuload(ppufile);
                ibformaldef : hp:=tformaldef.ppuload(ppufile);
               ibvariantdef : hp:=tvariantdef.ppuload(ppufile);
+            ibundefineddef : hp:=tundefineddef.ppuload(ppufile);
                  ibenddefs : break;
                      ibend : Message(unit_f_ppu_read_error);
            else
@@ -1672,7 +1667,12 @@ implementation
                   objects
                   parameters
               }
-              if not(srsymtable.symtabletype in [recordsymtable,objectsymtable,parasymtable]) then
+              if not(srsymtable.symtabletype in [recordsymtable,objectsymtable,parasymtable]) or
+                 (assigned(srsymtable.defowner) and
+                  (
+                   (df_generic in tdef(srsymtable.defowner).defoptions) or
+                   (df_specialization in tdef(srsymtable.defowner).defoptions))
+                  ) then
                 begin
                   srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
                   if assigned(srsym) and

compiler/tokens.pas

@@ -78,6 +78,8 @@ type
     _CCHAR,
     _CWSTRING,
     _CWCHAR,
+    _LSHARPBRACKET,
+    _RSHARPBRACKET,
     { C like operators }
     _PLUSASN,
     _MINUSASN,
@@ -177,6 +179,7 @@ type
     _EXPORTS,
     _FINALLY,
     _FORWARD,
+    _GENERIC,
     _IOCHECK,
     _LIBRARY,
     _MESSAGE,
@@ -225,6 +228,7 @@ type
     _INTERNPROC,
     _OLDFPCCALL,
     _OPENSTRING,
+    _SPECIALIZE,
     _CONSTRUCTOR,
     _INTERNCONST,
     _REINTRODUCE,
@@ -318,6 +322,8 @@ const
       (str:'const char'    ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'const wstring' ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'const wchar'   ;special:true ;keyword:m_none;op:NOTOKEN),
+      (str:'<'             ;special:true ;keyword:m_none;op:NOTOKEN),
+      (str:'>'             ;special:true ;keyword:m_none;op:NOTOKEN),
     { C like operators }
       (str:'+='            ;special:true ;keyword:m_none;op:NOTOKEN),
       (str:'-='            ;special:true ;keyword:m_none;op:NOTOKEN),
@@ -417,6 +423,7 @@ const
       (str:'EXPORTS'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'FINALLY'       ;special:false;keyword:m_class;op:NOTOKEN),
       (str:'FORWARD'       ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'GENERIC'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'IOCHECK'       ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'LIBRARY'       ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'MESSAGE'       ;special:false;keyword:m_none;op:NOTOKEN),
@@ -465,6 +472,7 @@ const
       (str:'INTERNPROC'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OLDFPCCALL'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'OPENSTRING'    ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'SPECIALIZE'    ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'CONSTRUCTOR'   ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'INTERNCONST'   ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'REINTRODUCE'   ;special:false;keyword:m_none;op:NOTOKEN),

compiler/utils/ppudump.pp

@@ -748,33 +748,85 @@ end;
 procedure readcommondef(const s:string);
 type
   tdefoption=(df_none,
-    df_has_inittable,           { init data has been generated }
-    df_has_rttitable,           { rtti data has been generated }
-    df_unique
+    { init data has been generated }
+    df_has_inittable,
+    { rtti data has been generated }
+    df_has_rttitable,
+    { type is unique, i.e. declared with type = type <tdef>; }
+    df_unique,
+    { type is a generic }
+    df_generic,
+    { type is a specialization of a generic type }
+    df_specialization
   );
   tdefoptions=set of tdefoption;
+  tdefopt=record
+    mask : tdefoption;
+    str  : string[30];
+  end;
+const
+  defopts=5;
+  defopt : array[1..defopts] of tdefopt=(
+     (mask:df_has_inittable;  str:'InitTable'),
+     (mask:df_has_rttitable;  str:'RTTITable'),
+     (mask:df_unique;         str:'Unique Type'),
+     (mask:df_generic;        str:'Generic'),
+     (mask:df_specialization; str:'Specialization')
+  );
 var
-  defopts : tdefoptions;
+  defoptions : tdefoptions;
+  i      : longint;
+  first  : boolean;
+  tokenbufsize : longint;
+  tokenbuf : pointer;
 begin
   writeln(space,'** Definition Nr. ',ppufile.getword,' **');
   writeln(space,s);
   write  (space,'      Type symbol : ');
   readderef;
-  ppufile.getsmallset(defopts);
+  write  (space,'       DefOptions : ');
+  ppufile.getsmallset(defoptions);
+  if defoptions<>[] then
+    begin
+      first:=true;
+      for i:=1to defopts do
+       if (defopt[i].mask in defoptions) then
+        begin
+          if first then
+            first:=false
+          else
+            write(', ');
+          write(defopt[i].str);
+        end;
+    end;
+  writeln;
 
-  if df_unique in defopts then
+  if df_unique in defoptions then
     writeln  (space,'      Unique type symbol');
 
-  if df_has_rttitable in defopts then
-   begin
-     write  (space,'      RTTI symbol : ');
-     readderef;
-   end;
-  if df_has_inittable in defopts then
-   begin
-     write  (space,'      Init symbol : ');
-     readderef;
-   end;
+  if df_has_rttitable in defoptions then
+    begin
+      write  (space,'      RTTI symbol : ');
+      readderef;
+    end;
+  if df_has_inittable in defoptions then
+    begin
+      write  (space,'      Init symbol : ');
+      readderef;
+    end;
+  if df_generic in defoptions then
+    begin
+      tokenbufsize:=ppufile.getlongint;
+      writeln(space,' Tokenbuffer size : ',tokenbufsize);
+      tokenbuf:=allocmem(tokenbufsize);
+      ppufile.getdata(tokenbuf^,tokenbufsize);
+      freemem(tokenbuf);
+    end;
+  if df_specialization in defoptions then
+    begin
+      write  (space,' Orig. GenericDef : ');
+      readderef;
+    end;
 end;
 
 
@@ -1680,7 +1732,10 @@ begin
            end;
 
          ibformaldef :
-           readcommondef('Generic Definition (void-typ)');
+           readcommondef('Generic definition (void-typ)');
+
+         ibundefineddef :
+           readcommondef('Undefined definition (generic parameter)');
 
          ibenumdef :
            begin

tests/test/tgeneric1.pp

@@ -0,0 +1,35 @@
+{$mode objfpc}
+
+type
+   TList=generic(_T) class(TObject)
+     data : _T;
+     procedure Add(item: _T);
+   end;
+
+procedure TList.Add(item: _T);
+begin
+  data:=item;
+end;
+
+type
+  TMyIntList = specialize TList(integer);
+  TMyStringList = specialize TList(string);
+
+var
+  ilist : TMyIntList;
+  slist : TMyStringList;
+  someInt : integer;
+begin
+  someInt:=10;
+  ilist := TMyIntList.Create;
+  ilist.Add(someInt);
+  writeln(ilist.data);
+  if ilist.data<>10 then
+    halt(1);
+
+  slist := TMyStringList.Create;
+  slist.Add('Test');
+  writeln(slist.data);
+  if slist.data<>'Test' then
+    halt(1);
+end.

tests/test/tgeneric2.pp

@@ -0,0 +1,29 @@
+{ %fail }
+
+{$mode objfpc}
+
+type
+   TList=generic(_T) class(TObject)
+     data : _T;
+     procedure Add(item: _T);
+   end;
+
+procedure TList.Add(item: _T);
+var
+  i : integer;
+begin
+  { The next line should fail for TList(string) }
+  i:=item;
+  data:=item;
+end;
+
+type
+  TMyStringList = specialize TList(string);
+
+var
+  slist : TMyStringList;
+begin
+  slist := TMyStringList.Create;
+  slist.Add('Test');
+  writeln(slist.data);
+end.

tests/test/tgeneric3.pp

@@ -0,0 +1,12 @@
+uses ugeneric3;
+
+type
+  TMyStringList = specialize TList(string);
+
+var
+  slist : TMyStringList;
+begin
+  slist := TMyStringList.Create;
+  slist.Add('Test');
+  writeln(slist.data);
+end.

tests/test/tgeneric4.pp

@@ -0,0 +1,19 @@
+uses ugeneric4;
+
+procedure LocalFill;
+begin
+  globaldata:='Program';
+end;
+
+type
+  TMyStringList = specialize TList(string);
+
+var
+  slist : TMyStringList;
+begin
+  slist := TMyStringList.Create;
+  slist.Fill;
+  writeln(slist.data);
+  if slist.data<>'Program' then
+    halt(1);
+end.

tests/test/tgeneric5.pp

@@ -0,0 +1,53 @@
+{$mode objfpc}
+
+uses
+  typinfo;
+
+type
+   TList=generic(_T) class(TObject)
+     data : _T;
+     procedure Add(item: _T);
+   end;
+
+var
+  err : boolean;
+
+procedure TList.Add(item: _T);
+var
+  i : integer;
+  p : pointer;
+begin
+  i:=item;
+  if item=i then;
+  p:=typeinfo(_T);
+  if p<>typeinfo(integer) then
+    begin
+      writeln('Typeinfo error');
+      err:=true;
+    end;
+  if sizeof(item)<>4 then
+    begin
+      writeln('Sizeof error');
+      err:=true;
+    end;
+end;
+
+type
+  TMyIntList = specialize TList(integer);
+
+var
+  ilist : TMyIntList;
+  someInt : integer;
+begin
+  someInt:=10;
+  ilist := TMyIntList.Create;
+  ilist.Add(someInt);
+  writeln(ilist.data);
+  if ilist.data<>10 then
+    err:=true;
+  if err then
+    begin
+      writeln('ERROR!');
+      halt(1);
+    end;
+end.

tests/test/ugeneric3.pp

@@ -0,0 +1,20 @@
+unit ugeneric3;
+
+interface
+
+{$mode objfpc}
+
+type
+   TList=generic(_T) class(TObject)
+     data : _T;
+     procedure Add(item: _T);
+   end;
+
+implementation
+
+procedure TList.Add(item: _T);
+begin
+  data:=item;
+end;
+
+end.

tests/test/ugeneric4.pp

@@ -0,0 +1,30 @@
+unit ugeneric4;
+
+interface
+
+{$mode objfpc}
+
+type
+   TList=generic(_T) class(TObject)
+     data : _T;
+     procedure Fill;
+   end;
+
+var
+  globaldata : string;
+
+implementation
+
+procedure LocalFill;
+begin
+  globaldata:='Unit';
+end;
+
+
+procedure TList.Fill;
+begin
+  LocalFill;
+  data:=globaldata;
+end;
+
+end.