From 0ab4515e587d6eba0c82700a003dc3a0ba6a25bb Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sun, 24 Jan 2021 21:32:27 +0000
Subject: [PATCH]   * properly mangle interface wrapper names to avoid
 duplicate label errors, resolves #38385

git-svn-id: trunk@48411 -
---
 .gitattributes           |  4 ++++
 compiler/ncgvmt.pas      |  2 +-
 tests/webtbs/tw38385.pp  | 41 ++++++++++++++++++++++++++++++++++++++++
 tests/webtbs/uw38385a.pp | 17 +++++++++++++++++
 tests/webtbs/uw38385b.pp | 18 ++++++++++++++++++
 tests/webtbs/uw38385c.pp | 18 ++++++++++++++++++
 6 files changed, 99 insertions(+), 1 deletion(-)
 create mode 100644 tests/webtbs/tw38385.pp
 create mode 100644 tests/webtbs/uw38385a.pp
 create mode 100644 tests/webtbs/uw38385b.pp
 create mode 100644 tests/webtbs/uw38385c.pp

diff --git a/.gitattributes b/.gitattributes
index b466c1a519..f29924c704 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/ncgvmt.pas b/compiler/ncgvmt.pas
index 2353ce7bc9..e887deea75 100644
--- a/compiler/ncgvmt.pas
+++ b/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;
diff --git a/tests/webtbs/tw38385.pp b/tests/webtbs/tw38385.pp
new file mode 100644
index 0000000000..30a66965a2
--- /dev/null
+++ b/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.
+
diff --git a/tests/webtbs/uw38385a.pp b/tests/webtbs/uw38385a.pp
new file mode 100644
index 0000000000..41110fc8a8
--- /dev/null
+++ b/tests/webtbs/uw38385a.pp
@@ -0,0 +1,17 @@
+Unit uw38385a;
+
+{$mode objfpc}{$H+}
+
+Interface
+
+Type
+  IInterface1 = Interface(IInterface)
+    Procedure p1();
+  End;
+
+Implementation
+
+
+
+End.
+
diff --git a/tests/webtbs/uw38385b.pp b/tests/webtbs/uw38385b.pp
new file mode 100644
index 0000000000..a4b5d9eca7
--- /dev/null
+++ b/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.
+
diff --git a/tests/webtbs/uw38385c.pp b/tests/webtbs/uw38385c.pp
new file mode 100644
index 0000000000..069d50f7f4
--- /dev/null
+++ b/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.
+