瀏覽代碼

* fix for Mantis #30939: Rework generation of the generic name to be less relying on the type hierarchy as a specialization inside the parameter declaration would want to have the full name of the procdef including its parameters, but those are still parsed at that stage (the pretty name is still a topic onto itself however...)
+ added tests (original test was only mode fpc, test for mode delphi is added as well)

git-svn-id: trunk@35010 -

svenbarth 8 年之前
父節點
當前提交
a535d54bcb
共有 5 個文件被更改,包括 69 次插入11 次删除
  1. 2 0
      .gitattributes
  2. 6 2
      compiler/pdecsub.pas
  3. 15 9
      compiler/pgenutil.pas
  4. 23 0
      tests/webtbs/tw30939a.pp
  5. 23 0
      tests/webtbs/tw30939b.pp

+ 2 - 0
.gitattributes

@@ -15271,6 +15271,8 @@ tests/webtbs/tw30936.pp svneol=native#text/pascal
 tests/webtbs/tw30936a.pp svneol=native#text/pascal
 tests/webtbs/tw30936a.pp svneol=native#text/pascal
 tests/webtbs/tw30936b.pp svneol=native#text/pascal
 tests/webtbs/tw30936b.pp svneol=native#text/pascal
 tests/webtbs/tw30936c.pp svneol=native#text/pascal
 tests/webtbs/tw30936c.pp svneol=native#text/pascal
+tests/webtbs/tw30939a.pp svneol=native#text/pascal
+tests/webtbs/tw30939b.pp svneol=native#text/pascal
 tests/webtbs/tw30948.pp svneol=native#text/plain
 tests/webtbs/tw30948.pp svneol=native#text/plain
 tests/webtbs/tw30978.pp svneol=native#text/pascal
 tests/webtbs/tw30978.pp svneol=native#text/pascal
 tests/webtbs/tw30978a.pp svneol=native#text/pascal
 tests/webtbs/tw30978a.pp svneol=native#text/pascal

+ 6 - 2
compiler/pdecsub.pas

@@ -771,11 +771,12 @@ implementation
             error : boolean;
             error : boolean;
             genname,
             genname,
             ugenname : tidstring;
             ugenname : tidstring;
+            module : tmodule;
           begin
           begin
             result:=false;
             result:=false;
             if not assigned(genericparams) then
             if not assigned(genericparams) then
               exit;
               exit;
-            specializename:='';
+            specializename:='$';
             prettyname:='';
             prettyname:='';
             error:=false;
             error:=false;
             for i:=0 to genericparams.count-1 do
             for i:=0 to genericparams.count-1 do
@@ -794,7 +795,10 @@ implementation
                     error:=true;
                     error:=true;
                     continue;
                     continue;
                   end;
                   end;
-                specializename:=specializename+'$'+ttypesym(typesrsym).typedef.fulltypename;
+                module:=find_module_from_symtable(ttypesym(typesrsym).typedef.owner);
+                if not assigned(module) then
+                  internalerror(2016112803);
+                specializename:=specializename+'_$'+hexstr(module.moduleid,8)+'$$'+ttypesym(typesrsym).typedef.unique_id_str;
                 if i>0 then
                 if i>0 then
                   prettyname:=prettyname+',';
                   prettyname:=prettyname+',';
                 prettyname:=prettyname+ttypesym(typesrsym).prettyname;
                 prettyname:=prettyname+ttypesym(typesrsym).prettyname;

+ 15 - 9
compiler/pgenutil.pas

@@ -295,6 +295,7 @@ uses
         tmpparampos : tfileposinfo;
         tmpparampos : tfileposinfo;
         namepart : string;
         namepart : string;
         prettynamepart : ansistring;
         prettynamepart : ansistring;
+        module : tmodule;
       begin
       begin
         result:=true;
         result:=true;
         if genericdeflist=nil then
         if genericdeflist=nil then
@@ -310,8 +311,12 @@ uses
         if assigned(parsedtype) then
         if assigned(parsedtype) then
           begin
           begin
             genericdeflist.Add(parsedtype);
             genericdeflist.Add(parsedtype);
