[Git][ghc/ghc][wip/T15933] Add test case for #15933

[Peter Trommler]

Peter Trommler pushed to branch wip/T15933 at Glasgow Haskell Compiler / GHC


Commits:
2229741c by Peter Trommler at 2020-06-11T19:59:26+02:00
Add test case for #15933

- - - - -


6 changed files:

- testsuite/tests/ffi/should_run/Makefile
- + testsuite/tests/ffi/should_run/T15933.h
- + testsuite/tests/ffi/should_run/T15933.hs
- + testsuite/tests/ffi/should_run/T15933.stdout
- + testsuite/tests/ffi/should_run/T15933_c.c
- testsuite/tests/ffi/should_run/all.T


Changes:

=====================================
testsuite/tests/ffi/should_run/Makefile
=====================================
@@ -43,3 +43,9 @@ Capi_Ctype_002:
 	'$(TEST_HC)' $(TEST_HC_OPTS) Capi_Ctype_A_002.o Capi_Ctype_002.o -o Capi_Ctype_002
 	./Capi_Ctype_002
 
+.PHONY: T15933
+T15933:
+	$(TEST_HC) $(TEST_HC_OPTS) -c T15933_c.c
+	$(TEST_HC) $(TEST_HC_OPTS) -c T15933.hs
+	$(TEST_HC) $(TEST_HC_OPTS) T15933_c.o T15933.o -o T15933
+	./T15933


=====================================
testsuite/tests/ffi/should_run/T15933.h
=====================================
@@ -0,0 +1,2 @@
+typedef void(*hs_callback)(int x);
+extern void function_in_c(hs_callback cb);


=====================================
testsuite/tests/ffi/should_run/T15933.hs
=====================================
@@ -0,0 +1,17 @@
+module Main(main) where
+
+import Foreign
+import Foreign.C
+
+type HsCallback = CInt -> IO ()
+
+foreign import ccall "T15933.h function_in_c"
+  functionInC :: FunPtr HsCallback -> IO ()
+
+foreign import ccall "wrapper"
+  wrap :: HsCallback -> IO (FunPtr HsCallback)
+
+main = do
+  f <- wrap $ \x -> print x
+  functionInC f
+  freeHaskellFunPtr f


=====================================
testsuite/tests/ffi/should_run/T15933.stdout
=====================================
@@ -0,0 +1 @@
+10


=====================================
testsuite/tests/ffi/should_run/T15933_c.c
=====================================
@@ -0,0 +1,7 @@
+#include "T15933.h"
+
+void function_in_c(hs_callback cb)
+{
+    int x = 10;
+    cb(x);
+}


=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -194,6 +194,8 @@ test('T12134', [omit_ways(['ghci'])], compile_and_run, ['T12134_c.c'])
 
 test('T12614', [omit_ways(['ghci'])], compile_and_run, ['T12614_c.c'])
 
+test('T15933', extra_files(['T15933_c.c', 'T15933.h']), makefile_test, ['T15933'])
+
 test('T16650a', [omit_ways(['ghci'])], compile_and_run, ['T16650a_c.c'])
 
 test('T16650b', [omit_ways(['ghci'])], compile_and_run, ['T16650b_c.c'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2229741c50b9f0130ae3523c06508098021fc033

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2229741c50b9f0130ae3523c06508098021fc033
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/20200611/15f0393e/attachment-0001.html>