[commit: ghc] master: Fix #13807 - foreign import nondeterminism (dcdc391)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/dcdc391609d6ff902989d806266855901c051608/ghc

>---------------------------------------------------------------

commit dcdc391609d6ff902989d806266855901c051608
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Mon Jun 12 17:02:44 2017 -0400

    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


>---------------------------------------------------------------

dcdc391609d6ff902989d806266855901c051608
 compiler/deSugar/DsForeign.hs                               | 13 +++++--------
 testsuite/tests/determinism/T13807/A.hs                     | 11 +++++++++++
 testsuite/tests/determinism/{determ022 => T13807}/Makefile  |  2 +-
 .../{determ002/determ002.stdout => T13807/T13807.stdout}    |  0
 testsuite/tests/determinism/T13807/all.T                    |  1 +
 5 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs
index fb3752d..9b088b2 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 0000000..ff8a00c
--- /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/determ022/Makefile b/testsuite/tests/determinism/T13807/Makefile
similarity index 96%
copy from testsuite/tests/determinism/determ022/Makefile
copy to testsuite/tests/determinism/T13807/Makefile
index 1bd543e..f420abb 100644
--- a/testsuite/tests/determinism/determ022/Makefile
+++ b/testsuite/tests/determinism/T13807/Makefile
@@ -2,7 +2,7 @@ TOP=../../..
 include $(TOP)/mk/boilerplate.mk
 include $(TOP)/mk/test.mk
 
-determ022:
+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
diff --git a/testsuite/tests/determinism/determ002/determ002.stdout b/testsuite/tests/determinism/T13807/T13807.stdout
similarity index 100%
copy from testsuite/tests/determinism/determ002/determ002.stdout
copy to testsuite/tests/determinism/T13807/T13807.stdout
diff --git a/testsuite/tests/determinism/T13807/all.T b/testsuite/tests/determinism/T13807/all.T
new file mode 100644
index 0000000..465d57c
--- /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'])