compiler: implement generic array type:

  - add tarraysymtable to store generic type symbols
  - process generic and specialize declarations similar to generic records and classes
  - fix insert_generic_parameter_types to use def passed in argument instead of current_structdef because generic array type can't be assigned to the current_structdef variable
  - increase ppu version because of arraydef changes
  - tests

git-svn-id: trunk@16681 -

.gitattributes

@@ -8009,7 +8009,6 @@ tests/tbf/tb0184.pp svneol=native#text/plain
 tests/tbf/tb0185.pp svneol=native#text/plain
 tests/tbf/tb0186.pp svneol=native#text/plain
 tests/tbf/tb0187.pp svneol=native#text/plain
-tests/tbf/tb0188.pp svneol=native#text/plain
 tests/tbf/tb0189.pp svneol=native#text/plain
 tests/tbf/tb0190.pp svneol=native#text/plain
 tests/tbf/tb0191.pp svneol=native#text/plain
@@ -8239,6 +8238,7 @@ tests/tbs/tb0185.pp svneol=native#text/plain
 tests/tbs/tb0186.pp svneol=native#text/plain
 tests/tbs/tb0187.pp svneol=native#text/plain
 tests/tbs/tb0188.pp svneol=native#text/plain
+tests/tbs/tb0188a.pp svneol=native#text/plain
 tests/tbs/tb0189.pp svneol=native#text/plain
 tests/tbs/tb0190.pp svneol=native#text/plain
 tests/tbs/tb0191.pp svneol=native#text/plain
@@ -9413,6 +9413,7 @@ tests/test/tgeneric21.pp svneol=native#text/pascal
 tests/test/tgeneric22.pp svneol=native#text/pascal
 tests/test/tgeneric23.pp svneol=native#text/pascal
 tests/test/tgeneric24.pp svneol=native#text/pascal
+tests/test/tgeneric25.pp svneol=native#text/pascal
 tests/test/tgeneric3.pp svneol=native#text/plain
 tests/test/tgeneric4.pp svneol=native#text/plain
 tests/test/tgeneric5.pp svneol=native#text/plain

compiler/pdecl.pas

@@ -681,7 +681,7 @@ implementation
               end;
             end;
 
-           if isgeneric and not(hdef.typ in [objectdef,recorddef]) then
+           if isgeneric and not(hdef.typ in [objectdef,recorddef,arraydef]) then
              message(parser_e_cant_create_generics_of_this_type);
 
            { Stop recording a generic template }

compiler/pdecobj.pas

@@ -37,7 +37,7 @@ interface
     function constructor_head:tprocdef;
     function destructor_head:tprocdef;
     procedure struct_property_dec(is_classproperty:boolean);
-    procedure insert_generic_parameter_types(genericdef:tstoreddef;genericlist:TFPObjectList);
+    procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
 
 implementation
 
@@ -534,22 +534,31 @@ implementation
       end;
 
 
-    procedure insert_generic_parameter_types(genericdef:tstoreddef;genericlist:TFPObjectList);
+    procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
       var
-        i : longint;
-        generictype : ttypesym;
+        i: longint;
+        generictype: ttypesym;
+        st: tsymtable;
       begin
-        current_structdef.genericdef:=genericdef;
+        def.genericdef:=genericdef;
         if not assigned(genericlist) then
           exit;
+
+        case def.typ of
+          recorddef,objectdef: st:=tabstractrecorddef(def).symtable;
+          arraydef: st:=tarraydef(def).symtable;
+          else
+            internalerror(201101020);
+        end;
+
         for i:=0 to genericlist.count-1 do
           begin
             generictype:=ttypesym(genericlist[i]);
             if generictype.typedef.typ=undefineddef then
-              include(current_structdef.defoptions,df_generic)
+              include(def.defoptions,df_generic)
             else
-              include(current_structdef.defoptions,df_specialization);
-            symtablestack.top.insert(generictype);
+              include(def.defoptions,df_specialization);
+            st.insert(generictype);
           end;
        end;
 
@@ -1057,7 +1066,7 @@ implementation
             parse_guid;
 
             symtablestack.push(current_structdef.symtable);
-            insert_generic_parameter_types(genericdef,genericlist);
+            insert_generic_parameter_types(current_structdef,genericdef,genericlist);
             { parse and insert object members }
             parse_object_members;
             symtablestack.pop(current_structdef.symtable);

compiler/pexpr.pas

@@ -1395,7 +1395,7 @@ implementation
                if typeonly then
                  searchsym_type(pattern,srsym,srsymtable)
                else
