From 162d106148aaafb30ceb823f7d1c5b2333e4d7d0 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 5 Apr 2006 16:01:29 +0000 Subject: [PATCH] add test for ForeignPtrEnv --- .../tests/ghc-regress/ccall/should_run/all.T | 2 ++ .../ghc-regress/ccall/should_run/ffi016.hs | 23 +++++++++++++++++++ .../ccall/should_run/ffi016.stdout | 1 + 3 files changed, 26 insertions(+) create mode 100644 testsuite/tests/ghc-regress/ccall/should_run/ffi016.hs create mode 100644 testsuite/tests/ghc-regress/ccall/should_run/ffi016.stdout diff --git a/testsuite/tests/ghc-regress/ccall/should_run/all.T b/testsuite/tests/ghc-regress/ccall/should_run/all.T index 333e961ae8..37f7523d88 100644 --- a/testsuite/tests/ghc-regress/ccall/should_run/all.T +++ b/testsuite/tests/ghc-regress/ccall/should_run/all.T @@ -88,3 +88,5 @@ test('ffi014', only_ways(['threaded']), compile_and_run, ['ffi014_cbits.c']) # GHCi can't handle the separate C file (ToDo: fix this somehow) test('ffi015', omit_ways(['ghci']), compile_and_run, ['ffi015_cbits.c']) + +test('ffi016', normal, compile_and_run, ['']) diff --git a/testsuite/tests/ghc-regress/ccall/should_run/ffi016.hs b/testsuite/tests/ghc-regress/ccall/should_run/ffi016.hs new file mode 100644 index 0000000000..03caf0e3b7 --- /dev/null +++ b/testsuite/tests/ghc-regress/ccall/should_run/ffi016.hs @@ -0,0 +1,23 @@ +-- Tests ForeignPtrEnv finalizers + +import Text.Printf +import Foreign.ForeignPtr +import Foreign +import GHC.TopHandler +import Control.Concurrent + +foreign export ccall fin :: Ptr Int -> Ptr Int -> IO () +foreign import ccall "&fin" finptr :: FinalizerEnvPtr Int Int + +fin :: Ptr Int -> Ptr Int -> IO () +fin envp ap = runIO $ do + env <- peek envp + a <- peek ap + printf "%d %d\n" env a + return () + +main = do + a <- new (55 :: Int) + env <- new (66 :: Int) + fp <- newForeignPtrEnv finptr env a + sum [1..1000000] `seq` return () diff --git a/testsuite/tests/ghc-regress/ccall/should_run/ffi016.stdout b/testsuite/tests/ghc-regress/ccall/should_run/ffi016.stdout new file mode 100644 index 0000000000..74b7c6f766 --- /dev/null +++ b/testsuite/tests/ghc-regress/ccall/should_run/ffi016.stdout @@ -0,0 +1 @@ +66 55 -- GitLab