Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/a93fcc994dc75642c39977021339d77480697604 >--------------------------------------------------------------- commit a93fcc994dc75642c39977021339d77480697604 Author: Ian Lynagh <[email protected]> Date: Fri Sep 30 17:22:41 2011 +0100 Add some tests for handling of FFI types >--------------------------------------------------------------- tests/ffi/should_compile/all.T | 1 + tests/ffi/should_compile/cc015.hs | 31 +++++++++++++++++++++++++++++++ 2 files changed, 32 insertions(+), 0 deletions(-) diff --git a/tests/ffi/should_compile/all.T b/tests/ffi/should_compile/all.T index ff8bc64..0c97827 100644 --- a/tests/ffi/should_compile/all.T +++ b/tests/ffi/should_compile/all.T @@ -36,3 +36,4 @@ test('ffi-deriv1', normal, compile, ['']) test('1357', normal, compile, ['']) test('3624', normal, compile, ['']) test('3742', normal, compile, ['']) +test('cc015', normal, compile, ['']) diff --git a/tests/ffi/should_compile/cc015.hs b/tests/ffi/should_compile/cc015.hs new file mode 100644 index 0000000..df724e0 --- /dev/null +++ b/tests/ffi/should_compile/cc015.hs @@ -0,0 +1,31 @@ + +{-# LANGUAGE TypeFamilies #-} + +module Cc015 where + +type S a = a +type IOS a = IO a + +type family F a +type instance F Int = Int +type instance F Bool = G2 + +newtype G1 = G1 Int +newtype G1F = G1F (F (S Int)) +newtype G2 = G2 Char +newtype G3 = G3 (IO Int) +newtype G4 = G4 G3 + +-- Type synonyms should be transparent to the typechecker +foreign import ccall f1 :: S Int -> IOS Int +foreign export ccall "g1" f1 :: S Int -> IOS Int +-- As should type functions +foreign import ccall f2 :: F Int -> IO (F Int) +foreign export ccall "g2" f2 :: F Int -> IO (F Int) +-- And newtype +foreign import ccall f3 :: G1 -> G2 -> G4 +foreign export ccall "g3" f3 :: G1 -> G2 -> G4 +-- And a combination +foreign import ccall f4 :: G1F -> F Bool -> S G4 +foreign export ccall "g4" f4 :: G1F -> F Bool -> S G4 + _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
