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

* extend tdef.fullownerhierarchyname() with a parameter that skips the inclusion of a procdef's parameter declaration using the new pno_noparams option

Browse Source 
git-svn-id: trunk@35009 -
This commit is contained in:
svenbarth 2016-11-28 18:06:35 +00:00
parent 930070a8ca
commit ee466b9a28
4 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/llvm/llvmdef.pas
View File

@ -129,7 +129,7 @@ implementation
begin
if not assigned(def.typesym) then
internalerror(2015041901);
result:='%"typ.'+def.fullownerhierarchyname+def.typesym.realname+'"'
result:='%"typ.'+def.fullownerhierarchyname(false)+def.typesym.realname+'"'
end;

6
compiler/pgenutil.pas
View File

@ -360,13 +360,13 @@ uses
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+'_'+tprocdef(symtablestack.top.defowner).procsym.realname+'_'+typeparam.resultdef.typename;
prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname+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
else
begin
namepart:=typeparam.resultdef.fulltypename;
prettynamepart:=typeparam.resultdef.fullownerhierarchyname;
prettynamepart:=typeparam.resultdef.fullownerhierarchyname(false);
end;
specializename:=specializename+'$'+namepart;
if not first then

22
compiler/symdef.pas
View File

@ -114,7 +114,7 @@ interface
function needs_inittable : boolean;override;
function rtti_mangledname(rt:trttitype):TSymStr;override;
function OwnerHierarchyName: string; override;
function fullownerhierarchyname:TSymStr;override;
function fullownerhierarchyname(skipprocparams:boolean):TSymStr;override;
function needs_separate_initrtti:boolean;override;
function in_currentunit: boolean;
{ regvars }
@ -1892,16 +1892,17 @@ implementation
until tmp=nil;
end;
function tstoreddef.fullownerhierarchyname: TSymStr;
function tstoreddef.fullownerhierarchyname(skipprocparams:boolean): TSymStr;
var
lastowner: tsymtable;
tmp: tdef;
pno: tprocnameoptions;
begin
{$ifdef symansistr}
if _fullownerhierarchyname<>'' then
if not skipprocparams and (_fullownerhierarchyname<>'') then
exit(_fullownerhierarchyname);
{$else symansistr}
if assigned(_fullownerhierarchyname) then
if not skipprocparams and assigned(_fullownerhierarchyname) then
exit(_fullownerhierarchyname^);
{$endif symansistr}
{ the def can only reside inside structured types or
@ -1921,16 +1922,23 @@ implementation
result:=tabstractrecorddef(tmp).objrealname^+'.'+result
else
if tmp.typ=procdef then
result:=tprocdef(tmp).customprocname([pno_paranames,pno_proctypeoption])+'.'+result;
begin
pno:=[pno_paranames,pno_proctypeoption];
if skipprocparams then
include(pno,pno_noparams);
result:=tprocdef(tmp).customprocname(pno)+'.'+result;
end;
until tmp=nil;
{ add the unit name }
if assigned(lastowner) and
assigned(lastowner.realname) then
result:=lastowner.realname^+'.'+result;
if not skipprocparams then
{ don't store the name in this case }
{$ifdef symansistr}
_fullownerhierarchyname:=result;
_fullownerhierarchyname:=result;
{$else symansistr}
_fullownerhierarchyname:=stringdup(result);
_fullownerhierarchyname:=stringdup(result);
{$endif symansistr}
end;

4
compiler/symtype.pas
View File

@ -75,7 +75,7 @@ interface
function getmangledparaname:TSymStr;virtual;
function rtti_mangledname(rt:trttitype):TSymStr;virtual;abstract;
function OwnerHierarchyName: string; virtual; abstract;
function fullownerhierarchyname:TSymStr;virtual;abstract;
function fullownerhierarchyname(skipprocparams:boolean):TSymStr;virtual;abstract;
function unique_id_str: string;
function size:asizeint;virtual;abstract;
function packedbitsize:asizeint;virtual;
@ -296,7 +296,7 @@ implementation
function tdef.fulltypename:string;
begin
result:=fullownerhierarchyname;
result:=fullownerhierarchyname(false);
if assigned(typesym) and
not(typ in [procvardef,procdef]) and
(typesym.realname[1]<>'$') then