Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f7062522ded6b1f6f639b3bdf5de5436a0a00c42 >--------------------------------------------------------------- commit f7062522ded6b1f6f639b3bdf5de5436a0a00c42 Author: Ian Lynagh <[email protected]> Date: Wed Feb 15 00:40:47 2012 +0000 Add a CAPI / CTYPE test (Capi_Ctype_001) >--------------------------------------------------------------- tests/ffi/should_run/Capi_Ctype_001.hsc | 55 ++++++++++++++++++++++++++++ tests/ffi/should_run/Capi_Ctype_001.stdout | 3 ++ tests/ffi/should_run/Capi_Ctype_A_001.hsc | 29 +++++++++++++++ tests/ffi/should_run/Makefile | 10 +++++ tests/ffi/should_run/all.T | 8 ++++ tests/ffi/should_run/capi_ctype_001.c | 7 ++++ tests/ffi/should_run/capi_ctype_001.h | 16 ++++++++ 7 files changed, 128 insertions(+), 0 deletions(-) diff --git a/tests/ffi/should_run/Capi_Ctype_001.hsc b/tests/ffi/should_run/Capi_Ctype_001.hsc new file mode 100644 index 0000000..71e48f1 --- /dev/null +++ b/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/tests/ffi/should_run/Capi_Ctype_001.stdout b/tests/ffi/should_run/Capi_Ctype_001.stdout new file mode 100644 index 0000000..87c8729 --- /dev/null +++ b/tests/ffi/should_run/Capi_Ctype_001.stdout @@ -0,0 +1,3 @@ +6 +16 +26 diff --git a/tests/ffi/should_run/Capi_Ctype_A_001.hsc b/tests/ffi/should_run/Capi_Ctype_A_001.hsc new file mode 100644 index 0000000..103b264 --- /dev/null +++ b/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/tests/ffi/should_run/Makefile b/tests/ffi/should_run/Makefile index 3981cd2..8b5a9a5 100644 --- a/tests/ffi/should_run/Makefile +++ b/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/tests/ffi/should_run/all.T b/tests/ffi/should_run/all.T index 118a26f..1b61b34 100644 --- a/tests/ffi/should_run/all.T +++ b/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/tests/ffi/should_run/capi_ctype_001.c b/tests/ffi/should_run/capi_ctype_001.c new file mode 100644 index 0000000..970ea4b --- /dev/null +++ b/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/tests/ffi/should_run/capi_ctype_001.h b/tests/ffi/should_run/capi_ctype_001.h new file mode 100644 index 0000000..11add5b --- /dev/null +++ b/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 + _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
