testsuite: Add test for #19149

(cherry picked from commit 61ce4261bb4c21ca5c41fcfc2107a81726cf22c1)

4 files changed, 51 insertions, 0 deletions

diff --git a/testsuite/tests/codeGen/should_run/T19149.hs b/testsuite/tests/codeGen/should_run/T19149.hs
new file mode 100644
index 0000000000..7b2ae5e500
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T19149.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeOperators #-}
+
+-- The idea:
+--
+--  1. Register a CAFfy foreign export
+--  2. Force a CAF reachable from the export
+--  3. Do a GC
+--  4. Then call the foreign export.
+
+import System.Mem
+import Foreign.C.Types
+
+x :: Integer
+x = fib 80
+{-# NOINLINE x #-}
+
+test_export :: IO CInt
+test_export = return $ fromIntegral x
+
+fib :: Int -> Integer
+fib 0 = 1
+fib 1 = 1
+fib n = go 1 1 n
+  where
+    go :: Integer -> Integer -> Int -> Integer
+    go !n0 !n1 0 = n1
+    go  n0  n1 i = let n0' = n1
+                       n1' = n0 + n1
+                   in go n0' n1' (i-1)
+{-# NOINLINE fib #-}
+
+foreign export ccall test_export :: IO CInt
+foreign import ccall test :: IO CInt
+
+main :: IO ()
+main = do
+  print (fromIntegral x :: CInt)
+  _ <- return $! fib 100000
+  performMajorGC
+  test >>= print
diff --git a/testsuite/tests/codeGen/should_run/T19149.stdout b/testsuite/tests/codeGen/should_run/T19149.stdout
new file mode 100644
index 0000000000..f727f60f19
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T19149.stdout
@@ -0,0 +1,2 @@
+-1230842041
+-1230842041
diff --git a/testsuite/tests/codeGen/should_run/T19149_c.c b/testsuite/tests/codeGen/should_run/T19149_c.c
new file mode 100644
index 0000000000..40ae39cce5
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T19149_c.c
@@ -0,0 +1,6 @@
+int test_export();
+
+int test() {
+  return test_export();
+}
+
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index 950901d742..f1c3887590 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -206,3 +206,4 @@ test('T16846', [only_ways(['optasm']), exit_code(1)], compile_and_run, [''])
 
 test('T17920', cmm_src, compile_and_run, [''])
 test('T18527', normal, compile_and_run, ['T18527FFI.c'])
+test('T19149', only_ways('sanity'), compile_and_run, ['T19149_c.c'])