diff --git a/.gitattributes b/.gitattributes index cbfd248422..fc7bdc27bf 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas index 9ffc2e0351..74d3f1dc75 100644 --- a/compiler/ncgvmt.pas +++ b/compiler/ncgvmt.pas @@ -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; diff --git a/tests/webtbs/tw33069.pp b/tests/webtbs/tw33069.pp new file mode 100644 index 0000000000..bd44480e24 --- /dev/null +++ b/tests/webtbs/tw33069.pp @@ -0,0 +1,19 @@ +{ %OPT=-al } +program test; + +{$mode objfpc} + +type + generic IIncrediblyLongInterfaceNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaame = interface + end; + + generic TGenericImplementationOfLongInterfaceName = + class(TInterfacedObject, + specialize IIncrediblyLongInterfaceNaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaame) + end; + + TIWillBreakYou = specialize TGenericImplementationOfLongInterfaceName; + +begin + +end.