-            specializename:='$'+parsedtype.fulltypename;
-            prettyname:=parsedtype.typesym.prettyname;
+            module:=find_module_from_symtable(parsedtype.owner);
+            if not assigned(module) then
+              internalerror(2016112801);
+            namepart:='_$'+hexstr(module.moduleid,8)+'$$'+parsedtype.unique_id_str;
+            specializename:='$'+namepart;
+            prettyname:=parsedtype.fullownerhierarchyname(true)+parsedtype.typesym.prettyname;
             if assigned(poslist) then
             if assigned(poslist) then
               begin
               begin
                 New(parampos);
                 New(parampos);
@@ -321,7 +326,7 @@ uses
           end
           end
         else
         else
           begin
           begin
-            specializename:='';
+            specializename:='$';
             prettyname:='';
             prettyname:='';
           end;
           end;
         while not (token in [_GT,_RSHARPBRACKET]) do
         while not (token in [_GT,_RSHARPBRACKET]) do
@@ -353,22 +358,23 @@ uses
                     else if (typeparam.resultdef.typ<>errordef) then
                     else if (typeparam.resultdef.typ<>errordef) then
                       begin
                       begin
                         genericdeflist.Add(typeparam.resultdef);
                         genericdeflist.Add(typeparam.resultdef);
+                        module:=find_module_from_symtable(typeparam.resultdef.owner);
+                        if not assigned(module) then
+                          internalerror(2016112802);
+                        namepart:='_$'+hexstr(module.moduleid,8)+'$$'+typeparam.resultdef.unique_id_str;
                         { we use the full name of the type to uniquely identify it }
                         { we use the full name of the type to uniquely identify it }
                         if (symtablestack.top.symtabletype=parasymtable) and
                         if (symtablestack.top.symtabletype=parasymtable) and
                             (symtablestack.top.defowner.typ=procdef) and
                             (symtablestack.top.defowner.typ=procdef) and
                             (typeparam.resultdef.owner=symtablestack.top) then
                             (typeparam.resultdef.owner=symtablestack.top) then
                           begin
                           begin
                             { special handling for specializations inside generic function declarations }
                             { special handling for specializations inside generic function declarations }
-                            namepart:=tdef(symtablestack.top.defowner).unique_id_str;
-                            namepart:='genproc'+namepart+'_'+tdef(symtablestack.top.defowner).fullownerhierarchyname(false)+'_'+tprocdef(symtablestack.top.defowner).procsym.realname+'_'+typeparam.resultdef.typename;
-                            prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(false)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
+                            prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
                           end
                           end
                         else
                         else
                           begin
                           begin
-                            namepart:=typeparam.resultdef.fulltypename;
-                            prettynamepart:=typeparam.resultdef.fullownerhierarchyname(false);
+                            prettynamepart:=typeparam.resultdef.fullownerhierarchyname(true);
                           end;
                           end;
-                        specializename:=specializename+'$'+namepart;
+                        specializename:=specializename+namepart;
                         if not first then
                         if not first then
                           prettyname:=prettyname+',';
                           prettyname:=prettyname+',';
                         prettyname:=prettyname+prettynamepart+typeparam.resultdef.typesym.prettyname;
                         prettyname:=prettyname+prettynamepart+typeparam.resultdef.typesym.prettyname;

+ 23 - 0
tests/webtbs/tw30939a.pp

@@ -0,0 +1,23 @@
+{ %NORUN }
+
+program tw30939a;
+
+{$MODESWITCH result}
+
+Type
+  generic TGData<T> = record
+    b: T
+  end;
+
+  generic TGWrapper<T> = record
+    a: specialize TGData<T>
+  end;
+
+generic Function DoSomething<T>: specialize TGWrapper<T>;
+  Begin
+    result.a.b := default(T)
+  End;
+
+Begin
+  specialize DoSomething<LongInt>;
+End.

+ 23 - 0
tests/webtbs/tw30939b.pp

@@ -0,0 +1,23 @@
+{ %NORUN }
+
+program tw30939a;
+
+{$MODE delphi}
+
+Type
+  TGData<T> = record
+    b: T
+  end;
+
+  TGWrapper<T> = record
+    a: TGData<T>
+  end;
+
+Function DoSomething<T>: TGWrapper<T>;
+  Begin
+    result.a.b := default(T)
+  End;
+
+Begin
+  DoSomething<LongInt>;
+End.