diff options
Diffstat (limited to 'testsuite/tests/stranal')
-rw-r--r-- | testsuite/tests/stranal/should_run/T11555a.hs | 38 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_run/T11555a.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_run/all.T | 1 |
3 files changed, 41 insertions, 0 deletions
diff --git a/testsuite/tests/stranal/should_run/T11555a.hs b/testsuite/tests/stranal/should_run/T11555a.hs new file mode 100644 index 0000000000..29f2a49680 --- /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 0000000000..16ff8b462d --- /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 efd1afaa35..a4b550e698 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, ['']) |