* properly mangle interface wrapper names to avoid duplicate label errors, resolves #38385

git-svn-id: trunk@48411 -
This commit is contained in:
florian 2021-01-24 21:32:27 +00:00
parent 0b76059b37
commit 0ab4515e58
6 changed files with 99 additions and 1 deletions

4
.gitattributes vendored
View File

@ -18644,6 +18644,7 @@ tests/webtbs/tw3833.pp svneol=native#text/plain
tests/webtbs/tw38337.pp svneol=native#text/plain
tests/webtbs/tw38339.pp svneol=native#text/plain
tests/webtbs/tw38351.pp -text svneol=native#text/pascal
tests/webtbs/tw38385.pp svneol=native#text/pascal
tests/webtbs/tw38390.pp svneol=native#text/pascal
tests/webtbs/tw3840.pp svneol=native#text/plain
tests/webtbs/tw3841.pp svneol=native#text/plain
@ -19181,6 +19182,9 @@ tests/webtbs/uw35918b.pp svneol=native#text/pascal
tests/webtbs/uw35918c.pp svneol=native#text/pascal
tests/webtbs/uw36544.pp svneol=native#text/pascal
tests/webtbs/uw38069.pp svneol=native#text/pascal
tests/webtbs/uw38385a.pp svneol=native#text/pascal
tests/webtbs/uw38385b.pp svneol=native#text/pascal
tests/webtbs/uw38385c.pp svneol=native#text/pascal
tests/webtbs/uw3968.pp svneol=native#text/plain
tests/webtbs/uw4056.pp svneol=native#text/plain
tests/webtbs/uw4140.pp svneol=native#text/plain

View File

@ -708,7 +708,7 @@ implementation
while realintfdef.is_unique_objpasdef do
realintfdef:=realintfdef.childof;
tmpstr:=_class.objname^+'_$_'+realintfdef.objname^+'_$_'+tostr(i)+'_$_'+pd.mangledname;
tmpstr:=_class.objname^+'_$_'+make_mangledname('',realintfdef.owner,'')+'_$$_'+realintfdef.objname^+'_$_'+tostr(i)+'_$_'+pd.mangledname;
if length(tmpstr)>100 then
begin
crc:=0;

41
tests/webtbs/tw38385.pp Normal file
View File

@ -0,0 +1,41 @@
{ %norun }
Unit tw38385;
{$mode objfpc}{$H+}
Interface
Uses
uw38385a, uw38385b, uw38385c;
Type
{ TFoo }
TFoo = Class(TInterfacedObject, uw38385a.IInterface1, uw38385b.IInterface1, uw38385c.IInterface1)
Procedure p1();
Procedure p2();
Procedure p3();
End;
Implementation
{ TFoo }
Procedure TFoo.p1();
Begin
WriteLn('p1');
End;
Procedure TFoo.p2();
Begin
WriteLn('p2');
End;
Procedure TFoo.p3();
Begin
WriteLn('p3');
End;
End.

17
tests/webtbs/uw38385a.pp Normal file
View File

@ -0,0 +1,17 @@
Unit uw38385a;
{$mode objfpc}{$H+}
Interface
Type
IInterface1 = Interface(IInterface)
Procedure p1();
End;
Implementation
End.

18
tests/webtbs/uw38385b.pp Normal file
View File

@ -0,0 +1,18 @@
unit uw38385b;
{$mode objfpc}{$H+}
interface
uses
uw38385a;
type
IInterface1 = Interface(uw38385a.IInterface1)
Procedure p2();
End;
implementation
end.

18
tests/webtbs/uw38385c.pp Normal file
View File

@ -0,0 +1,18 @@
Unit uw38385c;
{$mode objfpc}{$H+}
Interface
Uses
uw38385a;
Type
IInterface1 = Interface(uw38385a.IInterface1)
Procedure p3();
End;
Implementation
End.