Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
https://github.com/ghc/testsuite/commit/6b30a324317ce185baf0a913f08dfebd414182d4 >--------------------------------------------------------------- commit 6b30a324317ce185baf0a913f08dfebd414182d4 Author: Simon Peyton Jones <[email protected]> Date: Wed May 22 20:36:33 2013 +0100 Test Trac #7924 >--------------------------------------------------------------- tests/simplCore/should_run/T7924.hs | 20 ++++++++++++++++++++ tests/simplCore/should_run/T7924.stderr | 1 + tests/simplCore/should_run/all.T | 2 ++ 3 files changed, 23 insertions(+), 0 deletions(-) diff --git a/tests/simplCore/should_run/T7924.hs b/tests/simplCore/should_run/T7924.hs new file mode 100644 index 0000000..d06a2d2 --- /dev/null +++ b/tests/simplCore/should_run/T7924.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DeriveDataTypeable #-} +module Main where +import Control.Exception (throwIO, Exception) +import Control.Monad (when) +import Data.Typeable (Typeable) + +data Boom = Boom deriving (Show, Typeable) +instance Exception Boom + +main = do + args <- return [] + + -- Should throw this exception. + when (length args /= 1) (throwIO Boom) + + -- With -O, instead throws this one from head []. + let n = read (head args) + print (n :: Int) + + return () \ No newline at end of file diff --git a/tests/simplCore/should_run/T7924.stderr b/tests/simplCore/should_run/T7924.stderr new file mode 100644 index 0000000..8f269f7 --- /dev/null +++ b/tests/simplCore/should_run/T7924.stderr @@ -0,0 +1 @@ +T7924: Boom diff --git a/tests/simplCore/should_run/all.T b/tests/simplCore/should_run/all.T index fa1dddd..32f78fa 100644 --- a/tests/simplCore/should_run/all.T +++ b/tests/simplCore/should_run/all.T @@ -57,3 +57,5 @@ test('T5915', only_ways(['normal','optasm']), compile_and_run, ['']) test('T5920', only_ways(['normal','optasm']), compile_and_run, ['']) test('T5997', normal, compile_and_run, ['']) test('T7101', normal, compile_and_run, ['']) +test('T7924', exit_code(1), compile_and_run, ['']) + _______________________________________________ ghc-commits mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-commits
