Correctly specialize generics if locally declared types are used (e.g. two procedures could both define a different "TRec" type which is used to specialize a generic inside the procedures).

symtype.pas, tdef:
  + add method "fullownerhierarchyname" which allows to retrieve the owner hierarchy name including procedure/function/method names
  + add method "fulltypename" which uses "fullownerhierarchyname" to return a full type name
symdef.pas, tstoreddef:
  * implement "fullownerhierarchyname" (including caching of the result)
pgenutil.pas, parse_generic_specialization_types_internal:
  * use "tdef.fulltypename" instead of "tdef.typename" to have unique values for each parsed type and thus for the specialization itself

+ tests

git-svn-id: trunk@25175 -

.gitattributes

@@ -11253,6 +11253,8 @@ tests/test/tgeneric90.pp svneol=native#text/pascal
 tests/test/tgeneric91.pp svneol=native#text/pascal
 tests/test/tgeneric92.pp svneol=native#text/pascal
 tests/test/tgeneric93.pp svneol=native#text/pascal
+tests/test/tgeneric94.pp svneol=native#text/pascal
+tests/test/tgeneric95.pp svneol=native#text/pascal
 tests/test/tgoto.pp svneol=native#text/plain
 tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain

compiler/pgenutil.pas

@@ -278,7 +278,7 @@ uses
         if assigned(parsedtype) then
           begin
             genericdeflist.Add(parsedtype);
-            specializename:='$'+parsedtype.typename;
+            specializename:='$'+parsedtype.fulltypename;
             prettyname:=parsedtype.typesym.prettyname;
             if assigned(poslist) then
               begin
@@ -315,11 +315,11 @@ uses
                   message(type_e_generics_cannot_reference_itself)
                 else
                   begin
-                    specializename:=specializename+'$'+typeparam.resultdef.typename;
+                    { we use the full name of the type to uniquely identify it }
-                    if first then
+                    specializename:=specializename+'$'+typeparam.resultdef.fulltypename;
-                      prettyname:=prettyname+typeparam.resultdef.typesym.prettyname
+                    if not first then
-                    else
+                      prettyname:=prettyname+',';
-                      prettyname:=prettyname+','+typeparam.resultdef.typesym.prettyname;
+                    prettyname:=prettyname+typeparam.resultdef.fullownerhierarchyname+typeparam.resultdef.typesym.prettyname;
                   end;
               end
             else

compiler/symdef.pas

@@ -66,6 +66,8 @@ interface
        { tstoreddef }
 
        tstoreddef = class(tdef)
+       private
+          _fullownerhierarchyname : pshortstring;
        protected
           typesymderef  : tderef;
           procedure fillgenericparas(symtable:tsymtable);
@@ -100,6 +102,7 @@ interface
           function  needs_inittable : boolean;override;
           function  rtti_mangledname(rt:trttitype):string;override;
           function  OwnerHierarchyName: string; override;
+          function  fullownerhierarchyname:string;override;
           function  needs_separate_initrtti:boolean;override;
           function  in_currentunit: boolean;
           { regvars }
@@ -1532,6 +1535,7 @@ implementation
           end;
         genericparas.free;
         genconstraintdata.free;
+        stringdispose(_fullownerhierarchyname);
         inherited destroy;
       end;
 
@@ -1621,6 +1625,36 @@ implementation
         until tmp=nil;
       end;
 
+    function tstoreddef.fullownerhierarchyname: string;
+      var
+        tmp: tdef;
+      begin
+        if assigned(_fullownerhierarchyname) then
+          begin
+            result:=_fullownerhierarchyname^;
+            exit;
+          end;
+        { the def can only reside inside structured types or
+          procedures/functions/methods }
+        tmp:=self;
+        result:='';
+        repeat
+          { can be not assigned in case of a forwarddef }
+          if not assigned(tmp.owner) then
+            break
+          else
+            tmp:=tdef(tmp.owner.defowner);
+          if not assigned(tmp) then
+            break;
+          if tmp.typ in [recorddef,objectdef] then
+            result:=tabstractrecorddef(tmp).objrealname^+'.'+result
+          else
+            if tmp.typ=procdef then
+              result:=tprocdef(tmp).customprocname([pno_paranames,pno_proctypeoption])+'.'+result;
+        until tmp=nil;
+        _fullownerhierarchyname:=stringdup(result);
+      end;
+
 
     function tstoreddef.in_currentunit: boolean;
       var

