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
67
68
69
70
71
|
HUnitLang98.lhs -- HUnit language support, generic Haskell 98 variant
Note: The Haskell system you use needs to find this file when looking
for module `HUnitLang`.
$Id: HUnitLang98.lhs,v 1.2 2002/02/14 19:27:56 heringto Exp $
> module HUnitLang
> (
> Assertion,
> assertFailure,
> performTestCase
> )
> where
When adapting this module for other Haskell language systems, change
the imports and the implementations but not the interfaces.
Imports
-------
> import List (isPrefixOf)
> import IO (ioeGetErrorString, try)
Interfaces
----------
An assertion is an `IO` computation with trivial result.
> type Assertion = IO ()
`assertFailure` signals an assertion failure with a given message.
> assertFailure :: String -> Assertion
`performTestCase` performs a single test case. The meaning of the
result is as follows:
Nothing test case success
Just (True, msg) test case failure with the given message
Just (False, msg) test case error with the given message
> performTestCase :: Assertion -> IO (Maybe (Bool, String))
Implementations
---------------
> hunitPrefix = "HUnit:"
> hugsPrefix = "IO Error: User error\nReason: "
> nhc98Prefix = "I/O error (user-defined), call to function `userError':\n "
> -- GHC prepends no prefix to the user-supplied string.
> assertFailure msg = ioError (userError (hunitPrefix ++ msg))
> performTestCase action = do r <- try action
> case r of Right () -> return Nothing
> Left e -> return (Just (decode e))
> where
> decode e = let s0 = ioeGetErrorString e
> (_, s1) = dropPrefix hugsPrefix s0
> (_, s2) = dropPrefix nhc98Prefix s1
> in dropPrefix hunitPrefix s2
> dropPrefix pref str = if pref `isPrefixOf` str
> then (True, drop (length pref) str)
> else (False, str)
|
