paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 06:49:13 +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 begin
if not assigned(def.typesym) then if not assigned(def.typesym) then
internalerror(2015041901); internalerror(2015041901);
result:='%"typ.'+def.fullownerhierarchyname+def.typesym.realname+'"' result:='%"typ.'+def.fullownerhierarchyname(false)+def.typesym.realname+'"'
end; end;

6
compiler/pgenutil.pas
View File

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

22
compiler/symdef.pas
View File

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

4
compiler/symtype.pas
View File

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