Fix panic for `ByteArray#` arguments in CApiFFI foreign imports
authorHerbert Valerio Riedel <hvr@gnu.org>
Mon, 16 Oct 2017 17:02:01 +0000 (19:02 +0200)
committerHerbert Valerio Riedel <hvr@gnu.org>
Mon, 16 Oct 2017 17:03:11 +0000 (19:03 +0200)
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

compiler/deSugar/DsForeign.hs
testsuite/tests/ffi/should_run/T9274.hs [new file with mode: 0644]
testsuite/tests/ffi/should_run/T9274.stdout [new file with mode: 0644]
testsuite/tests/ffi/should_run/all.T

index 01173c9..492d353 100644 (file)
@@ -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 (file)
index 0000000..814deff
--- /dev/null
@@ -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/testsuite/tests/ffi/should_run/T9274.stdout b/testsuite/tests/ffi/should_run/T9274.stdout
new file mode 100644 (file)
index 0000000..0ca9514
--- /dev/null
@@ -0,0 +1 @@
+True
index 1bb58c5..fd0af7e 100644 (file)
@@ -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'),