diff options
author | Ben Gamari <ben@smart-cactus.org> | 2016-03-11 11:20:43 +0100 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2016-03-11 13:20:07 +0100 |
commit | c937f424e4acd61d1c558e8fe9b47e7d580fdbd8 (patch) | |
tree | 62bb54fcf369f734ffc3910e7a74b135a872ec8d /testsuite/tests/stranal | |
parent | fc16690a536b74e7af72e963599471474e3df603 (diff) | |
download | haskell-c937f424e4acd61d1c558e8fe9b47e7d580fdbd8.tar.gz |
Add regression test for #11555
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, ['']) |