summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/codeGen/should_run/5129.hs
blob: 6bc1912754125aeb616bd4c01dcb598ba7f77990 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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