From 5af27e2ff1e6dff64d70b48cdb747d9d5d1e7578 Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Mon, 20 Aug 2012 13:43:32 +0100
Subject: add the test from #7160

---
 testsuite/tests/rts/T7160.hs     | 27 +++++++++++++++++++++++++++
 testsuite/tests/rts/T7160.stderr |  6 ++++++
 testsuite/tests/rts/all.T        |  1 +
 3 files changed, 34 insertions(+)
 create mode 100644 testsuite/tests/rts/T7160.hs
 create mode 100644 testsuite/tests/rts/T7160.stderr

(limited to 'testsuite/tests/rts')

diff --git a/testsuite/tests/rts/T7160.hs b/testsuite/tests/rts/T7160.hs
new file mode 100644
index 0000000000..8f5ef43ea8
--- /dev/null
+++ b/testsuite/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/testsuite/tests/rts/T7160.stderr b/testsuite/tests/rts/T7160.stderr
new file mode 100644
index 0000000000..ad3c9fd752
--- /dev/null
+++ b/testsuite/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/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 5f4874b25c..62de3b9255 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/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, [''])
-- 
cgit v1.2.1