Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b1325a715801aace0f47a205c4a66da8b2419d0b >--------------------------------------------------------------- commit b1325a715801aace0f47a205c4a66da8b2419d0b Author: Ian Lynagh <ig...@earth.li> Date: Fri Feb 17 15:55:40 2012 +0000 Add another test for CAPI / CTYPE This tests that the header given in the CTYPE pragma is handled. >--------------------------------------------------------------- tests/ffi/should_run/Capi_Ctype_002.hs | 19 +++++++++++++ .../should_run/Capi_Ctype_002.stdout} | 0 tests/ffi/should_run/Capi_Ctype_A_002.hsc | 28 ++++++++++++++++++++ tests/ffi/should_run/Makefile | 8 +++++ tests/ffi/should_run/all.T | 6 ++++ tests/ffi/should_run/capi_ctype_002_A.h | 12 ++++++++ tests/ffi/should_run/capi_ctype_002_B.h | 8 +++++ 7 files changed, 81 insertions(+), 0 deletions(-) diff --git a/tests/ffi/should_run/Capi_Ctype_002.hs b/tests/ffi/should_run/Capi_Ctype_002.hs new file mode 100644 index 0000000..4868ee2 --- /dev/null +++ b/tests/ffi/should_run/Capi_Ctype_002.hs @@ -0,0 +1,19 @@ + +{-# LANGUAGE CApiFFI #-} + +module Main (main) where + +import Capi_Ctype_A_002 + +import Foreign +import Foreign.C + +main :: IO () +main = alloca $ \p -> + do poke p (Foo 5 6 7) + r1 <- f p + print r1 + +foreign import capi unsafe "capi_ctype_002_B.h f" + f :: Ptr Foo -> IO CInt + diff --git a/tests/ghc-e/should_run/ghc-e004.stdout b/tests/ffi/should_run/Capi_Ctype_002.stdout similarity index 100% copy from tests/ghc-e/should_run/ghc-e004.stdout copy to tests/ffi/should_run/Capi_Ctype_002.stdout diff --git a/tests/ffi/should_run/Capi_Ctype_A_002.hsc b/tests/ffi/should_run/Capi_Ctype_A_002.hsc new file mode 100644 index 0000000..14da114 --- /dev/null +++ b/tests/ffi/should_run/Capi_Ctype_A_002.hsc @@ -0,0 +1,28 @@ + +{-# LANGUAGE CApiFFI #-} + +module Capi_Ctype_A_002 (Foo(..)) where + +#include "capi_ctype_002_A.h" + +import Foreign +import Foreign.C + +data {-# CTYPE "capi_ctype_002_A.h" "Foo" #-} + Foo = Foo { + i :: CInt, + j :: CInt, + k :: 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/Makefile b/tests/ffi/should_run/Makefile index 8b5a9a5..25a8db9 100644 --- a/tests/ffi/should_run/Makefile +++ b/tests/ffi/should_run/Makefile @@ -30,3 +30,11 @@ Capi_Ctype_001: '$(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 +.PHONY: Capi_Ctype_002 +Capi_Ctype_002: + '$(HSC2HS)' Capi_Ctype_A_002.hsc + '$(TEST_HC)' $(TEST_HC_OPTS) -c Capi_Ctype_A_002.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -c Capi_Ctype_002.hs + '$(TEST_HC)' $(TEST_HC_OPTS) Capi_Ctype_A_002.o Capi_Ctype_002.o -o Capi_Ctype_002 + ./Capi_Ctype_002 + diff --git a/tests/ffi/should_run/all.T b/tests/ffi/should_run/all.T index 1b61b34..e24472c 100644 --- a/tests/ffi/should_run/all.T +++ b/tests/ffi/should_run/all.T @@ -195,3 +195,9 @@ test('Capi_Ctype_001', run_command, ['$MAKE -s --no-print-directory Capi_Ctype_001']) +test('Capi_Ctype_002', + extra_clean(['Capi_Ctype_A_002.o', 'Capi_Ctype_A_002.hi', + 'Capi_Ctype_A_002.hs']), + run_command, + ['$MAKE -s --no-print-directory Capi_Ctype_002']) + diff --git a/tests/ffi/should_run/capi_ctype_002_A.h b/tests/ffi/should_run/capi_ctype_002_A.h new file mode 100644 index 0000000..26928a3 --- /dev/null +++ b/tests/ffi/should_run/capi_ctype_002_A.h @@ -0,0 +1,12 @@ + +#ifndef __capi_ctype_002_A_H__ +#define __capi_ctype_002_A_H__ + +typedef struct { + int i; + int j; + int k; +} Foo; + +#endif + diff --git a/tests/ffi/should_run/capi_ctype_002_B.h b/tests/ffi/should_run/capi_ctype_002_B.h new file mode 100644 index 0000000..6928290 --- /dev/null +++ b/tests/ffi/should_run/capi_ctype_002_B.h @@ -0,0 +1,8 @@ + +#ifndef __capi_ctype_002_B_H__ +#define __capi_ctype_002_B_H__ + +#define f(p) p->j + +#endif + _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
