paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 04:48:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* 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...)

Browse Source 
+ 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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/tw30936b.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/tw30978.pp svneol=native#text/pascal
tests/webtbs/tw30978a.pp svneol=native#text/pascal

8
compiler/pdecsub.pas
View File

@ -771,11 +771,12 @@ implementation
error : boolean;
genname,
ugenname : tidstring;
module : tmodule;
begin
result:=false;
if not assigned(genericparams) then
exit;
specializename:='';
specializename:='$';
prettyname:='';
error:=false;
for i:=0 to genericparams.count-1 do
@ -794,7 +795,10 @@ implementation
error:=true;
continue;
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
prettyname:=prettyname+',';
prettyname:=prettyname+ttypesym(typesrsym).prettyname;

24
compiler/pgenutil.pas
View File

@ -295,6 +295,7 @@ uses
tmpparampos : tfileposinfo;
namepart : string;
prettynamepart : ansistring;
module : tmodule;
begin
result:=true;
if genericdeflist=nil then
@ -310,8 +311,12 @@ uses
if assigned(parsedtype) then
begin
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
begin
New(parampos);
@ -321,7 +326,7 @@ uses
end
else
begin
specializename:='';
specializename:='$';
prettyname:='';
end;
while not (token in [_GT,_RSHARPBRACKET]) do
@ -353,22 +358,23 @@ uses
else if (typeparam.resultdef.typ<>errordef) then
begin
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 }
if (symtablestack.top.symtabletype=parasymtable) and
(symtablestack.top.defowner.typ=procdef) and
(typeparam.resultdef.owner=symtablestack.top) then
begin
{ 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
else
begin
namepart:=typeparam.resultdef.fulltypename;
prettynamepart:=typeparam.resultdef.fullownerhierarchyname(false);
prettynamepart:=typeparam.resultdef.fullownerhierarchyname(true);
end;
specializename:=specializename+'$'+namepart;
specializename:=specializename+namepart;
if not first then
prettyname:=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.