[commit: ghc] master: Fix panic for `ByteArray#` arguments in CApiFFI foreign imports (add85cc)

[git at git.haskell.org]

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

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

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

commit add85cc2a3ec0bda810dca2a35264308ffaab069
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Mon Oct 16 19:02:01 2017 +0200

    Fix panic for `ByteArray#` arguments in CApiFFI foreign imports
    
    Declarations such as
    
      foreign import capi  unsafe "string.h strlen"
          c_strlen_capi :: ByteArray# -> IO CSize
    
      foreign import capi  unsafe "string.h memset"
          c_memset_capi :: MutableByteArray# s -> CInt -> CSize -> IO ()
    
    would cause GHC to panic because the CApiFFI c-wrapper generator didn't
    know what C type to use for `(Mutable)ByteArray#` types (unlike the
    `ccall` codepath).
    
    This addresses #9274
    
    Reviewed By: bgamari
    
    Differential Revision: https://phabricator.haskell.org/D4092


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

add85cc2a3ec0bda810dca2a35264308ffaab069
 compiler/deSugar/DsForeign.hs                      |  6 ++++++
 testsuite/tests/ffi/should_run/T9274.hs            | 24 ++++++++++++++++++++++
 .../tests/ffi/should_run/T9274.stdout              |  0
 testsuite/tests/ffi/should_run/all.T               |  2 ++
 4 files changed, 32 insertions(+)

diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs
index 01173c9..492d353 100644
--- a/compiler/deSugar/DsForeign.hs
+++ b/compiler/deSugar/DsForeign.hs
@@ -717,6 +717,12 @@ toCType = f False
            -- through one layer of type synonym etc.
            | Just t' <- coreView t
               = f voidOK t'
+           -- This may be an 'UnliftedFFITypes'-style ByteArray# argument
+           -- (which is marshalled like a Ptr)
+           | Just byteArrayPrimTyCon        == tyConAppTyConPicky_maybe t
+              = (Nothing, text "const void*")
+           | Just mutableByteArrayPrimTyCon == tyConAppTyConPicky_maybe t
+              = (Nothing, text "void*")
            -- Otherwise we don't know the C type. If we are allowing
            -- void then return that; otherwise something has gone wrong.
            | voidOK = (Nothing, text "void")
diff --git a/testsuite/tests/ffi/should_run/T9274.hs b/testsuite/tests/ffi/should_run/T9274.hs
new file mode 100644
index 0000000..814deff
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/T9274.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE BangPatterns      #-}
+{-# LANGUAGE CApiFFI           #-}
+{-# LANGUAGE MagicHash         #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UnliftedFFITypes  #-}
+
+module Main where
+
+import qualified Data.ByteString.Short.Internal as SBS
+import           Foreign.C.Types
+import           GHC.Exts
+
+foreign import capi  unsafe "string.h strlen"
+    c_strlen_capi :: ByteArray# -> IO CSize
+
+foreign import capi  unsafe "string.h memset"
+    c_memset_capi :: MutableByteArray# s -> CInt -> CSize -> IO ()
+
+main :: IO ()
+main = do
+    n <- c_strlen_capi ba#
+    print (n == 13)
+  where
+    !(SBS.SBS ba#) = "Hello FFI!!!!\NUL"
diff --git a/libraries/base/tests/IO/IOError002.stdout b/testsuite/tests/ffi/should_run/T9274.stdout
similarity index 100%
copy from libraries/base/tests/IO/IOError002.stdout
copy to testsuite/tests/ffi/should_run/T9274.stdout
diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T
index 1bb58c5..fd0af7e 100644
--- a/testsuite/tests/ffi/should_run/all.T
+++ b/testsuite/tests/ffi/should_run/all.T
@@ -174,6 +174,8 @@ test('T4012', [expect_broken_for(7388, ['ghci'])], multimod_compile_and_run,
 
 test('T8083', [omit_ways(['ghci'])], compile_and_run, ['T8083_c.c'])
 
+test('T9274', [omit_ways(['ghci'])], compile_and_run, [''])
+
 test('ffi023', [ omit_ways(['ghci']),
                 extra_clean(['ffi023_c.o']),
                 extra_run_opts('1000 4'),