Fix #13807 - foreign import nondeterminism

The problem was that the generated label included
a freshly assigned Unique value.

Test Plan:
Added a new test and looked at the generated stub:

```
 #include "HsFFI.h"
 #ifdef __cplusplus
 extern "C" {
 #endif
 extern HsInt zdmainzdAzdAzuzzlzzgzzg(StgStablePtr the_stableptr);
 extern HsInt zdmainzdAzdAzumkStringWriter(StgStablePtr the_stableptr);
 #ifdef __cplusplus
 }
 #endif
```

./validate

Reviewers: simonmar, austin, bgamari

Reviewed By: simonmar

Subscribers: rwbarton, thomie

GHC Trac Issues: #13807

Differential Revision: https://phabricator.haskell.org/D3633

5 files changed, 30 insertions, 8 deletions

diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs
index fb3752d104..9b088b280d 100644
--- a/compiler/deSugar/DsForeign.hs
+++ b/compiler/deSugar/DsForeign.hs
@@ -52,6 +52,7 @@ import OrdList
 import Pair
 import Util
 import Hooks
+import Encoding
 
 import Data.Maybe
 import Data.List
@@ -412,16 +413,12 @@ dsFExportDynamic :: Id
                  -> CCallConv
                  -> DsM ([Binding], SDoc, SDoc)
 dsFExportDynamic id co0 cconv = do
-    fe_id <-  newSysLocalDs ty
     mod <- getModule
     dflags <- getDynFlags
-    let
-        -- hack: need to get at the name of the C stub we're about to generate.
-        -- TODO: There's no real need to go via String with
-        -- (mkFastString . zString). In fact, is there a reason to convert
-        -- to FastString at all now, rather than sticking with FastZString?
-        fe_nm    = mkFastString (zString (zEncodeFS (moduleNameFS (moduleName mod))) ++ "_" ++ toCName dflags fe_id)
-
+    let fe_nm = mkFastString $ zEncodeString
+            (moduleStableString mod ++ "$" ++ toCName dflags id)
+        -- Construct the label based on the passed id, don't use names
+        -- depending on Unique. See #13807 and Note [Unique Determinism].
     cback <- newSysLocalDs arg_ty
     newStablePtrId <- dsLookupGlobalId newStablePtrName
     stable_ptr_tycon <- dsLookupTyCon stablePtrTyConName
diff --git a/testsuite/tests/determinism/T13807/A.hs b/testsuite/tests/determinism/T13807/A.hs
new file mode 100644
index 0000000000..ff8a00c2c1
--- /dev/null
+++ b/testsuite/tests/determinism/T13807/A.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module A ( mkStringWriter, (<>>) ) where
+
+import Foreign.Ptr
+import Prelude
+
+-- generated C wrappers used to use Unique values for the label
+foreign import ccall "wrapper" mkStringWriter :: Int -> IO (Ptr Int)
+-- make sure we properly z-encode the generated stubs
+foreign import ccall "wrapper" (<>>) :: Int -> IO (Ptr Int)
diff --git a/testsuite/tests/determinism/T13807/Makefile b/testsuite/tests/determinism/T13807/Makefile
new file mode 100644
index 0000000000..f420abba43
--- /dev/null
+++ b/testsuite/tests/determinism/T13807/Makefile
@@ -0,0 +1,11 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T13807:
+	$(RM) A.hi A.o
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -dinitial-unique=0 -dunique-increment=1 A.hs
+	$(CP) A.hi A.normal.hi
+	$(RM) A.hi A.o
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -dinitial-unique=16777215 -dunique-increment=-1 A.hs
+	diff A.hi A.normal.hi
diff --git a/testsuite/tests/determinism/T13807/T13807.stdout b/testsuite/tests/determinism/T13807/T13807.stdout
new file mode 100644
index 0000000000..60c2bc368d
--- /dev/null
+++ b/testsuite/tests/determinism/T13807/T13807.stdout
@@ -0,0 +1,2 @@
+[1 of 1] Compiling A                ( A.hs, A.o )
+[1 of 1] Compiling A                ( A.hs, A.o )
diff --git a/testsuite/tests/determinism/T13807/all.T b/testsuite/tests/determinism/T13807/all.T
new file mode 100644
index 0000000000..465d57c239
--- /dev/null
+++ b/testsuite/tests/determinism/T13807/all.T
@@ -0,0 +1 @@
+test('T13807', [extra_files(['A.hs'])], run_command, ['$MAKE -s --no-print-directory T13807'])