mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-22 18:09:20 +02:00
+ parameters of nested procedure variable parameters are taken into account during name mangling, resolves #27515
* de-duplicated parameter name mangling code git-svn-id: trunk@29791 -
This commit is contained in:
parent
8ed6109955
commit
cab98a58d0
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -14261,6 +14261,7 @@ tests/webtbs/tw2737.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw2738.pp svneol=native#text/plain
|
tests/webtbs/tw2738.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2739.pp svneol=native#text/plain
|
tests/webtbs/tw2739.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw27424.pp svneol=native#text/pascal
|
tests/webtbs/tw27424.pp svneol=native#text/pascal
|
||||||
|
tests/webtbs/tw27515.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw2758.pp svneol=native#text/plain
|
tests/webtbs/tw2758.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2763.pp svneol=native#text/plain
|
tests/webtbs/tw2763.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw2765.pp svneol=native#text/plain
|
tests/webtbs/tw2765.pp svneol=native#text/plain
|
||||||
|
@ -214,9 +214,6 @@ interface
|
|||||||
function alignment:shortint;override;
|
function alignment:shortint;override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ tpointerdef }
|
|
||||||
|
|
||||||
tpointerdef = class(tabstractpointerdef)
|
tpointerdef = class(tabstractpointerdef)
|
||||||
has_pointer_math : boolean;
|
has_pointer_math : boolean;
|
||||||
constructor create(def:tdef);virtual;
|
constructor create(def:tdef);virtual;
|
||||||
@ -577,6 +574,7 @@ interface
|
|||||||
procedure buildderef;override;
|
procedure buildderef;override;
|
||||||
procedure deref;override;
|
procedure deref;override;
|
||||||
procedure calcparas;
|
procedure calcparas;
|
||||||
|
function mangledprocparanames(oldlen : longint) : string;
|
||||||
function typename_paras(pno: tprocnameoptions): ansistring;
|
function typename_paras(pno: tprocnameoptions): ansistring;
|
||||||
function is_methodpointer:boolean;virtual;
|
function is_methodpointer:boolean;virtual;
|
||||||
function is_addressonly:boolean;virtual;
|
function is_addressonly:boolean;virtual;
|
||||||
@ -1220,38 +1218,7 @@ implementation
|
|||||||
conflicts with 2 overloads having both a nested procedure
|
conflicts with 2 overloads having both a nested procedure
|
||||||
with the same name, see tb0314 (PFV) }
|
with the same name, see tb0314 (PFV) }
|
||||||
s:=tprocdef(st.defowner).procsym.name;
|
s:=tprocdef(st.defowner).procsym.name;
|
||||||
oldlen:=length(s);
|
s:=s+tprocdef(st.defowner).mangledprocparanames(Length(s));
|
||||||
for i:=0 to tprocdef(st.defowner).paras.count-1 do
|
|
||||||
begin
|
|
||||||
hp:=tparavarsym(tprocdef(st.defowner).paras[i]);
|
|
||||||
if not(vo_is_hidden_para in hp.varoptions) then
|
|
||||||
s:=s+'$'+hp.vardef.mangledparaname;
|
|
||||||
end;
|
|
||||||
if not is_void(tprocdef(st.defowner).returndef) then
|
|
||||||
s:=s+'$$'+tprocdef(st.defowner).returndef.mangledparaname;
|
|
||||||
newlen:=length(s);
|
|
||||||
{ Replace with CRC if the parameter line is very long }
|
|
||||||
if (newlen-oldlen>12) and
|
|
||||||
((newlen+length(prefix)>100) or (newlen-oldlen>32)) then
|
|
||||||
begin
|
|
||||||
crc:=0;
|
|
||||||
for i:=0 to tprocdef(st.defowner).paras.count-1 do
|
|
||||||
begin
|
|
||||||
hp:=tparavarsym(tprocdef(st.defowner).paras[i]);
|
|
||||||
if not(vo_is_hidden_para in hp.varoptions) then
|
|
||||||
begin
|
|
||||||
hs:=hp.vardef.mangledparaname;
|
|
||||||
crc:=UpdateCrc32(crc,hs[1],length(hs));
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
if not is_void(tprocdef(st.defowner).returndef) then
|
|
||||||
begin
|
|
||||||
{ add a little prefix so that x(integer; integer) is different from x(integer):integer }
|
|
||||||
hs:='$$'+tprocdef(st.defowner).returndef.mangledparaname;
|
|
||||||
crc:=UpdateCrc32(crc,hs[1],length(hs));
|
|
||||||
end;
|
|
||||||
s:=Copy(s,1,oldlen)+'$crc'+hexstr(crc,8);
|
|
||||||
end;
|
|
||||||
if prefix<>'' then
|
if prefix<>'' then
|
||||||
prefix:=s+'_'+prefix
|
prefix:=s+'_'+prefix
|
||||||
else
|
else
|
||||||
@ -4342,6 +4309,53 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function tabstractprocdef.mangledprocparanames(oldlen : longint) : string;
|
||||||
|
var
|
||||||
|
crc : dword;
|
||||||
|
hp : TParavarsym;
|
||||||
|
hs : TSymStr;
|
||||||
|
newlen,
|
||||||
|
i : integer;
|
||||||
|
begin
|
||||||
|
result:='';
|
||||||
|
hp:=nil;
|
||||||
|
{ add parameter types }
|
||||||
|
for i:=0 to paras.count-1 do
|
||||||
|
begin
|
||||||
|
hp:=tparavarsym(paras[i]);
|
||||||
|
if not(vo_is_hidden_para in hp.varoptions) then
|
||||||
|
result:=result+'$'+hp.vardef.mangledparaname;
|
||||||
|
end;
|
||||||
|
{ add resultdef, add $$ as separator to make it unique from a
|
||||||
|
parameter separator }
|
||||||
|
if not is_void(returndef) then
|
||||||
|
result:=result+'$$'+returndef.mangledparaname;
|
||||||
|
newlen:=length(result)+oldlen;
|
||||||
|
{ Replace with CRC if the parameter line is very long }
|
||||||
|
if (newlen-oldlen>12) and
|
||||||
|
((newlen>100) or (newlen-oldlen>64)) then
|
||||||
|
begin
|
||||||
|
crc:=0;
|
||||||
|
for i:=0 to paras.count-1 do
|
||||||
|
begin
|
||||||
|
hp:=tparavarsym(paras[i]);
|
||||||
|
if not(vo_is_hidden_para in hp.varoptions) then
|
||||||
|
begin
|
||||||
|
hs:=hp.vardef.mangledparaname;
|
||||||
|
crc:=UpdateCrc32(crc,hs[1],length(hs));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if not is_void(returndef) then
|
||||||
|
begin
|
||||||
|
{ add a little prefix so that x(integer; integer) is different from x(integer):integer }
|
||||||
|
hs:='$$'+returndef.mangledparaname;
|
||||||
|
crc:=UpdateCrc32(crc,hs[1],length(hs));
|
||||||
|
end;
|
||||||
|
result:='$crc'+hexstr(crc,8);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure tabstractprocdef.buildderef;
|
procedure tabstractprocdef.buildderef;
|
||||||
begin
|
begin
|
||||||
{ released procdef? }
|
{ released procdef? }
|
||||||
@ -5475,53 +5489,11 @@ implementation
|
|||||||
|
|
||||||
|
|
||||||
function tprocdef.defaultmangledname: TSymStr;
|
function tprocdef.defaultmangledname: TSymStr;
|
||||||
var
|
|
||||||
hp : TParavarsym;
|
|
||||||
hs : TSymStr;
|
|
||||||
crc : dword;
|
|
||||||
newlen,
|
|
||||||
oldlen,
|
|
||||||
i : integer;
|
|
||||||
begin
|
begin
|
||||||
hp:=nil;
|
|
||||||
{ we need to use the symtable where the procsym is inserted,
|
{ we need to use the symtable where the procsym is inserted,
|
||||||
because that is visible to the world }
|
because that is visible to the world }
|
||||||
defaultmangledname:=make_mangledname('',procsym.owner,procsym.name);
|
defaultmangledname:=make_mangledname('',procsym.owner,procsym.name);
|
||||||
oldlen:=length(defaultmangledname);
|
defaultmangledname:=defaultmangledname+mangledprocparanames(Length(defaultmangledname))
|
||||||
{ add parameter types }
|
|
||||||
for i:=0 to paras.count-1 do
|
|
||||||
begin
|
|
||||||
hp:=tparavarsym(paras[i]);
|
|
||||||
if not(vo_is_hidden_para in hp.varoptions) then
|
|
||||||
defaultmangledname:=defaultmangledname+'$'+hp.vardef.mangledparaname;
|
|
||||||
end;
|
|
||||||
{ add resultdef, add $$ as separator to make it unique from a
|
|
||||||
parameter separator }
|
|
||||||
if not is_void(returndef) then
|
|
||||||
defaultmangledname:=defaultmangledname+'$$'+returndef.mangledparaname;
|
|
||||||
newlen:=length(defaultmangledname);
|
|
||||||
{ Replace with CRC if the parameter line is very long }
|
|
||||||
if (newlen-oldlen>12) and
|
|
||||||
((newlen>100) or (newlen-oldlen>64)) then
|
|
||||||
begin
|
|
||||||
crc:=0;
|
|
||||||
for i:=0 to paras.count-1 do
|
|
||||||
begin
|
|
||||||
hp:=tparavarsym(paras[i]);
|
|
||||||
if not(vo_is_hidden_para in hp.varoptions) then
|
|
||||||
begin
|
|
||||||
hs:=hp.vardef.mangledparaname;
|
|
||||||
crc:=UpdateCrc32(crc,hs[1],length(hs));
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
if not is_void(returndef) then
|
|
||||||
begin
|
|
||||||
{ add a little prefix so that x(integer; integer) is different from x(integer):integer }
|
|
||||||
hs:='$$'+returndef.mangledparaname;
|
|
||||||
crc:=UpdateCrc32(crc,hs[1],length(hs));
|
|
||||||
end;
|
|
||||||
defaultmangledname:=Copy(defaultmangledname,1,oldlen)+'$crc'+hexstr(crc,8);
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -5858,7 +5830,11 @@ implementation
|
|||||||
if not is_nested_pd(self) then
|
if not is_nested_pd(self) then
|
||||||
result:='procvar'
|
result:='procvar'
|
||||||
else
|
else
|
||||||
result:='nestedprovar'
|
{ we need the manglednames here, because nestedprocvars can be anonymous, e.g.
|
||||||
|
having not a type name or not an unique one, see webtbs/tw27515.pp
|
||||||
|
|
||||||
|
Further, use $_ ... _$ delimiters to avoid ambiguous names, see webtbs/tw27515.pp }
|
||||||
|
result:='$_nestedprovar'+mangledprocparanames(0)+'_$'
|
||||||
else
|
else
|
||||||
result:='procvarofobj'
|
result:='procvarofobj'
|
||||||
end;
|
end;
|
||||||
|
7
tests/webtbs/tw27515.pp
Normal file
7
tests/webtbs/tw27515.pp
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
{$modeswitch nestedprocvars}
|
||||||
|
procedure foo(procedure bar;x : longint); begin end;
|
||||||
|
procedure foo(procedure bar(x: longint)); begin end;
|
||||||
|
procedure foo(procedure baz(x: tobject)); begin end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user