compiler/symtype.pas

@@ -68,12 +68,14 @@ interface
          procedure deref;virtual;abstract;
          procedure derefimpl;virtual;abstract;
          function  typename:string;
+         function  fulltypename:string;
          function  GetTypeName:string;virtual;
          function  typesymbolprettyname:string;virtual;
          function  mangledparaname:string;
          function  getmangledparaname:TSymStr;virtual;
          function  rtti_mangledname(rt:trttitype):string;virtual;abstract;
          function  OwnerHierarchyName: string; virtual; abstract;
+         function  fullownerhierarchyname:string;virtual;abstract;
          function  size:asizeint;virtual;abstract;
          function  packedbitsize:asizeint;virtual;
          function  alignment:shortint;virtual;abstract;
@@ -274,11 +276,21 @@ implementation
           result:=result+GetTypeName;
       end;
 
+    function tdef.fulltypename:string;
+      begin
+        result:=fullownerhierarchyname;
+        if assigned(typesym) and
+           not(typ in [procvardef,procdef]) and
+           (typesym.realname[1]<>'$') then
+          result:=result+typesym.realname
+        else
+          result:=result+GetTypeName;
+      end;
+
 
     function tdef.GetTypeName : string;
       begin
-         GetTypeName:='<unknown type>'
+         GetTypeName:='<unknown type>'      end;
-      end;
 
 
     function tdef.typesymbolprettyname:string;

tests/test/tgeneric94.pp

@@ -0,0 +1,66 @@
+program tgeneric94;
+
+{$mode objfpc}
+
+type
+  generic TTest<T> = record
+    f: T;
+  end;
+
+  TRec = record
+    x, y: LongInt;
+  end;
+
+type
+  TTestTRec_Global = specialize TTest<TRec>;
+const
+  TRecSize_Global = SizeOf(TRec);
+
+procedure DoTest;
+type
+  TRec = packed record
+    a, b: Byte;
+  end;
+  TTestTRec_DoTest = specialize TTest<TRec>;
+const
+  TRecSize_DoTest = SizeOf(TRec);
+
+  procedure Nested(out aActual, aExpected: LongInt);
+  type
+    TRec = packed record
+      f1, f2: Word;
+    end;
+    TTestTRec_Nested = specialize TTest<TRec>;
+  const
+    TRecSize_Nested = SizeOf(TRec);
+  var
+    t: TTestTRec_Nested;
+  begin
+    aActual := SizeOf(t.f);
+    aExpected := TRecSize_Nested;
+  end;
+
+procedure DoError(const aMessage: String);
+begin
+  Writeln(aMessage);
+  ExitCode := 1;
+  Halt;
+end;
+
+var
+  tg: TTestTRec_Global;
+  tt: TTestTRec_DoTest;
+  act, expt: LongInt;
+begin
+  if SizeOf(tg.f) <> TRecSize_Global then
+    DoError('Unexpected size of global TRec');
+  if SizeOf(tt.f) <> TRecSize_DoTest then
+    DoError('Unexpected size of DoTest TRec');
+  Nested(act, expt);
+  if act <> expt then
+    DoError('Unexpected size of Nested TRec');
+end;
+
+begin
+  DoTest;
+end.

tests/test/tgeneric95.pp

@@ -0,0 +1,40 @@
+program tgeneric95;
+
+{$mode objfpc}
+
+type
+  generic TTest<T> = record
+    f: T;
+  end;
+
+function Test(aArg: Integer): Integer;
+type
+  TTest_Word = specialize TTest<Word>;
+var
+  t: TTest_Word;
+begin
+  Result := SizeOf(t.f);
+end;
+
+function Test(aArg: String): Integer;
+type
+  TTest_String = specialize TTest<String>;
+var
+  t: TTest_String;
+begin
+  Result := SizeOf(t.f);
+end;
+
+procedure DoError(const aMessage: String);
+begin
+  Writeln(aMessage);
+  ExitCode := 1;
+  Halt;
+end;
+
+begin
+  if Test(42) <> SizeOf(Word) then
+    DoError('Unexpected size of field');
+  if Test('Test') <> SizeOf(String) then
+    DoError('Unexpe size of field');
+end.