* 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 -
This commit is contained in:
svenbarth 2016-11-28 18:16:49 +00:00
parent ee466b9a28
commit a535d54bcb
5 changed files with 69 additions and 11 deletions

2
.gitattributes vendored
View File

@ -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

View File

@ -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;

View File

@ -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; module:=find_module_from_symtable(parsedtype.owner);
prettyname:=parsedtype.typesym.prettyname; 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; prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
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;
end end
else else
begin begin
namepart:=typeparam.resultdef.fulltypename; prettynamepart:=typeparam.resultdef.fullownerhierarchyname(true);
prettynamepart:=typeparam.resultdef.fullownerhierarchyname(false);
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
tests/webtbs/tw30939a.pp Normal file
View File

@ -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
tests/webtbs/tw30939b.pp Normal file
View File

@ -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.