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

* shorten interface wrapper names if needed, resolves #33069

Browse Source 
git-svn-id: trunk@38319 -
This commit is contained in:
florian 2018-02-22 21:55:07 +00:00
parent 5b16a84de1
commit 048c2c09fd
3 changed files with 42 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -16009,6 +16009,7 @@ tests/webtbs/tw3294a.pp svneol=native#text/plain
tests/webtbs/tw3298.pp svneol=native#text/plain
tests/webtbs/tw33004.pp svneol=native#text/pascal
tests/webtbs/tw3301.pp svneol=native#text/plain
tests/webtbs/tw33069.pp svneol=native#text/pascal
tests/webtbs/tw33086.pp svneol=native#text/pascal
tests/webtbs/tw3309.pp svneol=native#text/plain
tests/webtbs/tw33098.pp svneol=native#text/pascal

26
compiler/ncgvmt.pas
View File

@ -108,6 +108,7 @@ implementation
uses
cutils,cclasses,
fpccrc,
globtype,globals,verbose,constexp,
systems,fmodule,
symsym,symtable,symcreat,
@ -708,6 +709,25 @@ implementation
Interface tables
**************************************}
function CreateWrapperName(_class : tobjectdef;AImplIntf : TImplementedInterface;i : longint;pd : tprocdef) : string;
var
tmpstr : AnsiString;
hs : string;
crc : DWord;
begin
tmpstr:=_class.objname^+'_$_'+AImplIntf.IntfDef.objname^+'_$_'+tostr(i)+'_$_'+pd.mangledname;
if length(tmpstr)>100 then
begin
crc:=0;
crc:=UpdateCrc32(crc,tmpstr[101],length(tmpstr)-100);
hs:=copy(tmpstr,1,100)+'$CRC'+hexstr(crc,8);
end
else
hs:=tmpstr;
result:=make_mangledname('WRPR',_class.owner,hs);
end;
procedure TVMTWriter.intf_create_vtbl(tcb: ttai_typedconstbuilder; AImplIntf: TImplementedInterface; intfindex: longint);
var
datatcb : ttai_typedconstbuilder;
@ -724,8 +744,7 @@ implementation
for i:=0 to AImplIntf.procdefs.count-1 do
begin
pd:=tprocdef(AImplIntf.procdefs[i]);
hs:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+AImplIntf.IntfDef.objname^+'_$_'+
tostr(i)+'_$_'+pd.mangledname);
hs:=CreateWrapperName(_Class,AImplIntf,i,pd);
{ create reference }
datatcb.emit_tai(Tai_const.Createname(hs,AT_FUNCTION,0),cprocvardef.getreusableprocaddr(pd));
end;
@ -1292,8 +1311,7 @@ implementation
if (po_virtualmethod in pd.procoptions) and
not is_objectpascal_helper(tprocdef(pd).struct) then
tobjectdef(tprocdef(pd).struct).register_vmt_call(tprocdef(pd).extnumber);
tmps:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+
ImplIntf.IntfDef.objname^+'_$_'+tostr(j)+'_$_'+pd.mangledname);
tmps:=CreateWrapperName(_Class,ImplIntf,j,pd);
{$ifdef cpuhighleveltarget}
new(wrapperinfo);
wrapperinfo^.pd:=pd;

19
tests/webtbs/tw33069.pp Normal file
View File

@ -0,0 +1,19 @@
{ %OPT=-al }
program test;
{$mode objfpc}
type
generic IIncrediblyLongInterfaceNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaame<T> = interface
end;
generic TGenericImplementationOfLongInterfaceName<T> =
class(TInterfacedObject,
specialize IIncrediblyLongInterfaceNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaame<T>)
end;
TIWillBreakYou = specialize TGenericImplementationOfLongInterfaceName<Integer>;
begin
end.