[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