1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
{-# LANGUAGE OverloadedStrings, CPP #-}
module Sound.Tidal.ExceptionsTest where
import Test.Microspec
import Control.Exception
import Control.DeepSeq
import Data.Typeable ()
import Prelude hiding ((<*), (*>))
import Sound.Tidal.Pattern
run :: Microspec ()
run =
describe "NFData, forcing and catching exceptions" $ do
describe "instance NFData (Pattern a)" $ do
it "rnf forces argument" $ do
evaluate (rnf (Pattern undefined :: Pattern ()))
`shouldThrow` anyException
-- copied from http://hackage.haskell.org/package/hspec-expectations-0.8.2/docs/src/Test-Hspec-Expectations.html#shouldThrow
shouldThrow :: (Exception e) => IO a -> Selector e -> Microspec ()
action `shouldThrow` p = prop "shouldThrow" $ monadicIO $ do
r <- Test.Microspec.run $ try action
case r of
Right _ ->
-- "finished normally, but should throw exception: " ++ exceptionType
Test.Microspec.assert False
Left e ->
-- "threw exception that did not meet expectation")
Test.Microspec.assert $ p e
where
-- a string repsentation of the expected exception's type
{-
exceptionType = (show . typeOf . instanceOf) p
where
instanceOf :: Selector a -> a
instanceOf _ = error "Test.Hspec.Expectations.shouldThrow: broken Typeable instance"
-}
-- |
-- A @Selector@ is a predicate; it can simultaneously constrain the type and
-- value of an exception.
type Selector a = (a -> Bool)
anyException :: Selector SomeException
anyException = const True
anyErrorCall :: Selector ErrorCall
anyErrorCall = const True
errorCall :: String -> Selector ErrorCall
#if MIN_VERSION_base(4,9,0)
errorCall s (ErrorCallWithLocation msg _) = s == msg
#else
errorCall s (ErrorCall msg) = s == msg
#endif
anyIOException :: Selector IOException
anyIOException = const True
anyArithException :: Selector ArithException
anyArithException = const True
|
