[Git][ghc/ghc][master] Add regression test case for old issue #493

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
6f07f828 by Kevin Buhr at 2019-05-10T20:51:11Z
Add regression test case for old issue #493

- - - - -


5 changed files:

- testsuite/.gitignore
- + testsuite/tests/ffi/should_run/T493.hs
- + testsuite/tests/ffi/should_run/T493.stdout
- + testsuite/tests/ffi/should_run/T493_c.c
- testsuite/tests/ffi/should_run/all.T


Changes:

=====================================
testsuite/.gitignore
=====================================
@@ -694,6 +694,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
 /tests/ffi/should_run/Capi_Ctype_002
 /tests/ffi/should_run/Capi_Ctype_A_001.hs
 /tests/ffi/should_run/Capi_Ctype_A_002.hs
+/tests/ffi/should_run/T493
 /tests/ffi/should_run/T1288
 /tests/ffi/should_run/T1679
 /tests/ffi/should_run/T2276


=====================================
testsuite/tests/ffi/should_run/T493.hs
=====================================
@@ -0,0 +1,41 @@
+import Foreign
+import Foreign.C
+
+-- These newtypes...
+newtype MyFunPtr a = MyFunPtr { getFunPtr :: FunPtr a }
+newtype MyPtr a = MyPtr (Ptr a)
+newtype MyIO a = MyIO { runIO :: IO a }
+-- should be supported by...
+
+-- foreign import dynamics
+foreign import ccall "dynamic"
+    mkFun1 :: MyFunPtr (CInt -> CInt) -> (CInt -> CInt)
+foreign import ccall "dynamic"
+    mkFun2 :: MyPtr (Int32 -> Int32) -> (CInt -> CInt)
+
+-- and foreign import wrappers.
+foreign import ccall "wrapper"
+    mkWrap1 :: (CInt -> CInt) -> MyIO (MyFunPtr (CInt -> CInt))
+foreign import ccall "wrapper"
+    mkWrap2 :: (CInt -> CInt) -> MyIO (MyPtr (Int32 -> Int32))
+
+-- We'll need a dynamic function point to export
+foreign import ccall "getDbl" getDbl :: IO (MyFunPtr (CInt -> CInt))
+-- and a Haskell function to export
+half :: CInt -> CInt
+half = (`div` 2)
+-- and a C function to pass it to.
+foreign import ccall "apply" apply1 :: MyFunPtr (CInt -> CInt) -> Int -> Int
+foreign import ccall "apply" apply2 :: MyPtr (Int32 -> Int32) -> Int -> Int
+
+main :: IO ()
+main = do
+
+  dbl <- getDbl
+  let dbl1 = mkFun1 dbl
+      dbl2 = mkFun2 $ MyPtr $ castFunPtrToPtr $ getFunPtr dbl
+  print (dbl1 21, dbl2 21)
+
+  half1 <- runIO $ mkWrap1 half
+  half2 <- runIO $ mkWrap2 half
+  print (apply1 half1 84, apply2 half2 84)


=====================================
testsuite/tests/ffi/should_run/T493.stdout
=====================================
@@ -0,0 +1,2 @@
+(42,42)
+(42,42)


=====================================
testsuite/tests/ffi/should_run/T493_c.c
=====================================
@@ -0,0 +1,16 @@
+typedef int (*intfun_p)(int);
+
+int dbl(int x)
+{
+        return x*2;
+}
+
+intfun_p getDbl(void)
+{
+        return dbl;
+}
+
+int apply(intfun_p f, int x)
+{
+        return f(x);
+}


=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -198,3 +198,5 @@ test('PrimFFIWord8', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord8_c.c'
 test('PrimFFIInt16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIInt16_c.c'])
 
 test('PrimFFIWord16', [omit_ways(['ghci'])], compile_and_run, ['PrimFFIWord16_c.c'])
+
+test('T493', [], compile_and_run, ['T493_c.c'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6f07f828e4f7a445fabd82dcb3fbf6edb2641369

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6f07f828e4f7a445fabd82dcb3fbf6edb2641369
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190510/405ea544/attachment-0001.html>