Add a CAPI / CTYPE test (Capi_Ctype_001)

7 files changed, 128 insertions, 0 deletions

diff --git a/testsuite/tests/ffi/should_run/Capi_Ctype_001.hsc b/testsuite/tests/ffi/should_run/Capi_Ctype_001.hsc
new file mode 100644
index 0000000000..71e48f1bbe
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/Capi_Ctype_001.hsc
@@ -0,0 +1,55 @@
+
+{-# LANGUAGE CApiFFI #-}
+
+module Main (main) where
+
+#include "capi_ctype_001.h"
+
+import Capi_Ctype_A_001
+
+import Foreign
+import Foreign.C
+
+main :: IO ()
+main = do alloca $ \p ->
+              do poke p (Foo 5 6 7)
+                 r1 <- f p
+                 print r1
+          alloca $ \p ->
+              do poke p (Foo 15 16 17)
+                 r2 <- g p
+                 print r2
+          alloca $ \p ->
+              do poke p (FooA 25 26 27)
+                 r3 <- h p
+                 print r3
+
+data {-# CTYPE "Foo" #-}
+     Foo = Foo {
+               i :: CInt,
+               j :: CInt,
+               k :: CInt
+           }
+
+type FooASynSyn = FooASyn
+
+foreign import capi unsafe "capi_ctype_001.h f"
+    f :: Ptr Foo -> IO CInt
+
+foreign import capi unsafe "capi_ctype_001.h g"
+    g :: Ptr Foo -> IO CInt
+
+foreign import capi unsafe "capi_ctype_001.h g"
+    h :: Ptr FooASynSyn -> IO CInt
+
+instance Storable Foo where
+    sizeOf _ = #size Foo
+    alignment = sizeOf
+    peek p = do i <- (# peek Foo, i) p
+                j <- (# peek Foo, j) p
+                k <- (# peek Foo, k) p
+                return $ Foo i j k
+    poke p foo = do (# poke Foo, i) p (i foo)
+                    (# poke Foo, j) p (j foo)
+                    (# poke Foo, k) p (k foo)
+
diff --git a/testsuite/tests/ffi/should_run/Capi_Ctype_001.stdout b/testsuite/tests/ffi/should_run/Capi_Ctype_001.stdout
new file mode 100644
index 0000000000..87c8729d1f
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/Capi_Ctype_001.stdout
@@ -0,0 +1,3 @@
+6
+16
+26
diff --git a/testsuite/tests/ffi/should_run/Capi_Ctype_A_001.hsc b/testsuite/tests/ffi/should_run/Capi_Ctype_A_001.hsc
new file mode 100644
index 0000000000..103b264f47
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/Capi_Ctype_A_001.hsc
@@ -0,0 +1,29 @@
+
+{-# LANGUAGE CApiFFI #-}
+
+module Capi_Ctype_A_001 where
+
+#include "capi_ctype_001.h"
+
+import Foreign
+import Foreign.C
+
+data FooA = FooA {
+                ia :: CInt,
+                ja :: CInt,
+                ka :: CInt
+            }
+
+type {-# CTYPE "Foo" #-} FooASyn = FooA
+
+instance Storable FooA where
+    sizeOf _ = #size Foo
+    alignment = sizeOf
+    peek p = do i <- (# peek Foo, i) p
+                j <- (# peek Foo, j) p
+                k <- (# peek Foo, k) p
+                return $ FooA i j k
+    poke p foo = do (# poke Foo, i) p (ia foo)
+                    (# poke Foo, j) p (ja foo)
+                    (# poke Foo, k) p (ka foo)
+
diff --git a/testsuite/tests/ffi/should_run/Makefile b/testsuite/tests/ffi/should_run/Makefile
index 3981cd2166..8b5a9a556d 100644
--- a/testsuite/tests/ffi/should_run/Makefile
+++ b/testsuite/tests/ffi/should_run/Makefile
@@ -20,3 +20,13 @@ ffi002_setup :
 5594_setup :
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c 5594.hs
 
+.PHONY: Capi_Ctype_001
+Capi_Ctype_001:
+	'$(HSC2HS)' Capi_Ctype_A_001.hsc
+	'$(HSC2HS)' Capi_Ctype_001.hsc
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c capi_ctype_001.c
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c Capi_Ctype_A_001.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c Capi_Ctype_001.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) capi_ctype_001.o Capi_Ctype_A_001.o Capi_Ctype_001.o -o Capi_Ctype_001
+	./Capi_Ctype_001
+
diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T
index 118a26fb44..1b61b345bc 100644
--- a/testsuite/tests/ffi/should_run/all.T
+++ b/testsuite/tests/ffi/should_run/all.T
@@ -187,3 +187,11 @@ test('5594', [ omit_ways(['ghci']),
                # 5594_stub.h before compiling 5594_c.c, which
                # needs it.
                compile_and_run, ['5594_c.c -no-hs-main'])
+
+test('Capi_Ctype_001',
+     extra_clean(['Capi_Ctype_A_001.o', 'Capi_Ctype_A_001.hi',
+                  'capi_ctype_001.o',
+                  'Capi_Ctype_A_001.hs', 'Capi_Ctype_001.hs']),
+     run_command,
+     ['$MAKE -s --no-print-directory Capi_Ctype_001'])
+
diff --git a/testsuite/tests/ffi/should_run/capi_ctype_001.c b/testsuite/tests/ffi/should_run/capi_ctype_001.c
new file mode 100644
index 0000000000..970ea4be0f
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_ctype_001.c
@@ -0,0 +1,7 @@
+
+#include "capi_ctype_001.h"
+
+int f(Foo *p) {
+    return p->j;
+}
+
diff --git a/testsuite/tests/ffi/should_run/capi_ctype_001.h b/testsuite/tests/ffi/should_run/capi_ctype_001.h
new file mode 100644
index 0000000000..11add5bf3d
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_ctype_001.h
@@ -0,0 +1,16 @@
+
+#ifndef __capi_ctype_001_H__
+#define __capi_ctype_001_H__
+
+typedef struct {
+    int i;
+    int j;
+    int k;
+} Foo;
+
+int f(Foo *p);
+
+#define g(p) p->j
+
+#endif
+