-               searchsym(pattern,srsym,srsymtable);
+                 searchsym(pattern,srsym,srsymtable);
 
                { handle unit specification like System.Writeln }
                unit_found:=try_consume_unitsym(srsym,srsymtable,t);

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 125;
+  CurrentPPUVersion = 126;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/ptype.pas

@@ -200,14 +200,16 @@ implementation
         first:=true;
         generictypelist:=TFPObjectList.create(false);
         case genericdef.typ of
-          procdef :
+          procdef:
             st:=genericdef.GetSymtable(gs_para);
           objectdef,
-          recorddef :
+          recorddef:
             st:=genericdef.GetSymtable(gs_record);
+          arraydef:
+            st:=tarraydef(genericdef).symtable;
+          else
+            internalerror(200511182);
         end;
-        if not assigned(st) then
-          internalerror(200511182);
 
         { Parse type parameters }
         if not assigned(genericdef.typesym) then
@@ -866,7 +868,7 @@ implementation
          else if assigned(genericlist) then
            current_genericdef:=current_structdef;
 
-         insert_generic_parameter_types(genericdef,genericlist);
+         insert_generic_parameter_types(current_structdef,genericdef,genericlist);
          parse_generic:=(df_generic in current_structdef.defoptions);
          if m_advanced_records in current_settings.modeswitches then
            parse_record_members
@@ -1098,7 +1100,17 @@ implementation
             end;
           end;
 
+        var
+          old_current_genericdef,
+          old_current_specializedef: tstoreddef;
+          old_parse_generic: boolean;
         begin
+           old_current_genericdef:=current_genericdef;
+           old_current_specializedef:=current_specializedef;
+           old_parse_generic:=parse_generic;
+
+           current_genericdef:=nil;
+           current_specializedef:=nil;
            arrdef:=nil;
            consume(_ARRAY);
            { open array? }
@@ -1194,16 +1206,33 @@ implementation
                 include(arrdef.arrayoptions,ado_IsDynamicArray);
                 def:=arrdef;
              end;
+           if assigned(arrdef) then
+             begin
+               { usage of specialized type inside its generic template }
+               if assigned(genericdef) then
+                 current_specializedef:=arrdef
+               { reject declaration of generic class inside generic class }
+               else if assigned(genericlist) then
+                 current_genericdef:=arrdef;
+               symtablestack.push(arrdef.symtable);
+               insert_generic_parameter_types(arrdef,genericdef,genericlist);
+               parse_generic:=(df_generic in arrdef.defoptions);
+             end;
            consume(_OF);
            read_anon_type(tt2,true);
            { set element type of the last array definition }
            if assigned(arrdef) then
              begin
+               symtablestack.pop(arrdef.symtable);
                arrdef.elementdef:=tt2;
                if is_packed and
                   is_managed_type(tt2) then
                  Message(type_e_no_packed_inittable);
              end;
+           { restore old state }
+           parse_generic:=old_parse_generic;
+           current_genericdef:=old_current_genericdef;
+           current_specializedef:=old_current_specializedef;
         end;
 
       var
@@ -1225,7 +1254,7 @@ implementation
            _LKLAMMER:
               begin
                 consume(_LKLAMMER);
-                first := true;
+                first:=true;
                 { allow negativ value_str }
                 l:=int64(-1);
                 enumdupmsg:=false;
@@ -1273,7 +1302,7 @@ implementation
                     end
                   else
                     inc(l.svalue);
-                  first := false;
+                  first:=false;
                   storepos:=current_tokenpos;
                   current_tokenpos:=defpos;
                   tenumsymtable(aktenumdef.symtable).insert(tenumsym.create(s,aktenumdef,longint(l.svalue)));

compiler/symconst.pas

@@ -447,7 +447,9 @@ type
     stt_excepTSymtable,    { try/except symtable             }
     exportedmacrosymtable, { }
     localmacrosymtable,    { }
-    enumsymtable           { symtable for enum members       }
+    enumsymtable,          { symtable for enum members       }
+    arraysymtable          { used to store parameterised type
+                             in array                        }
   );
 
 

compiler/symdef.pas

@@ -349,6 +349,7 @@ interface
           rangedef      : tdef;
           rangedefderef : tderef;
           arrayoptions  : tarraydefoptions;
+          symtable      : TSymtable;
        protected
           _elementdef      : tdef;
           _elementdefderef : tderef;
@@ -360,6 +361,7 @@ interface
           constructor create_from_pointer(def:tdef);
           constructor create(l,h:aint;def:tdef);
           constructor ppuload(ppufile:tcompilerppufile);
