[commit: testsuite] master: add the test from #7160 (a8e7143)
Simon Marlow
marlowsd at gmail.com
Tue Aug 21 14:18:03 CEST 2012
Repository : ssh://darcs.haskell.org//srv/darcs/testsuite
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/a8e7143bdc5ed401c41cc9a8a0a2a912923751e4
>---------------------------------------------------------------
commit a8e7143bdc5ed401c41cc9a8a0a2a912923751e4
Author: Simon Marlow <marlowsd at gmail.com>
Date: Mon Aug 20 13:43:32 2012 +0100
add the test from #7160
>---------------------------------------------------------------
tests/rts/T7160.hs | 27 +++++++++++++++++++++++++++
tests/rts/T7160.stderr | 6 ++++++
tests/rts/all.T | 1 +
3 files changed, 34 insertions(+), 0 deletions(-)
diff --git a/tests/rts/T7160.hs b/tests/rts/T7160.hs
new file mode 100644
index 0000000..8f5ef43
--- /dev/null
+++ b/tests/rts/T7160.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE ForeignFunctionInterface, MagicHash #-}
+import GHC.ForeignPtr
+import GHC.Ptr
+import System.Mem
+
+-- one should really use own C function rather than this varargs one to avoid
+-- possible ABI issues
+foreign import ccall "&debugBelch" fun :: FunPtr (Ptr () -> Ptr () -> IO ())
+
+new name = do
+ p <- newForeignPtr_ (Ptr name)
+ addForeignPtrFinalizerEnv fun (Ptr "finalizer 1 (%s)\n"#) p
+ addForeignPtrFinalizerEnv fun (Ptr "finalizer 2 (%s)\n"#) p
+ return p
+
+main = do
+ p <- new "p"#
+ q <- new "q"#
+ r <- new "r"#
+ performGC -- collect p. finalizer order: 2, then 1.
+-- print q
+ touchForeignPtr q
+ performGC -- collect q. finalizer order: 1, then 2.
+ -- expected order: 2, then 1.
+-- print r
+ touchForeignPtr r
+ performGC -- collect r. finalizer order: 2, then 1.
diff --git a/tests/rts/T7160.stderr b/tests/rts/T7160.stderr
new file mode 100644
index 0000000..ad3c9fd
--- /dev/null
+++ b/tests/rts/T7160.stderr
@@ -0,0 +1,6 @@
+finalizer 2 (p)
+finalizer 1 (p)
+finalizer 2 (q)
+finalizer 1 (q)
+finalizer 2 (r)
+finalizer 1 (r)
diff --git a/tests/rts/all.T b/tests/rts/all.T
index 5f4874b..62de3b9 100644
--- a/tests/rts/all.T
+++ b/tests/rts/all.T
@@ -149,3 +149,4 @@ test('T7037',
['$MAKE -s --no-print-directory T7037'])
test('7087', exit_code(1), compile_and_run, [''])
+test('T7160', normal, compile_and_run, [''])
More information about the Cvs-ghc
mailing list