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

* added more options to format the result of tprocdef.fullprocname() via

Browse Source 
a new customprocname() method and tprocnameoption flags (add parameter
    names, add "function"/"procedure", add name of owning struct or not,
    don't add the "class" prefix for class methods)
   Reason: for internal use by the compiler so it can output the procdef
    into something that can be fed back to the parser for reuse (seems
    easier than manually constructing a new procdef, or duplicating it
    inside of another objectdef)

git-svn-id: branches/jvmbackend@18426 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:58:39 +00:00
parent b6bae1e2e7
commit 96b0ee0827
2 changed files with 66 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/ncal.pas
View File

@ -2399,7 +2399,7 @@ implementation
for i:=0 to tprocsym(sym).ProcdefList.Count-1 do for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
begin begin
pd:=tprocdef(tprocsym(sym).ProcdefList[i]); pd:=tprocdef(tprocsym(sym).ProcdefList[i]);
hs:=pd.procsym.name+pd.typename_paras(false); hs:=pd.procsym.name+pd.typename_paras([]);
j:=AbstractMethodsList.FindIndexOf(hs); j:=AbstractMethodsList.FindIndexOf(hs);
if j<>-1 then if j<>-1 then
AbstractMethodsList[j]:=pd AbstractMethodsList[j]:=pd

98
compiler/symdef.pas
View File

@ -414,6 +414,10 @@ interface
{ tabstractprocdef } { tabstractprocdef }
tprocnameoption = (pno_showhidden, pno_proctypeoption, pno_paranames,
pno_ownername, pno_noclassmarker);
tprocnameoptions = set of tprocnameoption;
tabstractprocdef = class(tstoreddef) tabstractprocdef = class(tstoreddef)
{ saves a definition to the return type } { saves a definition to the return type }
returndef : tdef; returndef : tdef;
@ -440,7 +444,7 @@ interface
procedure buildderef;override; procedure buildderef;override;
procedure deref;override; procedure deref;override;
procedure calcparas; procedure calcparas;
function typename_paras(showhidden:boolean): string; function typename_paras(pno: tprocnameoptions): string;
function is_methodpointer:boolean;virtual; function is_methodpointer:boolean;virtual;
function is_addressonly:boolean;virtual; function is_addressonly:boolean;virtual;
function no_self_node:boolean; function no_self_node:boolean;
@ -576,6 +580,7 @@ interface
function mangledname : string; function mangledname : string;
procedure setmangledname(const s : string); procedure setmangledname(const s : string);
function fullprocname(showhidden:boolean):string; function fullprocname(showhidden:boolean):string;
function customprocname(pno: tprocnameoptions):string;
function defaultmangledname: string; function defaultmangledname: string;
function cplusplusmangledname : string; function cplusplusmangledname : string;
function objcmangledname : string; function objcmangledname : string;
@ -3311,7 +3316,7 @@ implementation
end; end;
function tabstractprocdef.typename_paras(showhidden:boolean) : string; function tabstractprocdef.typename_paras(pno: tprocnameoptions) : string;
var var
hs,s : string; hs,s : string;
hp : TParavarsym; hp : TParavarsym;
@ -3325,7 +3330,7 @@ implementation
begin begin
hp:=tparavarsym(paras[i]); hp:=tparavarsym(paras[i]);
if not(vo_is_hidden_para in hp.varoptions) or if not(vo_is_hidden_para in hp.varoptions) or
(showhidden) then (pno_showhidden in pno) then
begin begin
if first then if first then
begin begin
@ -3346,6 +3351,8 @@ implementation
vs_constref : vs_constref :
s:=s+'constref '; s:=s+'constref ';
end; end;
if (pno_paranames in pno) then
s:=s+hp.realname+':';
if hp.univpara then if hp.univpara then
s:=s+'univ '; s:=s+'univ ';
if assigned(hp.vardef.typesym) then if assigned(hp.vardef.typesym) then
@ -3776,46 +3783,71 @@ implementation
function tprocdef.fullprocname(showhidden:boolean):string; function tprocdef.fullprocname(showhidden:boolean):string;
var
pno: tprocnameoptions;
begin
pno:=[];
if showhidden then
include(pno,pno_showhidden);
result:=customprocname(pno);
end;
function tprocdef.customprocname(pno: tprocnameoptions):string;
var var
s : string; s : string;
t : ttoken; t : ttoken;
begin begin
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
showhidden:=true; include(pno,pno_showhidden);
{$endif EXTDEBUG} {$endif EXTDEBUG}
s:=''; s:='';
if assigned(struct) then
begin
s:=struct.RttiName+'.';
if (po_classmethod in procoptions) and
not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
s:='class ' + s;
end;
if proctypeoption=potype_operator then if proctypeoption=potype_operator then
begin begin
for t:=NOTOKEN to last_overloaded do for t:=NOTOKEN to last_overloaded do
if procsym.realname='$'+overloaded_names[t] then if procsym.realname='$'+overloaded_names[t] then
begin begin
s:='operator '+arraytokeninfo[t].str+typename_paras(showhidden); s:='operator ';
if (pno_ownername in pno) and
assigned(struct) then
s:=s+struct.RttiName+'.';
s:=s+arraytokeninfo[t].str+typename_paras(pno);
break; break;
end; end;
end end
else else
s:=s+procsym.realname+typename_paras(showhidden); begin
case proctypeoption of if (po_classmethod in procoptions) and
potype_constructor: not(pno_noclassmarker in pno) and
s:='constructor '+s; not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
potype_destructor: s:='class ';
s:='destructor '+s; case proctypeoption of
potype_class_constructor: potype_constructor:
s:='class constructor '+s; s:=s+'constructor ';
potype_class_destructor: potype_destructor:
s:='class destructor '+s; s:=s+'destructor '+s;
else potype_class_constructor:
if assigned(returndef) and s:=s+'class constructor ';
not(is_void(returndef)) then potype_class_destructor:
s:=s+':'+returndef.GetTypeName; s:=s+'class destructor ';
end; else
if (pno_proctypeoption in pno) and
assigned(returndef) and
not(is_void(returndef)) then
s:=s+'function '
else
s:=s+'procedure ';
end;
if (pno_ownername in pno) and
(owner.symtabletype in [recordsymtable,objectsymtable]) then
s:=s+tabstractrecorddef(owner.defowner).RttiName+'.';
s:=s+procsym.realname+typename_paras(pno);
end;
if not(proctypeoption in [potype_constructor,potype_destructor,
potype_class_constructor,potype_class_destructor]) and
assigned(returndef) and
not(is_void(returndef)) then
s:=s+':'+returndef.GetTypeName;
if owner.symtabletype=localsymtable then if owner.symtabletype=localsymtable then
s:=s+' is nested'; s:=s+' is nested';
s:=s+';'; s:=s+';';
@ -3825,7 +3857,7 @@ implementation
if (po_staticmethod in procoptions) and if (po_staticmethod in procoptions) and
not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then
s:=s+' Static;'; s:=s+' Static;';
fullprocname:=s; customprocname:=s;
end; end;
@ -4441,12 +4473,12 @@ implementation
function tprocvardef.GetTypeName : string; function tprocvardef.GetTypeName : string;
var var
s: string; s: string;
showhidden : boolean; pno : tprocnameoptions;
begin begin
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
showhidden:=true; pno:=[pno_showhidden];
{$else EXTDEBUG} {$else EXTDEBUG}
showhidden:=false; pno:=[];
{$endif EXTDEBUG} {$endif EXTDEBUG}
s:='<'; s:='<';
if po_classmethod in procoptions then if po_classmethod in procoptions then
@ -4458,9 +4490,9 @@ implementation
s := s+'procedure variable type of'; s := s+'procedure variable type of';
if assigned(returndef) and if assigned(returndef) and
(returndef<>voidtype) then (returndef<>voidtype) then
s:=s+' function'+typename_paras(showhidden)+':'+returndef.GetTypeName s:=s+' function'+typename_paras(pno)+':'+returndef.GetTypeName
else else
s:=s+' procedure'+typename_paras(showhidden); s:=s+' procedure'+typename_paras(pno);
if po_methodpointer in procoptions then if po_methodpointer in procoptions then
s := s+' of object'; s := s+' of object';
if is_nested_pd(self) then if is_nested_pd(self) then