[commit: ghc] ghc-8.0: Add regression test for #11555 (a90c51f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/a90c51f155ff598dfc9cedf198db05560100864c/ghc

>---------------------------------------------------------------

commit a90c51f155ff598dfc9cedf198db05560100864c
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Fri Mar 11 11:20:43 2016 +0100

    Add regression test for #11555
    
    (cherry picked from commit c937f424e4acd61d1c558e8fe9b47e7d580fdbd8)


>---------------------------------------------------------------

a90c51f155ff598dfc9cedf198db05560100864c
 testsuite/tests/stranal/should_run/T11555a.hs     | 38 +++++++++++++++++++++++
 testsuite/tests/stranal/should_run/T11555a.stdout |  2 ++
 testsuite/tests/stranal/should_run/all.T          |  1 +
 3 files changed, 41 insertions(+)

diff --git a/testsuite/tests/stranal/should_run/T11555a.hs b/testsuite/tests/stranal/should_run/T11555a.hs
new file mode 100644
index 0000000..29f2a49
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T11555a.hs
@@ -0,0 +1,38 @@
+module Main(main) where
+
+import Control.Monad
+import Control.Exception
+import Control.Monad.Trans.Cont
+import GHC.Exts
+
+
+type RAW a = ContT () IO a
+
+-- See https://ghc.haskell.org/trac/ghc/ticket/11555
+catchSafe1, catchSafe2 :: IO a -> (SomeException -> IO a) -> IO a
+catchSafe1 a b = lazy a `catch` b
+catchSafe2 a b = join (evaluate a) `catch` b
+
+-- | Run and then call a continuation.
+runRAW1, runRAW2 :: RAW a -> (Either SomeException a -> IO ()) -> IO ()
+runRAW1 m k = m `runContT` (k . Right) `catchSafe1` \e -> k $ Left e
+runRAW2 m k = m `runContT` (k . Right) `catchSafe2` \e -> k $ Left e
+
+{-# NOINLINE run1 #-}
+run1 :: RAW ()-> IO ()
+run1 rs = do
+    runRAW1 rs $ \x -> case x of
+        Left e -> putStrLn "CAUGHT"
+        Right x -> return x
+
+{-# NOINLINE run2 #-}
+run2 :: RAW ()-> IO ()
+run2 rs = do
+    runRAW2 rs $ \x -> case x of
+        Left e -> putStrLn "CAUGHT"
+        Right x -> return x
+
+main :: IO ()
+main = do
+    run1 $ error "MISSED"
+    run2 $ error "MISSED"
diff --git a/testsuite/tests/stranal/should_run/T11555a.stdout b/testsuite/tests/stranal/should_run/T11555a.stdout
new file mode 100644
index 0000000..16ff8b4
--- /dev/null
+++ b/testsuite/tests/stranal/should_run/T11555a.stdout
@@ -0,0 +1,2 @@
+CAUGHT
+CAUGHT
diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T
index efd1afa..a4b550e 100644
--- a/testsuite/tests/stranal/should_run/all.T
+++ b/testsuite/tests/stranal/should_run/all.T
@@ -11,3 +11,4 @@ test('T9254', normal, compile_and_run, [''])
 test('T10148', normal, compile_and_run, [''])
 test('T10218', normal, compile_and_run, [''])
 test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm'])
+test('T11555a', normal, compile_and_run, [''])