Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/5ba6997081dd2cba642e61d21d362d050e388e7a >--------------------------------------------------------------- commit 5ba6997081dd2cba642e61d21d362d050e388e7a Author: Simon Marlow <[email protected]> Date: Wed Jun 29 15:00:14 2011 +0100 Add test for #5129 >--------------------------------------------------------------- tests/ghc-regress/codeGen/should_run/5129.hs | 21 +++++++++++++++++++++ tests/ghc-regress/codeGen/should_run/all.T | 1 + 2 files changed, 22 insertions(+), 0 deletions(-) diff --git a/tests/ghc-regress/codeGen/should_run/5129.hs b/tests/ghc-regress/codeGen/should_run/5129.hs new file mode 100644 index 0000000..6bc1912 --- /dev/null +++ b/tests/ghc-regress/codeGen/should_run/5129.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DeriveDataTypeable #-} +import Control.Exception as E +import Data.Typeable + +throwIfNegative :: Int -> String +throwIfNegative n | n < 0 = error "negative" + | otherwise = "no worries" +{-# NOINLINE throwIfNegative #-} + +data HUnitFailure = HUnitFailure String deriving (Show,Typeable) +instance Exception HUnitFailure + +assertFailure msg = E.throw (HUnitFailure msg) + +case_negative = + handleJust errorCalls (const $ return ()) $ do + evaluate $ throwIfNegative (-1) + assertFailure "must throw when given a negative number" + where errorCalls (ErrorCall _) = Just () + +main = case_negative diff --git a/tests/ghc-regress/codeGen/should_run/all.T b/tests/ghc-regress/codeGen/should_run/all.T index c5c5829..c12de29 100644 --- a/tests/ghc-regress/codeGen/should_run/all.T +++ b/tests/ghc-regress/codeGen/should_run/all.T @@ -86,3 +86,4 @@ test('3677', extra_run_opts('+RTS -K8k -RTS'), compile_and_run, ['']) test('4441', normal, compile_and_run, ['']) test('5149', omit_ways(['ghci']), multisrc_compile_and_run, ['5149', ['5149_cmm.cmm'], '']) +test('5129', normal, compile_and_run, ['']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