+          destructor destroy; override;
           function getcopy : tstoreddef;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function  GetTypeName:string;override;
@@ -2338,8 +2340,15 @@ implementation
          rangedef:=def;
          _elementdef:=nil;
          arrayoptions:=[];
+         symtable:=tarraysymtable.create(self);
       end;
 
+    destructor tarraydef.destroy;
+      begin
+        symtable.free;
+        symtable:=nil;
+        inherited;
+      end;
 
     constructor tarraydef.create_from_pointer(def:tdef);
       begin
@@ -2359,6 +2368,8 @@ implementation
          lowrange:=ppufile.getaint;
          highrange:=ppufile.getaint;
          ppufile.getsmallset(arrayoptions);
+         symtable:=tarraysymtable.create(self);
+         tarraysymtable(symtable).ppuload(ppufile)
       end;
 
 
@@ -2373,6 +2384,7 @@ implementation
     procedure tarraydef.buildderef;
       begin
         inherited buildderef;
+        tarraysymtable(symtable).buildderef;
         _elementdefderef.build(_elementdef);
         rangedefderef.build(rangedef);
       end;
@@ -2381,6 +2393,7 @@ implementation
     procedure tarraydef.deref;
       begin
         inherited deref;
+        tarraysymtable(symtable).deref;
         _elementdef:=tdef(_elementdefderef.resolve);
         rangedef:=tdef(rangedefderef.resolve);
       end;
@@ -2395,6 +2408,7 @@ implementation
          ppufile.putaint(highrange);
          ppufile.putsmallset(arrayoptions);
          ppufile.writeentry(ibarraydef);
+         tarraysymtable(symtable).ppuwrite(ppufile);
       end;
 
 

compiler/symtable.pas

@@ -183,6 +183,14 @@ interface
           constructor create(adefowner:tdef);
        end;
 
+       { tarraysymtable }
+
+       tarraysymtable = class(tstoredsymtable)
+       public
+          procedure insertdef(def:TDefEntry);override;
+          constructor create(adefowner:tdef);
+       end;
+
     var
        systemunit     : tglobalsymtable; { pointer to the system unit }
 
@@ -1622,6 +1630,27 @@ implementation
         defowner:=adefowner;
       end;
 
+{****************************************************************************
+                          TArraySymtable
+****************************************************************************}
+
+    procedure tarraysymtable.insertdef(def: TDefEntry);
+      begin
+        { Enums must also be available outside the record scope,
+          insert in the owner of this symtable }
+        if def.typ=enumdef then
+          defowner.owner.insertdef(def)
+        else
+          inherited insertdef(def);
+      end;
+
+    constructor tarraysymtable.create(adefowner: tdef);
+      begin
+        inherited Create('');
+        symtabletype:=arraysymtable;
+        defowner:=adefowner;
+      end;
+
 {*****************************************************************************
                              Helper Routines
 *****************************************************************************}

compiler/symtype.pas

@@ -228,6 +228,7 @@ implementation
               end;
             recordsymtable,
             enumsymtable,
+            arraysymtable,
             localsymtable,
             parasymtable,
             ObjectSymtable :

tests/tbf/tb0188.pp → tests/tbs/tb0188a.pp

@@ -1,8 +1,10 @@
-{ %fail }
 {$mode objfpc}
 
 type
   generic TMyArray<T> = array[0..10] of longint;
 
+var
+  MyArr: specialize TMyArray<String>;
 begin
+  MyArr[0] := 1;
 end.

tests/test/tgeneric25.pp

@@ -0,0 +1,34 @@
+program tgeneric25;
+
+{$mode objfpc}{$H+}
+
+type
+  generic TArr<T> = array[0..2] of T;
+  generic TDynamicArr<T> = array of T;
+  generic TRecArr<T> = array[0..1] of record
+    A: T;
+    B: String;
+  end;
+
+var
+  ArrInt: specialize TArr<Integer>;
+  ArrStr: specialize TArr<String>;
+  DynArrInt: specialize TDynamicArr<Integer>;
+  RecArr: specialize TRecArr<Integer>;
+begin
+  ArrInt[0] := 1;
+  ArrStr[0] := '1';
+  SetLength(DynArrInt, 1);
+  DynArrInt[0] := 2;
+  RecArr[0].A := 3;
+  RecArr[0].B := '3';
+  if ArrInt[0] <> 1 then
+    halt(1);
+  if ArrStr[0] <> '1' then
+    halt(2);
+  if DynArrInt[0] <> 2 then
+    halt(3);
+  if RecArr[0].A <> 3 then
+    halt(4);
+end.
+