2
0
Эх сурвалжийг харах

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

git-svn-id: trunk@48411 -
florian 4 жил өмнө
parent
commit
0ab4515e58

+ 4 - 0
.gitattributes

@@ -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

+ 1 - 1
compiler/ncgvmt.pas

@@ -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 - 0
tests/webtbs/tw38385.pp

@@ -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 - 0
tests/webtbs/uw38385a.pp

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

+ 18 - 0
tests/webtbs/uw38385b.pp

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

+ 18 - 0
tests/webtbs/uw38385c.pp

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