Add regression test for #11555
[ghc.git] / testsuite / tests / stranal / should_run / T11555a.hs
1 module Main(main) where
2
3 import Control.Monad
4 import Control.Exception
5 import Control.Monad.Trans.Cont
6 import GHC.Exts
7
8
9 type RAW a = ContT () IO a
10
11 -- See https://ghc.haskell.org/trac/ghc/ticket/11555
12 catchSafe1, catchSafe2 :: IO a -> (SomeException -> IO a) -> IO a
13 catchSafe1 a b = lazy a `catch` b
14 catchSafe2 a b = join (evaluate a) `catch` b
15
16 -- | Run and then call a continuation.
17 runRAW1, runRAW2 :: RAW a -> (Either SomeException a -> IO ()) -> IO ()
18 runRAW1 m k = m `runContT` (k . Right) `catchSafe1` \e -> k $ Left e
19 runRAW2 m k = m `runContT` (k . Right) `catchSafe2` \e -> k $ Left e
20
21 {-# NOINLINE run1 #-}
22 run1 :: RAW ()-> IO ()
23 run1 rs = do
24 runRAW1 rs $ \x -> case x of
25 Left e -> putStrLn "CAUGHT"
26 Right x -> return x
27
28 {-# NOINLINE run2 #-}
29 run2 :: RAW ()-> IO ()
30 run2 rs = do
31 runRAW2 rs $ \x -> case x of
32 Left e -> putStrLn "CAUGHT"
33 Right x -> return x
34
35 main :: IO ()
36 main = do
37 run1 $ error "MISSED"
38 run2 $ error "MISSED"