Test Trac #3983

testsuite/tests/ghc-regress/simplCore/should_run/T3983.hs

+module Main where
+import T3983_Foo
+import T3983_Bar
+
+main = catchX (foo False True) >>= print
\ No newline at end of file

testsuite/tests/ghc-regress/simplCore/should_run/T3983.stdout

+False

testsuite/tests/ghc-regress/simplCore/should_run/T3983_Bar.hs

+{-# LANGUAGE DeriveDataTypeable #-}
+module T3983_Bar where
+import Data.Dynamic
+import Control.Exception
+import Control.Monad (unless)
+
+type Assertion = IO ()
+
+data X = X String deriving (Show, Typeable)
+
+instance Exception X
+
+throwX = throw.X
+
+catchX action = do { action; return True; } `catches` [Handler (\(X _) -> return False)]
\ No newline at end of file

testsuite/tests/ghc-regress/simplCore/should_run/T3983_Foo.hs

+module T3983_Foo where
+
+import Control.Monad (unless)
+import Control.Exception
+import T3983_Bar
+
+foo :: Bool -> Bool -> IO ()
+foo a b = unless a $ throwX (if b then "" else "")

testsuite/tests/ghc-regress/simplCore/should_run/all.T

@@ -33,3 +33,9 @@ test('SeqRule', only_ways(['optc','optasm']), compile_and_run, [''])
 
 test('T3403', normal, compile_and_run, ['-package containers'])
 test('T3591', normal, compile_and_run, [''])
+
+# Run this test *without* optimisation too
+test('T3983', [only_ways(['normal','optc','optasm']),
+               extra_clean(['T3983_Foo.hi','T3983_Foo.o','T3983_Bar.hi','T3983_Bar.o',])], 
+              multimod_compile_and_run, 
+              ['T3983',''])