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

* let procdef typename-related routines return ansistrings instead of

Browse Source 
shortstrings to prevent cut-offs
  + ReplaceCase() ansistring overload in cutils to support the above
  * always use the fully qualified name in case of nested types inside
    the parameter lists of procdefs
  * put extra information about array parameters between {} so they
    can be passed back into the parser

git-svn-id: branches/jvmbackend@18431 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:59:02 +00:00
parent 0d9948a61b
commit c05bc8a931
2 changed files with 33 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
compiler/cutils.pas
View File

@ -59,6 +59,7 @@ interface
procedure Replace(var s:string;s1:string;const s2:string);
procedure Replace(var s:AnsiString;s1:string;const s2:AnsiString);
procedure ReplaceCase(var s:string;const s1,s2:string);
procedure ReplaceCase(var s:ansistring;const s1,s2:ansistring);
Function MatchPattern(const pattern,what:string):boolean;
function upper(const c : char) : char;
function upper(const s : string) : string;
@ -395,6 +396,26 @@ implementation
end;
procedure ReplaceCase(var s: ansistring; const s1, s2: ansistring);
var
last,
i : longint;
begin
last:=0;
repeat
i:=pos(s1,s);
if i=last then
i:=0;
if (i>0) then
begin
Delete(s,i,length(s1));
Insert(s2,s,i);
last:=i;
end;
until (i=0);
end;
Function MatchPattern(const pattern,what:string):boolean;
var
found : boolean;

23
compiler/symdef.pas
View File

@ -444,7 +444,7 @@ interface
procedure buildderef;override;
procedure deref;override;
procedure calcparas;
function typename_paras(pno: tprocnameoptions): string;
function typename_paras(pno: tprocnameoptions): ansistring;
function is_methodpointer:boolean;virtual;
function is_addressonly:boolean;virtual;
function no_self_node:boolean;
@ -580,7 +580,7 @@ interface
function mangledname : string;
procedure setmangledname(const s : string);
function fullprocname(showhidden:boolean):string;
function customprocname(pno: tprocnameoptions):string;
function customprocname(pno: tprocnameoptions):ansistring;
function defaultmangledname: string;
function cplusplusmangledname : string;
function objcmangledname : string;
@ -2792,17 +2792,17 @@ implementation
if (ado_isvariant in arrayoptions) or ((highrange=-1) and (lowrange=0)) then
GetTypeName:='Array Of Const'
else
GetTypeName:='Array Of Const/Constant Open Array of '+elementdef.typename;
GetTypeName:='{Array Of Const/Constant Open} Array of '+elementdef.typename;
end
else if (ado_IsDynamicArray in arrayoptions) then
GetTypeName:='Dynamic Array Of '+elementdef.typename
GetTypeName:='{Dynamic} Array Of '+elementdef.typename
else if ((highrange=-1) and (lowrange=0)) then
GetTypeName:='Open Array Of '+elementdef.typename
GetTypeName:='{Open} Array Of '+elementdef.typename
else
begin
result := '';
if (ado_IsBitPacked in arrayoptions) then
result:='Packed ';
result:='BitPacked ';
if rangedef.typ=enumdef then
result:=result+'Array['+rangedef.typename+'] Of '+elementdef.typename
else
@ -3316,9 +3316,9 @@ implementation
end;
function tabstractprocdef.typename_paras(pno: tprocnameoptions) : string;
function tabstractprocdef.typename_paras(pno: tprocnameoptions) : ansistring;
var
hs,s : string;
hs,s : ansistring;
hp : TParavarsym;
hpc : tconstsym;
first : boolean;
@ -3359,7 +3359,7 @@ implementation
begin
hs:=hp.vardef.typesym.realname;
if hs[1]<>'$' then
s:=s+hs
s:=s+hp.vardef.OwnerHierarchyName+hs
else
s:=s+hp.vardef.GetTypeName;
end
@ -3793,9 +3793,9 @@ implementation
end;
function tprocdef.customprocname(pno: tprocnameoptions):string;
function tprocdef.customprocname(pno: tprocnameoptions):ansistring;
var
s : string;
s : ansistring;
t : ttoken;
begin
{$ifdef EXTDEBUG}
@ -5595,6 +5595,7 @@ implementation
result:=import_lib^+'/'+result;
end;
{****************************************************************************
TImplementedInterface
****************************************************************************}