| 1 | Thu Jan 15 01:26:38 MST 2009 richardg@richardg.name |
|---|
| 2 | * FIX #1632 (Test.HUnit documentation) |
|---|
| 3 | Added documentation and integrated tests |
|---|
| 4 | Converted the literate files to non-literate files. |
|---|
| 5 | Added Haddock documentation. |
|---|
| 6 | Added summary to Test.HUnit module. |
|---|
| 7 | Made it so that tests are built when the rest of the package is. |
|---|
| 8 | Integrated tests so that Cabal will run them. Cabal will not |
|---|
| 9 | install the testing executables. |
|---|
| 10 | |
|---|
| 11 | New patches: |
|---|
| 12 | |
|---|
| 13 | [FIX #1632 (Test.HUnit documentation) |
|---|
| 14 | richardg@richardg.name**20090115082638 |
|---|
| 15 | Added documentation and integrated tests |
|---|
| 16 | Converted the literate files to non-literate files. |
|---|
| 17 | Added Haddock documentation. |
|---|
| 18 | Added summary to Test.HUnit module. |
|---|
| 19 | Made it so that tests are built when the rest of the package is. |
|---|
| 20 | Integrated tests so that Cabal will run them. Cabal will not |
|---|
| 21 | install the testing executables. |
|---|
| 22 | ] { |
|---|
| 23 | addfile ./Test/HUnit.hs |
|---|
| 24 | hunk ./Test/HUnit.lhs 1 |
|---|
| 25 | -HUnit.lhs -- interface module for HUnit |
|---|
| 26 | - |
|---|
| 27 | -> module Test.HUnit |
|---|
| 28 | -> ( |
|---|
| 29 | -> module Test.HUnit.Base, |
|---|
| 30 | -> module Test.HUnit.Text |
|---|
| 31 | -> ) |
|---|
| 32 | -> where |
|---|
| 33 | - |
|---|
| 34 | -> import Test.HUnit.Base |
|---|
| 35 | -> import Test.HUnit.Text |
|---|
| 36 | rmfile ./Test/HUnit.lhs |
|---|
| 37 | addfile ./Test/HUnit/Base.hs |
|---|
| 38 | hunk ./Test/HUnit/Base.lhs 1 |
|---|
| 39 | -HUnitBase.lhs -- basic definitions |
|---|
| 40 | - |
|---|
| 41 | -> module Test.HUnit.Base |
|---|
| 42 | -> ( |
|---|
| 43 | -> {- from Test.HUnit.Lang: -} Assertion, assertFailure, |
|---|
| 44 | -> assertString, assertBool, assertEqual, |
|---|
| 45 | -> Assertable(..), ListAssertable(..), |
|---|
| 46 | -> AssertionPredicate, AssertionPredicable(..), |
|---|
| 47 | -> (@?), (@=?), (@?=), |
|---|
| 48 | -> Test(..), Node(..), Path, |
|---|
| 49 | -> testCaseCount, |
|---|
| 50 | -> Testable(..), |
|---|
| 51 | -> (~?), (~=?), (~?=), (~:), |
|---|
| 52 | -> Counts(..), State(..), |
|---|
| 53 | -> ReportStart, ReportProblem, |
|---|
| 54 | -> testCasePaths, |
|---|
| 55 | -> performTest |
|---|
| 56 | -> ) |
|---|
| 57 | -> where |
|---|
| 58 | - |
|---|
| 59 | -> import Control.Monad (unless, foldM) |
|---|
| 60 | - |
|---|
| 61 | - |
|---|
| 62 | -Assertion Definition |
|---|
| 63 | -==================== |
|---|
| 64 | - |
|---|
| 65 | -> import Test.HUnit.Lang |
|---|
| 66 | - |
|---|
| 67 | - |
|---|
| 68 | -Conditional Assertion Functions |
|---|
| 69 | -------------------------------- |
|---|
| 70 | - |
|---|
| 71 | -> assertBool :: String -> Bool -> Assertion |
|---|
| 72 | -> assertBool msg b = unless b (assertFailure msg) |
|---|
| 73 | - |
|---|
| 74 | -> assertString :: String -> Assertion |
|---|
| 75 | -> assertString s = unless (null s) (assertFailure s) |
|---|
| 76 | - |
|---|
| 77 | -> assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion |
|---|
| 78 | -> assertEqual preface expected actual = |
|---|
| 79 | -> unless (actual == expected) (assertFailure msg) |
|---|
| 80 | -> where msg = (if null preface then "" else preface ++ "\n") ++ |
|---|
| 81 | -> "expected: " ++ show expected ++ "\n but got: " ++ show actual |
|---|
| 82 | - |
|---|
| 83 | - |
|---|
| 84 | -Overloaded `assert` Function |
|---|
| 85 | ----------------------------- |
|---|
| 86 | - |
|---|
| 87 | -> class Assertable t |
|---|
| 88 | -> where assert :: t -> Assertion |
|---|
| 89 | - |
|---|
| 90 | -> instance Assertable () |
|---|
| 91 | -> where assert = return |
|---|
| 92 | - |
|---|
| 93 | -> instance Assertable Bool |
|---|
| 94 | -> where assert = assertBool "" |
|---|
| 95 | - |
|---|
| 96 | -> instance (ListAssertable t) => Assertable [t] |
|---|
| 97 | -> where assert = listAssert |
|---|
| 98 | - |
|---|
| 99 | -> instance (Assertable t) => Assertable (IO t) |
|---|
| 100 | -> where assert = (>>= assert) |
|---|
| 101 | - |
|---|
| 102 | -We define the assertability of `[Char]` (that is, `String`) and leave |
|---|
| 103 | -other types of list to possible user extension. |
|---|
| 104 | - |
|---|
| 105 | -> class ListAssertable t |
|---|
| 106 | -> where listAssert :: [t] -> Assertion |
|---|
| 107 | - |
|---|
| 108 | -> instance ListAssertable Char |
|---|
| 109 | -> where listAssert = assertString |
|---|
| 110 | - |
|---|
| 111 | - |
|---|
| 112 | -Overloaded `assertionPredicate` Function |
|---|
| 113 | ----------------------------------------- |
|---|
| 114 | - |
|---|
| 115 | -> type AssertionPredicate = IO Bool |
|---|
| 116 | - |
|---|
| 117 | -> class AssertionPredicable t |
|---|
| 118 | -> where assertionPredicate :: t -> AssertionPredicate |
|---|
| 119 | - |
|---|
| 120 | -> instance AssertionPredicable Bool |
|---|
| 121 | -> where assertionPredicate = return |
|---|
| 122 | - |
|---|
| 123 | -> instance (AssertionPredicable t) => AssertionPredicable (IO t) |
|---|
| 124 | -> where assertionPredicate = (>>= assertionPredicate) |
|---|
| 125 | - |
|---|
| 126 | - |
|---|
| 127 | -Assertion Construction Operators |
|---|
| 128 | --------------------------------- |
|---|
| 129 | - |
|---|
| 130 | -> infix 1 @?, @=?, @?= |
|---|
| 131 | - |
|---|
| 132 | -> (@?) :: (AssertionPredicable t) => t -> String -> Assertion |
|---|
| 133 | -> pred @? msg = assertionPredicate pred >>= assertBool msg |
|---|
| 134 | - |
|---|
| 135 | -> (@=?) :: (Eq a, Show a) => a -> a -> Assertion |
|---|
| 136 | -> expected @=? actual = assertEqual "" expected actual |
|---|
| 137 | - |
|---|
| 138 | -> (@?=) :: (Eq a, Show a) => a -> a -> Assertion |
|---|
| 139 | -> actual @?= expected = assertEqual "" expected actual |
|---|
| 140 | - |
|---|
| 141 | - |
|---|
| 142 | - |
|---|
| 143 | -Test Definition |
|---|
| 144 | -=============== |
|---|
| 145 | - |
|---|
| 146 | -> data Test = TestCase Assertion |
|---|
| 147 | -> | TestList [Test] |
|---|
| 148 | -> | TestLabel String Test |
|---|
| 149 | - |
|---|
| 150 | -> instance Show Test where |
|---|
| 151 | -> showsPrec p (TestCase _) = showString "TestCase _" |
|---|
| 152 | -> showsPrec p (TestList ts) = showString "TestList " . showList ts |
|---|
| 153 | -> showsPrec p (TestLabel l t) = showString "TestLabel " . showString l |
|---|
| 154 | -> . showChar ' ' . showsPrec p t |
|---|
| 155 | - |
|---|
| 156 | -> testCaseCount :: Test -> Int |
|---|
| 157 | -> testCaseCount (TestCase _) = 1 |
|---|
| 158 | -> testCaseCount (TestList ts) = sum (map testCaseCount ts) |
|---|
| 159 | -> testCaseCount (TestLabel _ t) = testCaseCount t |
|---|
| 160 | - |
|---|
| 161 | - |
|---|
| 162 | -> data Node = ListItem Int | Label String |
|---|
| 163 | -> deriving (Eq, Show, Read) |
|---|
| 164 | - |
|---|
| 165 | -> type Path = [Node] -- Node order is from test case to root. |
|---|
| 166 | - |
|---|
| 167 | - |
|---|
| 168 | -> testCasePaths :: Test -> [Path] |
|---|
| 169 | -> testCasePaths t = tcp t [] |
|---|
| 170 | -> where tcp (TestCase _) p = [p] |
|---|
| 171 | -> tcp (TestList ts) p = |
|---|
| 172 | -> concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ] |
|---|
| 173 | -> tcp (TestLabel l t) p = tcp t (Label l : p) |
|---|
| 174 | - |
|---|
| 175 | - |
|---|
| 176 | -Overloaded `test` Function |
|---|
| 177 | --------------------------- |
|---|
| 178 | - |
|---|
| 179 | -> class Testable t |
|---|
| 180 | -> where test :: t -> Test |
|---|
| 181 | - |
|---|
| 182 | -> instance Testable Test |
|---|
| 183 | -> where test = id |
|---|
| 184 | - |
|---|
| 185 | -> instance (Assertable t) => Testable (IO t) |
|---|
| 186 | -> where test = TestCase . assert |
|---|
| 187 | - |
|---|
| 188 | -> instance (Testable t) => Testable [t] |
|---|
| 189 | -> where test = TestList . map test |
|---|
| 190 | - |
|---|
| 191 | - |
|---|
| 192 | -Test Construction Operators |
|---|
| 193 | ---------------------------- |
|---|
| 194 | - |
|---|
| 195 | -> infix 1 ~?, ~=?, ~?= |
|---|
| 196 | -> infixr 0 ~: |
|---|
| 197 | - |
|---|
| 198 | -> (~?) :: (AssertionPredicable t) => t -> String -> Test |
|---|
| 199 | -> pred ~? msg = TestCase (pred @? msg) |
|---|
| 200 | - |
|---|
| 201 | -> (~=?) :: (Eq a, Show a) => a -> a -> Test |
|---|
| 202 | -> expected ~=? actual = TestCase (expected @=? actual) |
|---|
| 203 | - |
|---|
| 204 | -> (~?=) :: (Eq a, Show a) => a -> a -> Test |
|---|
| 205 | -> actual ~?= expected = TestCase (actual @?= expected) |
|---|
| 206 | - |
|---|
| 207 | -> (~:) :: (Testable t) => String -> t -> Test |
|---|
| 208 | -> label ~: t = TestLabel label (test t) |
|---|
| 209 | - |
|---|
| 210 | - |
|---|
| 211 | - |
|---|
| 212 | -Test Execution |
|---|
| 213 | -============== |
|---|
| 214 | - |
|---|
| 215 | -> data Counts = Counts { cases, tried, errors, failures :: Int } |
|---|
| 216 | -> deriving (Eq, Show, Read) |
|---|
| 217 | - |
|---|
| 218 | -> data State = State { path :: Path, counts :: Counts } |
|---|
| 219 | -> deriving (Eq, Show, Read) |
|---|
| 220 | - |
|---|
| 221 | -> type ReportStart us = State -> us -> IO us |
|---|
| 222 | - |
|---|
| 223 | -> type ReportProblem us = String -> State -> us -> IO us |
|---|
| 224 | - |
|---|
| 225 | - |
|---|
| 226 | -Note that the counts in a start report do not include the test case |
|---|
| 227 | -being started, whereas the counts in a problem report do include the |
|---|
| 228 | -test case just finished. The principle is that the counts are sampled |
|---|
| 229 | -only between test case executions. As a result, the number of test |
|---|
| 230 | -case successes always equals the difference of test cases tried and |
|---|
| 231 | -the sum of test case errors and failures. |
|---|
| 232 | - |
|---|
| 233 | - |
|---|
| 234 | -> performTest :: ReportStart us -> ReportProblem us -> ReportProblem us |
|---|
| 235 | -> -> us -> Test -> IO (Counts, us) |
|---|
| 236 | -> performTest reportStart reportError reportFailure us t = do |
|---|
| 237 | -> (ss', us') <- pt initState us t |
|---|
| 238 | -> unless (null (path ss')) $ error "performTest: Final path is nonnull" |
|---|
| 239 | -> return (counts ss', us') |
|---|
| 240 | -> where |
|---|
| 241 | -> initState = State{ path = [], counts = initCounts } |
|---|
| 242 | -> initCounts = Counts{ cases = testCaseCount t, tried = 0, |
|---|
| 243 | -> errors = 0, failures = 0} |
|---|
| 244 | - |
|---|
| 245 | -> pt ss us (TestCase a) = do |
|---|
| 246 | -> us' <- reportStart ss us |
|---|
| 247 | -> r <- performTestCase a |
|---|
| 248 | -> case r of Nothing -> do return (ss', us') |
|---|
| 249 | -> Just (True, m) -> do usF <- reportFailure m ssF us' |
|---|
| 250 | -> return (ssF, usF) |
|---|
| 251 | -> Just (False, m) -> do usE <- reportError m ssE us' |
|---|
| 252 | -> return (ssE, usE) |
|---|
| 253 | -> where c@Counts{ tried = t } = counts ss |
|---|
| 254 | -> ss' = ss{ counts = c{ tried = t + 1 } } |
|---|
| 255 | -> ssF = ss{ counts = c{ tried = t + 1, failures = failures c + 1 } } |
|---|
| 256 | -> ssE = ss{ counts = c{ tried = t + 1, errors = errors c + 1 } } |
|---|
| 257 | - |
|---|
| 258 | -> pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..]) |
|---|
| 259 | -> where f (ss, us) (t, n) = withNode (ListItem n) ss us t |
|---|
| 260 | - |
|---|
| 261 | -> pt ss us (TestLabel label t) = withNode (Label label) ss us t |
|---|
| 262 | - |
|---|
| 263 | -> withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t |
|---|
| 264 | -> return (ss2{ path = path0 }, us1) |
|---|
| 265 | -> where path0 = path ss0 |
|---|
| 266 | -> ss1 = ss0{ path = node : path0 } |
|---|
| 267 | rmfile ./Test/HUnit/Base.lhs |
|---|
| 268 | addfile ./Test/HUnit/Lang.hs |
|---|
| 269 | hunk ./Test/HUnit/Lang.lhs 1 |
|---|
| 270 | -Test/HUnit/Lang.lhs -- HUnit language support. |
|---|
| 271 | - |
|---|
| 272 | -> module Test.HUnit.Lang |
|---|
| 273 | -> ( |
|---|
| 274 | -> Assertion, |
|---|
| 275 | -> assertFailure, |
|---|
| 276 | -> performTestCase |
|---|
| 277 | -> ) |
|---|
| 278 | -> where |
|---|
| 279 | - |
|---|
| 280 | - |
|---|
| 281 | -When adapting this module for other Haskell language systems, change |
|---|
| 282 | -the imports and the implementations but not the interfaces. |
|---|
| 283 | - |
|---|
| 284 | - |
|---|
| 285 | - |
|---|
| 286 | -Imports |
|---|
| 287 | -------- |
|---|
| 288 | - |
|---|
| 289 | -> import Data.List (isPrefixOf) |
|---|
| 290 | -#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) |
|---|
| 291 | -> import Data.Dynamic |
|---|
| 292 | -> import Control.Exception as E |
|---|
| 293 | -#else |
|---|
| 294 | -> import System.IO.Error (ioeGetErrorString, try) |
|---|
| 295 | -#endif |
|---|
| 296 | - |
|---|
| 297 | - |
|---|
| 298 | - |
|---|
| 299 | -Interfaces |
|---|
| 300 | ----------- |
|---|
| 301 | - |
|---|
| 302 | -An assertion is an `IO` computation with trivial result. |
|---|
| 303 | - |
|---|
| 304 | -> type Assertion = IO () |
|---|
| 305 | - |
|---|
| 306 | -`assertFailure` signals an assertion failure with a given message. |
|---|
| 307 | - |
|---|
| 308 | -> assertFailure :: String -> Assertion |
|---|
| 309 | - |
|---|
| 310 | -`performTestCase` performs a single test case. The meaning of the |
|---|
| 311 | -result is as follows: |
|---|
| 312 | - Nothing test case success |
|---|
| 313 | - Just (True, msg) test case failure with the given message |
|---|
| 314 | - Just (False, msg) test case error with the given message |
|---|
| 315 | - |
|---|
| 316 | -> performTestCase :: Assertion -> IO (Maybe (Bool, String)) |
|---|
| 317 | - |
|---|
| 318 | - |
|---|
| 319 | -Implementations |
|---|
| 320 | ---------------- |
|---|
| 321 | - |
|---|
| 322 | -#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) |
|---|
| 323 | -> data HUnitFailure = HUnitFailure String |
|---|
| 324 | -> deriving Show |
|---|
| 325 | -> |
|---|
| 326 | -> hunitFailureTc :: TyCon |
|---|
| 327 | -> hunitFailureTc = mkTyCon "HUnitFailure" |
|---|
| 328 | -> {-# NOINLINE hunitFailureTc #-} |
|---|
| 329 | -> |
|---|
| 330 | -> instance Typeable HUnitFailure where |
|---|
| 331 | -> typeOf _ = mkTyConApp hunitFailureTc [] |
|---|
| 332 | -#ifdef BASE4 |
|---|
| 333 | -> instance Exception HUnitFailure |
|---|
| 334 | - |
|---|
| 335 | -> assertFailure msg = E.throw (HUnitFailure msg) |
|---|
| 336 | - |
|---|
| 337 | -> performTestCase action = |
|---|
| 338 | -> do action |
|---|
| 339 | -> return Nothing |
|---|
| 340 | -> `E.catches` |
|---|
| 341 | -> [E.Handler (\(HUnitFailure msg) -> return $ Just (True, msg)), |
|---|
| 342 | -> E.Handler (\e -> return $ Just (False, show (e :: E.SomeException)))] |
|---|
| 343 | -#else |
|---|
| 344 | -> assertFailure msg = E.throwDyn (HUnitFailure msg) |
|---|
| 345 | - |
|---|
| 346 | -> performTestCase action = |
|---|
| 347 | -> do r <- E.try action |
|---|
| 348 | -> case r of |
|---|
| 349 | -> Right () -> return Nothing |
|---|
| 350 | -> Left e@(E.DynException dyn) -> |
|---|
| 351 | -> case fromDynamic dyn of |
|---|
| 352 | -> Just (HUnitFailure msg) -> return $ Just (True, msg) |
|---|
| 353 | -> Nothing -> return $ Just (False, show e) |
|---|
| 354 | -> Left e -> return $ Just (False, show e) |
|---|
| 355 | -#endif |
|---|
| 356 | -#else |
|---|
| 357 | -> hunitPrefix = "HUnit:" |
|---|
| 358 | - |
|---|
| 359 | -> nhc98Prefix = "I/O error (user-defined), call to function `userError':\n " |
|---|
| 360 | - |
|---|
| 361 | -> assertFailure msg = ioError (userError (hunitPrefix ++ msg)) |
|---|
| 362 | - |
|---|
| 363 | -> performTestCase action = do r <- try action |
|---|
| 364 | -> case r of Right () -> return Nothing |
|---|
| 365 | -> Left e -> return (Just (decode e)) |
|---|
| 366 | -> where |
|---|
| 367 | -> decode e = let s0 = ioeGetErrorString e |
|---|
| 368 | -> (_, s1) = dropPrefix nhc98Prefix s0 |
|---|
| 369 | -> in dropPrefix hunitPrefix s1 |
|---|
| 370 | -> dropPrefix pref str = if pref `isPrefixOf` str |
|---|
| 371 | -> then (True, drop (length pref) str) |
|---|
| 372 | -> else (False, str) |
|---|
| 373 | -#endif |
|---|
| 374 | rmfile ./Test/HUnit/Lang.lhs |
|---|
| 375 | addfile ./Test/HUnit/Terminal.hs |
|---|
| 376 | hunk ./Test/HUnit/Terminal.lhs 1 |
|---|
| 377 | -> module Test.HUnit.Terminal |
|---|
| 378 | -> ( |
|---|
| 379 | -> terminalAppearance |
|---|
| 380 | -> ) |
|---|
| 381 | -> where |
|---|
| 382 | - |
|---|
| 383 | -> import Data.Char (isPrint) |
|---|
| 384 | - |
|---|
| 385 | - |
|---|
| 386 | -Simplifies the input string by interpreting '\r' and '\b' characters |
|---|
| 387 | -specially so that the result string has the same final (or "terminal", |
|---|
| 388 | -pun intended) appearance as would the input string when written to a |
|---|
| 389 | -terminal that overwrites character positions following carriage |
|---|
| 390 | -returns and backspaces. |
|---|
| 391 | - |
|---|
| 392 | -The helper function `ta` takes an accumulating `ShowS`-style function |
|---|
| 393 | -that holds "committed" lines of text, a (reversed) list of characters |
|---|
| 394 | -on the current line *before* the cursor, a (normal) list of characters |
|---|
| 395 | -on the current line *after* the cursor, and the remaining input. |
|---|
| 396 | - |
|---|
| 397 | -> terminalAppearance :: String -> String |
|---|
| 398 | -> terminalAppearance str = ta id "" "" str |
|---|
| 399 | -> where |
|---|
| 400 | -> ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs |
|---|
| 401 | -> ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs |
|---|
| 402 | -> ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs |
|---|
| 403 | -> ta f "" as ('\b':cs) = error "'\\b' at beginning of line" |
|---|
| 404 | -> ta f bs as (c:cs) | not (isPrint c) = error "invalid nonprinting character" |
|---|
| 405 | -> | null as = ta f (c:bs) "" cs |
|---|
| 406 | -> | otherwise = ta f (c:bs) (tail as) cs |
|---|
| 407 | -> ta f bs as "" = f (reverse bs ++ as) |
|---|
| 408 | rmfile ./Test/HUnit/Terminal.lhs |
|---|
| 409 | addfile ./Test/HUnit/Text.hs |
|---|
| 410 | hunk ./Test/HUnit/Text.lhs 1 |
|---|
| 411 | -HUnitText.lhs -- text-based test controller |
|---|
| 412 | - |
|---|
| 413 | -> module Test.HUnit.Text |
|---|
| 414 | -> ( |
|---|
| 415 | -> PutText(..), |
|---|
| 416 | -> putTextToHandle, putTextToShowS, |
|---|
| 417 | -> runTestText, |
|---|
| 418 | -> showPath, showCounts, |
|---|
| 419 | -> runTestTT |
|---|
| 420 | -> ) |
|---|
| 421 | -> where |
|---|
| 422 | - |
|---|
| 423 | -> import Test.HUnit.Base |
|---|
| 424 | - |
|---|
| 425 | -> import Control.Monad (when) |
|---|
| 426 | -> import System.IO (Handle, stderr, hPutStr, hPutStrLn) |
|---|
| 427 | - |
|---|
| 428 | - |
|---|
| 429 | -As the general text-based test controller (`runTestText`) executes a |
|---|
| 430 | -test, it reports each test case start, error, and failure by |
|---|
| 431 | -constructing a string and passing it to the function embodied in a |
|---|
| 432 | -`PutText`. A report string is known as a "line", although it includes |
|---|
| 433 | -no line terminator; the function in a `PutText` is responsible for |
|---|
| 434 | -terminating lines appropriately. Besides the line, the function |
|---|
| 435 | -receives a flag indicating the intended "persistence" of the line: |
|---|
| 436 | -`True` indicates that the line should be part of the final overall |
|---|
| 437 | -report; `False` indicates that the line merely indicates progress of |
|---|
| 438 | -the test execution. Each progress line shows the current values of |
|---|
| 439 | -the cumulative test execution counts; a final, persistent line shows |
|---|
| 440 | -the final count values. |
|---|
| 441 | - |
|---|
| 442 | -The `PutText` function is also passed, and returns, an arbitrary state |
|---|
| 443 | -value (called `st` here). The initial state value is given in the |
|---|
| 444 | -`PutText`; the final value is returned by `runTestText`. |
|---|
| 445 | - |
|---|
| 446 | -> data PutText st = PutText (String -> Bool -> st -> IO st) st |
|---|
| 447 | - |
|---|
| 448 | - |
|---|
| 449 | -Two reporting schemes are defined here. `putTextToHandle` writes |
|---|
| 450 | -report lines to a given handle. `putTextToShowS` accumulates |
|---|
| 451 | -persistent lines for return as a whole by `runTestText`. |
|---|
| 452 | - |
|---|
| 453 | - |
|---|
| 454 | -`putTextToHandle` writes persistent lines to the given handle, |
|---|
| 455 | -following each by a newline character. In addition, if the given flag |
|---|
| 456 | -is `True`, it writes progress lines to the handle as well. A progress |
|---|
| 457 | -line is written with no line termination, so that it can be |
|---|
| 458 | -overwritten by the next report line. As overwriting involves writing |
|---|
| 459 | -carriage return and blank characters, its proper effect is usually |
|---|
| 460 | -only obtained on terminal devices. |
|---|
| 461 | - |
|---|
| 462 | -> putTextToHandle :: Handle -> Bool -> PutText Int |
|---|
| 463 | -> putTextToHandle handle showProgress = PutText put initCnt |
|---|
| 464 | -> where |
|---|
| 465 | -> initCnt = if showProgress then 0 else -1 |
|---|
| 466 | -> put line pers (-1) = do when pers (hPutStrLn handle line); return (-1) |
|---|
| 467 | -> put line True cnt = do hPutStrLn handle (erase cnt ++ line); return 0 |
|---|
| 468 | -> put line False cnt = do hPutStr handle ('\r' : line); return (length line) |
|---|
| 469 | -> -- The "erasing" strategy with a single '\r' relies on the fact that the |
|---|
| 470 | -> -- lengths of successive summary lines are monotonically nondecreasing. |
|---|
| 471 | -> erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" |
|---|
| 472 | - |
|---|
| 473 | - |
|---|
| 474 | -`putTextToShowS` accumulates persistent lines (dropping progess lines) |
|---|
| 475 | -for return by `runTestText`. The accumulated lines are represented by |
|---|
| 476 | -a `ShowS` (`String -> String`) function whose first argument is the |
|---|
| 477 | -string to be appended to the accumulated report lines. |
|---|
| 478 | - |
|---|
| 479 | -> putTextToShowS :: PutText ShowS |
|---|
| 480 | -> putTextToShowS = PutText put id |
|---|
| 481 | -> where put line pers f = return (if pers then acc f line else f) |
|---|
| 482 | -> acc f line tail = f (line ++ '\n' : tail) |
|---|
| 483 | - |
|---|
| 484 | - |
|---|
| 485 | -`runTestText` executes a test, processing each report line according |
|---|
| 486 | -to the given reporting scheme. The reporting scheme's state is |
|---|
| 487 | -threaded through calls to the reporting scheme's function and finally |
|---|
| 488 | -returned, along with final count values. |
|---|
| 489 | - |
|---|
| 490 | -> runTestText :: PutText st -> Test -> IO (Counts, st) |
|---|
| 491 | -> runTestText (PutText put us) t = do |
|---|
| 492 | -> (counts, us') <- performTest reportStart reportError reportFailure us t |
|---|
| 493 | -> us'' <- put (showCounts counts) True us' |
|---|
| 494 | -> return (counts, us'') |
|---|
| 495 | -> where |
|---|
| 496 | -> reportStart ss us = put (showCounts (counts ss)) False us |
|---|
| 497 | -> reportError = reportProblem "Error:" "Error in: " |
|---|
| 498 | -> reportFailure = reportProblem "Failure:" "Failure in: " |
|---|
| 499 | -> reportProblem p0 p1 msg ss us = put line True us |
|---|
| 500 | -> where line = "### " ++ kind ++ path' ++ '\n' : msg |
|---|
| 501 | -> kind = if null path' then p0 else p1 |
|---|
| 502 | -> path' = showPath (path ss) |
|---|
| 503 | - |
|---|
| 504 | - |
|---|
| 505 | -`showCounts` converts test execution counts to a string. |
|---|
| 506 | - |
|---|
| 507 | -> showCounts :: Counts -> String |
|---|
| 508 | -> showCounts Counts{ cases = cases, tried = tried, |
|---|
| 509 | -> errors = errors, failures = failures } = |
|---|
| 510 | -> "Cases: " ++ show cases ++ " Tried: " ++ show tried ++ |
|---|
| 511 | -> " Errors: " ++ show errors ++ " Failures: " ++ show failures |
|---|
| 512 | - |
|---|
| 513 | - |
|---|
| 514 | -`showPath` converts a test case path to a string, separating adjacent |
|---|
| 515 | -elements by ':'. An element of the path is quoted (as with `show`) |
|---|
| 516 | -when there is potential ambiguity. |
|---|
| 517 | - |
|---|
| 518 | -> showPath :: Path -> String |
|---|
| 519 | -> showPath [] = "" |
|---|
| 520 | -> showPath nodes = foldl1 f (map showNode nodes) |
|---|
| 521 | -> where f b a = a ++ ":" ++ b |
|---|
| 522 | -> showNode (ListItem n) = show n |
|---|
| 523 | -> showNode (Label label) = safe label (show label) |
|---|
| 524 | -> safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s |
|---|
| 525 | - |
|---|
| 526 | - |
|---|
| 527 | -`runTestTT` provides the "standard" text-based test controller. |
|---|
| 528 | -Reporting is made to standard error, and progress reports are |
|---|
| 529 | -included. For possible programmatic use, the final counts are |
|---|
| 530 | -returned. The "TT" in the name suggests "Text-based reporting to the |
|---|
| 531 | -Terminal". |
|---|
| 532 | - |
|---|
| 533 | -> runTestTT :: Test -> IO Counts |
|---|
| 534 | -> runTestTT t = do (counts, 0) <- runTestText (putTextToHandle stderr True) t |
|---|
| 535 | -> return counts |
|---|
| 536 | rmfile ./Test/HUnit/Text.lhs |
|---|
| 537 | hunk ./examples/Makefile 1 |
|---|
| 538 | -# ----------------------------------------------------------------------------- |
|---|
| 539 | - |
|---|
| 540 | -TOP = ../.. |
|---|
| 541 | -include $(TOP)/mk/boilerplate.mk |
|---|
| 542 | - |
|---|
| 543 | -# ----------------------------------------------------------------------------- |
|---|
| 544 | - |
|---|
| 545 | -ifeq "$(way)" "" |
|---|
| 546 | -SUBDIRS = test |
|---|
| 547 | - |
|---|
| 548 | -EXAMPLES := $(wildcard *.hs) |
|---|
| 549 | -BINS := $(addsuffix $(exeext),$(EXAMPLES:.hs=)) |
|---|
| 550 | -CLEAN_FILES += $(BINS) |
|---|
| 551 | - |
|---|
| 552 | -HC = $(GHC_INPLACE) |
|---|
| 553 | -MKDEPENDHS = $(GHC_INPLACE) |
|---|
| 554 | -SRC_HC_OPTS += -Wall -package HUnit |
|---|
| 555 | - |
|---|
| 556 | -all:: $(BINS) |
|---|
| 557 | - |
|---|
| 558 | -$(BINS): %$(exeext): %.o |
|---|
| 559 | - $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $< |
|---|
| 560 | -endif |
|---|
| 561 | - |
|---|
| 562 | -# ----------------------------------------------------------------------------- |
|---|
| 563 | - |
|---|
| 564 | -include $(TOP)/mk/target.mk |
|---|
| 565 | rmfile ./examples/Makefile |
|---|
| 566 | hunk ./examples/test/HUnitTest98.lhs 1 |
|---|
| 567 | -HUnitTest98.lhs -- test for HUnit, using Haskell language system "98" |
|---|
| 568 | - |
|---|
| 569 | -> module Main (main) where |
|---|
| 570 | - |
|---|
| 571 | -> import Test.HUnit |
|---|
| 572 | -> import HUnitTestBase |
|---|
| 573 | - |
|---|
| 574 | -> main :: IO Counts |
|---|
| 575 | -> main = runTestTT (test [baseTests]) |
|---|
| 576 | rmfile ./examples/test/HUnitTest98.lhs |
|---|
| 577 | hunk ./examples/test/HUnitTestBase.lhs 1 |
|---|
| 578 | -HUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant) |
|---|
| 579 | - |
|---|
| 580 | -> module HUnitTestBase where |
|---|
| 581 | - |
|---|
| 582 | -> import Test.HUnit |
|---|
| 583 | -> import Test.HUnit.Terminal (terminalAppearance) |
|---|
| 584 | -> import System.IO (IOMode(..), openFile, hClose) |
|---|
| 585 | - |
|---|
| 586 | - |
|---|
| 587 | -> data Report = Start State |
|---|
| 588 | -> | Error String State |
|---|
| 589 | -> | UnspecifiedError State |
|---|
| 590 | -> | Failure String State |
|---|
| 591 | -> deriving (Show, Read) |
|---|
| 592 | - |
|---|
| 593 | -> instance Eq Report where |
|---|
| 594 | -> Start s1 == Start s2 = s1 == s2 |
|---|
| 595 | -> Error m1 s1 == Error m2 s2 = m1 == m2 && s1 == s2 |
|---|
| 596 | -> Error m1 s1 == UnspecifiedError s2 = s1 == s2 |
|---|
| 597 | -> UnspecifiedError s1 == Error m2 s2 = s1 == s2 |
|---|
| 598 | -> UnspecifiedError s1 == UnspecifiedError s2 = s1 == s2 |
|---|
| 599 | -> Failure m1 s1 == Failure m2 s2 = m1 == m2 && s1 == s2 |
|---|
| 600 | -> _ == _ = False |
|---|
| 601 | - |
|---|
| 602 | - |
|---|
| 603 | -> expectReports :: [Report] -> Counts -> Test -> Test |
|---|
| 604 | -> expectReports reports counts test = TestCase $ do |
|---|
| 605 | -> (counts', reports') <- performTest (\ ss us -> return (Start ss : us)) |
|---|
| 606 | -> (\m ss us -> return (Error m ss : us)) |
|---|
| 607 | -> (\m ss us -> return (Failure m ss : us)) |
|---|
| 608 | -> [] test |
|---|
| 609 | -> assertEqual "for the reports from a test," reports (reverse reports') |
|---|
| 610 | -> assertEqual "for the counts from a test," counts counts' |
|---|
| 611 | - |
|---|
| 612 | - |
|---|
| 613 | -> simpleStart = Start (State [] (Counts 1 0 0 0)) |
|---|
| 614 | - |
|---|
| 615 | -> expectSuccess :: Test -> Test |
|---|
| 616 | -> expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0) |
|---|
| 617 | - |
|---|
| 618 | -> expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test |
|---|
| 619 | -> expectProblem kind err msg = |
|---|
| 620 | -> expectReports [simpleStart, kind msg (State [] counts)] counts |
|---|
| 621 | -> where counts = Counts 1 1 err (1-err) |
|---|
| 622 | - |
|---|
| 623 | -> expectError, expectFailure :: String -> Test -> Test |
|---|
| 624 | -> expectError = expectProblem Error 1 |
|---|
| 625 | -> expectFailure = expectProblem Failure 0 |
|---|
| 626 | - |
|---|
| 627 | -> expectUnspecifiedError :: Test -> Test |
|---|
| 628 | -> expectUnspecifiedError = expectProblem (\ msg st -> UnspecifiedError st) 1 undefined |
|---|
| 629 | - |
|---|
| 630 | - |
|---|
| 631 | -> data Expect = Succ | Err String | UErr | Fail String |
|---|
| 632 | - |
|---|
| 633 | -> expect :: Expect -> Test -> Test |
|---|
| 634 | -> expect Succ test = expectSuccess test |
|---|
| 635 | -> expect (Err m) test = expectError m test |
|---|
| 636 | -> expect UErr test = expectUnspecifiedError test |
|---|
| 637 | -> expect (Fail m) test = expectFailure m test |
|---|
| 638 | - |
|---|
| 639 | - |
|---|
| 640 | - |
|---|
| 641 | -> baseTests = test [ assertTests, |
|---|
| 642 | -> testCaseCountTests, |
|---|
| 643 | -> testCasePathsTests, |
|---|
| 644 | -> reportTests, |
|---|
| 645 | -> textTests, |
|---|
| 646 | -> showPathTests, |
|---|
| 647 | -> showCountsTests, |
|---|
| 648 | -> assertableTests, |
|---|
| 649 | -> predicableTests, |
|---|
| 650 | -> compareTests, |
|---|
| 651 | -> extendedTestTests ] |
|---|
| 652 | - |
|---|
| 653 | - |
|---|
| 654 | -> ok = test (assert ()) |
|---|
| 655 | -> bad m = test (assertFailure m) |
|---|
| 656 | - |
|---|
| 657 | - |
|---|
| 658 | -> assertTests = test [ |
|---|
| 659 | - |
|---|
| 660 | -> "null" ~: expectSuccess ok, |
|---|
| 661 | - |
|---|
| 662 | -> "userError" ~: |
|---|
| 663 | -> expectError "error" (TestCase (ioError (userError "error"))), |
|---|
| 664 | - |
|---|
| 665 | -> "IO error (file missing)" ~: |
|---|
| 666 | -> expectUnspecifiedError |
|---|
| 667 | -> (test (do openFile "3g9djs" ReadMode; return ())), |
|---|
| 668 | - |
|---|
| 669 | - "error" ~: |
|---|
| 670 | - expectError "error" (TestCase (error "error")), |
|---|
| 671 | - |
|---|
| 672 | - "tail []" ~: |
|---|
| 673 | - expectUnspecifiedError (TestCase (tail [] `seq` return ())), |
|---|
| 674 | - |
|---|
| 675 | - -- GHC doesn't currently catch arithmetic exceptions. |
|---|
| 676 | - "div by 0" ~: |
|---|
| 677 | - expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), |
|---|
| 678 | - |
|---|
| 679 | -> "assertFailure" ~: |
|---|
| 680 | -> let msg = "simple assertFailure" |
|---|
| 681 | -> in expectFailure msg (test (assertFailure msg)), |
|---|
| 682 | - |
|---|
| 683 | -> "assertString null" ~: expectSuccess (TestCase (assertString "")), |
|---|
| 684 | - |
|---|
| 685 | -> "assertString nonnull" ~: |
|---|
| 686 | -> let msg = "assertString nonnull" |
|---|
| 687 | -> in expectFailure msg (TestCase (assertString msg)), |
|---|
| 688 | - |
|---|
| 689 | -> let exp v non = |
|---|
| 690 | -> show v ++ " with " ++ non ++ "null message" ~: |
|---|
| 691 | -> expect (if v then Succ else Fail non) $ test $ assertBool non v |
|---|
| 692 | -> in "assertBool" ~: [ exp v non | v <- [True, False], non <- ["non", ""] ], |
|---|
| 693 | - |
|---|
| 694 | -> let msg = "assertBool True" |
|---|
| 695 | -> in msg ~: expectSuccess (test (assertBool msg True)), |
|---|
| 696 | - |
|---|
| 697 | -> let msg = "assertBool False" |
|---|
| 698 | -> in msg ~: expectFailure msg (test (assertBool msg False)), |
|---|
| 699 | - |
|---|
| 700 | -> "assertEqual equal" ~: |
|---|
| 701 | -> expectSuccess (test (assertEqual "" 3 3)), |
|---|
| 702 | - |
|---|
| 703 | -> "assertEqual unequal no msg" ~: |
|---|
| 704 | -> expectFailure "expected: 3\n but got: 4" |
|---|
| 705 | -> (test (assertEqual "" 3 4)), |
|---|
| 706 | - |
|---|
| 707 | -> "assertEqual unequal with msg" ~: |
|---|
| 708 | -> expectFailure "for x,\nexpected: 3\n but got: 4" |
|---|
| 709 | -> (test (assertEqual "for x," 3 4)) |
|---|
| 710 | - |
|---|
| 711 | -> ] |
|---|
| 712 | - |
|---|
| 713 | - |
|---|
| 714 | -> emptyTest0 = TestList [] |
|---|
| 715 | -> emptyTest1 = TestLabel "empty" emptyTest0 |
|---|
| 716 | -> emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ] |
|---|
| 717 | -> emptyTests = [emptyTest0, emptyTest1, emptyTest2] |
|---|
| 718 | - |
|---|
| 719 | -> testCountEmpty test = TestCase (assertEqual "" 0 (testCaseCount test)) |
|---|
| 720 | - |
|---|
| 721 | -> suite0 = (0, ok) |
|---|
| 722 | -> suite1 = (1, TestList []) |
|---|
| 723 | -> suite2 = (2, TestLabel "3" ok) |
|---|
| 724 | -> suite3 = (3, suite) |
|---|
| 725 | - |
|---|
| 726 | -> suite = |
|---|
| 727 | -> TestLabel "0" |
|---|
| 728 | -> (TestList [ TestLabel "1" (bad "1"), |
|---|
| 729 | -> TestLabel "2" (TestList [ TestLabel "2.1" ok, |
|---|
| 730 | -> ok, |
|---|
| 731 | -> TestLabel "2.3" (bad "2") ]), |
|---|
| 732 | -> TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))), |
|---|
| 733 | -> TestList [ TestList [ TestLabel "6" (bad "4") ] ] ]) |
|---|
| 734 | - |
|---|
| 735 | -> suiteCount = (6 :: Int) |
|---|
| 736 | - |
|---|
| 737 | -> suitePaths = [ |
|---|
| 738 | -> [Label "0", ListItem 0, Label "1"], |
|---|
| 739 | -> [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"], |
|---|
| 740 | -> [Label "0", ListItem 1, Label "2", ListItem 1], |
|---|
| 741 | -> [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"], |
|---|
| 742 | -> [Label "0", ListItem 2, Label "3", Label "4", Label "5"], |
|---|
| 743 | -> [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]] |
|---|
| 744 | - |
|---|
| 745 | -> suiteReports = [ Start (State (p 0) (Counts 6 0 0 0)), |
|---|
| 746 | -> Failure "1" (State (p 0) (Counts 6 1 0 1)), |
|---|
| 747 | -> Start (State (p 1) (Counts 6 1 0 1)), |
|---|
| 748 | -> Start (State (p 2) (Counts 6 2 0 1)), |
|---|
| 749 | -> Start (State (p 3) (Counts 6 3 0 1)), |
|---|
| 750 | -> Failure "2" (State (p 3) (Counts 6 4 0 2)), |
|---|
| 751 | -> Start (State (p 4) (Counts 6 4 0 2)), |
|---|
| 752 | -> Failure "3" (State (p 4) (Counts 6 5 0 3)), |
|---|
| 753 | -> Start (State (p 5) (Counts 6 5 0 3)), |
|---|
| 754 | -> Failure "4" (State (p 5) (Counts 6 6 0 4))] |
|---|
| 755 | -> where p n = reverse (suitePaths !! n) |
|---|
| 756 | - |
|---|
| 757 | -> suiteCounts = Counts 6 6 0 4 |
|---|
| 758 | - |
|---|
| 759 | -> suiteOutput = "### Failure in: 0:0:1\n\ |
|---|
| 760 | -> \1\n\ |
|---|
| 761 | -> \### Failure in: 0:1:2:2:2.3\n\ |
|---|
| 762 | -> \2\n\ |
|---|
| 763 | -> \### Failure in: 0:2:3:4:5\n\ |
|---|
| 764 | -> \3\n\ |
|---|
| 765 | -> \### Failure in: 0:3:0:0:6\n\ |
|---|
| 766 | -> \4\n\ |
|---|
| 767 | -> \Cases: 6 Tried: 6 Errors: 0 Failures: 4\n" |
|---|
| 768 | - |
|---|
| 769 | - |
|---|
| 770 | -> suites = [suite0, suite1, suite2, suite3] |
|---|
| 771 | - |
|---|
| 772 | - |
|---|
| 773 | -> testCount (num, test) count = |
|---|
| 774 | -> "testCaseCount suite" ++ show num ~: |
|---|
| 775 | -> TestCase $ assertEqual "for test count," count (testCaseCount test) |
|---|
| 776 | - |
|---|
| 777 | -> testCaseCountTests = TestList [ |
|---|
| 778 | - |
|---|
| 779 | -> "testCaseCount empty" ~: test (map testCountEmpty emptyTests), |
|---|
| 780 | - |
|---|
| 781 | -> testCount suite0 1, |
|---|
| 782 | -> testCount suite1 0, |
|---|
| 783 | -> testCount suite2 1, |
|---|
| 784 | -> testCount suite3 suiteCount |
|---|
| 785 | - |
|---|
| 786 | -> ] |
|---|
| 787 | - |
|---|
| 788 | - |
|---|
| 789 | -> testPaths (num, test) paths = |
|---|
| 790 | -> "testCasePaths suite" ++ show num ~: |
|---|
| 791 | -> TestCase $ assertEqual "for test paths," |
|---|
| 792 | -> (map reverse paths) (testCasePaths test) |
|---|
| 793 | - |
|---|
| 794 | -> testPathsEmpty test = TestCase $ assertEqual "" [] (testCasePaths test) |
|---|
| 795 | - |
|---|
| 796 | -> testCasePathsTests = TestList [ |
|---|
| 797 | - |
|---|
| 798 | -> "testCasePaths empty" ~: test (map testPathsEmpty emptyTests), |
|---|
| 799 | - |
|---|
| 800 | -> testPaths suite0 [[]], |
|---|
| 801 | -> testPaths suite1 [], |
|---|
| 802 | -> testPaths suite2 [[Label "3"]], |
|---|
| 803 | -> testPaths suite3 suitePaths |
|---|
| 804 | - |
|---|
| 805 | -> ] |
|---|
| 806 | - |
|---|
| 807 | - |
|---|
| 808 | -> reportTests = "reports" ~: expectReports suiteReports suiteCounts suite |
|---|
| 809 | - |
|---|
| 810 | - |
|---|
| 811 | -> expectText counts text test = TestCase $ do |
|---|
| 812 | -> (counts', text') <- runTestText putTextToShowS test |
|---|
| 813 | -> assertEqual "for the final counts," counts counts' |
|---|
| 814 | -> assertEqual "for the failure text output," text (text' "") |
|---|
| 815 | - |
|---|
| 816 | - |
|---|
| 817 | -> textTests = test [ |
|---|
| 818 | - |
|---|
| 819 | -> "lone error" ~: |
|---|
| 820 | -> expectText (Counts 1 1 1 0) |
|---|
| 821 | -> "### Error:\nxyz\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" |
|---|
| 822 | -> (test (do ioError (userError "xyz"); return ())), |
|---|
| 823 | - |
|---|
| 824 | -> "lone failure" ~: |
|---|
| 825 | -> expectText (Counts 1 1 0 1) |
|---|
| 826 | -> "### Failure:\nxyz\nCases: 1 Tried: 1 Errors: 0 Failures: 1\n" |
|---|
| 827 | -> (test (assert "xyz")), |
|---|
| 828 | - |
|---|
| 829 | -> "putTextToShowS" ~: |
|---|
| 830 | -> expectText suiteCounts suiteOutput suite, |
|---|
| 831 | - |
|---|
| 832 | -> "putTextToHandle (file)" ~: |
|---|
| 833 | -> let filename = "HUnitTest.tmp" |
|---|
| 834 | -> trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines |
|---|
| 835 | -> in map test |
|---|
| 836 | -> [ "show progress = " ++ show flag ~: do |
|---|
| 837 | -> handle <- openFile filename WriteMode |
|---|
| 838 | -> (counts, _) <- runTestText (putTextToHandle handle flag) suite |
|---|
| 839 | -> hClose handle |
|---|
| 840 | -> assertEqual "for the final counts," suiteCounts counts |
|---|
| 841 | -> text <- readFile filename |
|---|
| 842 | -> let text' = if flag then trim (terminalAppearance text) else text |
|---|
| 843 | -> assertEqual "for the failure text output," suiteOutput text' |
|---|
| 844 | -> | flag <- [False, True] ] |
|---|
| 845 | - |
|---|
| 846 | -> ] |
|---|
| 847 | - |
|---|
| 848 | - |
|---|
| 849 | -> showPathTests = "showPath" ~: [ |
|---|
| 850 | - |
|---|
| 851 | -> "empty" ~: showPath [] ~?= "", |
|---|
| 852 | -> ":" ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"", |
|---|
| 853 | -> "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"", |
|---|
| 854 | -> "misc" ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?= |
|---|
| 855 | -> "foo:3:2:b" |
|---|
| 856 | - |
|---|
| 857 | -> ] |
|---|
| 858 | - |
|---|
| 859 | - |
|---|
| 860 | -> showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?= |
|---|
| 861 | -> "Cases: 4 Tried: 3 Errors: 2 Failures: 1" |
|---|
| 862 | - |
|---|
| 863 | - |
|---|
| 864 | - |
|---|
| 865 | -> lift :: a -> IO a |
|---|
| 866 | -> lift a = return a |
|---|
| 867 | - |
|---|
| 868 | - |
|---|
| 869 | -> assertableTests = |
|---|
| 870 | -> let assertables x = [ |
|---|
| 871 | -> ( "", assert x , test (lift x)) , |
|---|
| 872 | -> ( "IO ", assert (lift x) , test (lift (lift x))) , |
|---|
| 873 | -> ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))] |
|---|
| 874 | -> assertabled l e x = |
|---|
| 875 | -> test [ test [ "assert" ~: pre ++ l ~: expect e $ test $ a, |
|---|
| 876 | -> "test" ~: pre ++ "IO " ++ l ~: expect e $ t ] |
|---|
| 877 | -> | (pre, a, t) <- assertables x ] |
|---|
| 878 | -> in "assertable" ~: [ |
|---|
| 879 | -> assertabled "()" Succ (), |
|---|
| 880 | -> assertabled "True" Succ True, |
|---|
| 881 | -> assertabled "False" (Fail "") False, |
|---|
| 882 | -> assertabled "\"\"" Succ "", |
|---|
| 883 | -> assertabled "\"x\"" (Fail "x") "x" |
|---|
| 884 | -> ] |
|---|
| 885 | - |
|---|
| 886 | - |
|---|
| 887 | -> predicableTests = |
|---|
| 888 | -> let predicables x m = [ |
|---|
| 889 | -> ( "", assertionPredicate x , x @? m, x ~? m ), |
|---|
| 890 | -> ( "IO ", assertionPredicate (l x) , l x @? m, l x ~? m ), |
|---|
| 891 | -> ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )] |
|---|
| 892 | -> l x = lift x |
|---|
| 893 | -> predicabled l e m x = |
|---|
| 894 | -> test [ test [ "pred" ~: pre ++ l ~: m ~: expect e $ test $ tst p, |
|---|
| 895 | -> "(@?)" ~: pre ++ l ~: m ~: expect e $ test $ a, |
|---|
| 896 | -> "(~?)" ~: pre ++ l ~: m ~: expect e $ t ] |
|---|
| 897 | -> | (pre, p, a, t) <- predicables x m ] |
|---|
| 898 | -> where tst p = p >>= assertBool m |
|---|
| 899 | -> in "predicable" ~: [ |
|---|
| 900 | -> predicabled "True" Succ "error" True, |
|---|
| 901 | -> predicabled "False" (Fail "error") "error" False, |
|---|
| 902 | -> predicabled "True" Succ "" True, |
|---|
| 903 | -> predicabled "False" (Fail "" ) "" False |
|---|
| 904 | -> ] |
|---|
| 905 | - |
|---|
| 906 | - |
|---|
| 907 | -> compareTests = test [ |
|---|
| 908 | - |
|---|
| 909 | -> let succ = const Succ |
|---|
| 910 | -> compare f exp act = test [ "(@=?)" ~: expect e $ test (exp @=? act), |
|---|
| 911 | -> "(@?=)" ~: expect e $ test (act @?= exp), |
|---|
| 912 | -> "(~=?)" ~: expect e $ exp ~=? act, |
|---|
| 913 | -> "(~?=)" ~: expect e $ act ~?= exp ] |
|---|
| 914 | -> where e = f $ "expected: " ++ show exp ++ "\n but got: " ++ show act |
|---|
| 915 | -> in test [ |
|---|
| 916 | -> compare succ 1 1, |
|---|
| 917 | -> compare Fail 1 2, |
|---|
| 918 | -> compare succ (1,'b',3.0) (1,'b',3.0), |
|---|
| 919 | -> compare Fail (1,'b',3.0) (1,'b',3.1) |
|---|
| 920 | -> ] |
|---|
| 921 | - |
|---|
| 922 | -> ] |
|---|
| 923 | - |
|---|
| 924 | - |
|---|
| 925 | -> expectList1 :: Int -> Test -> Test |
|---|
| 926 | -> expectList1 c = |
|---|
| 927 | -> expectReports |
|---|
| 928 | -> [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ] |
|---|
| 929 | -> (Counts c c 0 0) |
|---|
| 930 | - |
|---|
| 931 | -> expectList2 :: [Int] -> Test -> Test |
|---|
| 932 | -> expectList2 cs test = |
|---|
| 933 | -> expectReports |
|---|
| 934 | -> [ Start (State [ListItem j, ListItem i] (Counts c n 0 0)) |
|---|
| 935 | -> | ((i,j),n) <- zip coords [0..] ] |
|---|
| 936 | -> (Counts c c 0 0) |
|---|
| 937 | -> test |
|---|
| 938 | -> where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ] |
|---|
| 939 | -> c = testCaseCount test |
|---|
| 940 | - |
|---|
| 941 | - |
|---|
| 942 | -> extendedTestTests = test [ |
|---|
| 943 | - |
|---|
| 944 | -> "test idempotent" ~: expect Succ $ test $ test $ test $ ok, |
|---|
| 945 | - |
|---|
| 946 | -> "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True], |
|---|
| 947 | - |
|---|
| 948 | -> "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]] |
|---|
| 949 | - |
|---|
| 950 | -> ] |
|---|
| 951 | rmfile ./examples/test/HUnitTestBase.lhs |
|---|
| 952 | hunk ./examples/test/HUnitTestExtended.lhs 1 |
|---|
| 953 | -HUnitTestExc.lhs -- test for HUnit, using Haskell language system "Exc" |
|---|
| 954 | - |
|---|
| 955 | -> module Main (main) where |
|---|
| 956 | - |
|---|
| 957 | -> import Test.HUnit |
|---|
| 958 | -> import HUnitTestBase |
|---|
| 959 | - |
|---|
| 960 | - import qualified Control.Exception (assert) |
|---|
| 961 | - |
|---|
| 962 | - assertionMessage = "HUnitTestExc.lhs:13: Assertion failed\n" |
|---|
| 963 | - assertion = Control.Exception.assert False (return ()) |
|---|
| 964 | - |
|---|
| 965 | - |
|---|
| 966 | -> main :: IO Counts |
|---|
| 967 | -> main = runTestTT (test [baseTests, excTests]) |
|---|
| 968 | - |
|---|
| 969 | -> excTests :: Test |
|---|
| 970 | -> excTests = test [ |
|---|
| 971 | - |
|---|
| 972 | - -- Hugs and GHC don't currently catch arithmetic exceptions. |
|---|
| 973 | - "div by 0" ~: |
|---|
| 974 | - expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), |
|---|
| 975 | - |
|---|
| 976 | - -- GHC doesn't currently catch array-related exceptions. |
|---|
| 977 | - "array ref out of bounds" ~: |
|---|
| 978 | - expectUnspecifiedError (TestCase (... `seq` return ())), |
|---|
| 979 | - |
|---|
| 980 | -> "error" ~: |
|---|
| 981 | -> expectError "error" (TestCase (error "error")), |
|---|
| 982 | - |
|---|
| 983 | -> "tail []" ~: |
|---|
| 984 | -> expectUnspecifiedError (TestCase (tail [] `seq` return ())) |
|---|
| 985 | - |
|---|
| 986 | - -- Hugs doesn't provide `assert`. |
|---|
| 987 | - "assert" ~: |
|---|
| 988 | - expectError assertionMessage (TestCase assertion) |
|---|
| 989 | - |
|---|
| 990 | -> ] |
|---|
| 991 | rmfile ./examples/test/HUnitTestExtended.lhs |
|---|
| 992 | hunk ./examples/test/Makefile 1 |
|---|
| 993 | -# ----------------------------------------------------------------------------- |
|---|
| 994 | - |
|---|
| 995 | -TOP = ../../.. |
|---|
| 996 | -include $(TOP)/mk/boilerplate.mk |
|---|
| 997 | - |
|---|
| 998 | -# ----------------------------------------------------------------------------- |
|---|
| 999 | - |
|---|
| 1000 | -EXAMPLES := $(filter-out HUnitTestBase.lhs,$(wildcard *.lhs)) |
|---|
| 1001 | -BINS := $(addsuffix $(exeext),$(EXAMPLES:.lhs=)) |
|---|
| 1002 | -CLEAN_FILES += $(BINS) |
|---|
| 1003 | - |
|---|
| 1004 | -HC = $(GHC_INPLACE) |
|---|
| 1005 | -MKDEPENDHS = $(GHC_INPLACE) |
|---|
| 1006 | -SRC_HC_OPTS += -Wall -package HUnit |
|---|
| 1007 | - |
|---|
| 1008 | -all:: $(BINS) |
|---|
| 1009 | - |
|---|
| 1010 | -USES_HUNITTESTBASE := $(EXAMPLES:.lhs=) |
|---|
| 1011 | - |
|---|
| 1012 | -.PRECIOUS: HUnitTestBase.o |
|---|
| 1013 | -$(addsuffix .o,$(USES_HUNITTESTBASE)): HUnitTestBase.hi |
|---|
| 1014 | -$(addsuffix $(exeext),$(USES_HUNITTESTBASE)): HUnitTestBase.o |
|---|
| 1015 | - |
|---|
| 1016 | -$(BINS): %$(exeext): %.o |
|---|
| 1017 | - $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $< $(patsubst %,HUnitTestBase.o,$(filter $(<:.o=),$(USES_HUNITTESTBASE))) |
|---|
| 1018 | - |
|---|
| 1019 | -# ----------------------------------------------------------------------------- |
|---|
| 1020 | - |
|---|
| 1021 | -include $(TOP)/mk/target.mk |
|---|
| 1022 | rmfile ./examples/test/Makefile |
|---|
| 1023 | hunk ./examples/test/TerminalTest.lhs 1 |
|---|
| 1024 | -TerminalTest.lhs |
|---|
| 1025 | - |
|---|
| 1026 | -> import Test.HUnit.Terminal |
|---|
| 1027 | -> import Test.HUnit |
|---|
| 1028 | - |
|---|
| 1029 | -> main :: IO Counts |
|---|
| 1030 | -> main = runTestTT tests |
|---|
| 1031 | - |
|---|
| 1032 | -> try :: String -> String -> String -> Test |
|---|
| 1033 | -> try lab inp exp' = lab ~: terminalAppearance inp ~?= exp' |
|---|
| 1034 | - |
|---|
| 1035 | -> tests :: Test |
|---|
| 1036 | -> tests = test [ |
|---|
| 1037 | -> try "empty" "" "", |
|---|
| 1038 | -> try "end in \\n" "abc\ndef\n" "abc\ndef\n", |
|---|
| 1039 | -> try "not end in \\n" "abc\ndef" "abc\ndef", |
|---|
| 1040 | -> try "return 1" "abc\ndefgh\rxyz" "abc\nxyzgh", |
|---|
| 1041 | -> try "return 2" "\nabcdefgh\rijklm\rxy\n" "\nxyklmfgh\n", |
|---|
| 1042 | -> try "return 3" "\r\rabc\r\rdef\r\r\r\nghi\r\r\n" "def\nghi\n", |
|---|
| 1043 | -> try "back 1" "abc\bdef\b\bgh\b" "abdgh", |
|---|
| 1044 | -> try "back 2" "abc\b\b\bdef\b\bxy\b\b\n" "dxy\n" |
|---|
| 1045 | -> -- \b at beginning of line |
|---|
| 1046 | -> -- nonprinting char |
|---|
| 1047 | -> ] |
|---|
| 1048 | rmfile ./examples/test/TerminalTest.lhs |
|---|
| 1049 | rmdir ./examples/test |
|---|
| 1050 | adddir ./tests |
|---|
| 1051 | hunk ./HUnit.cabal 1 |
|---|
| 1052 | -name: HUnit |
|---|
| 1053 | -version: 1.2.0.3 |
|---|
| 1054 | -license: BSD3 |
|---|
| 1055 | -license-file: LICENSE |
|---|
| 1056 | -author: Dean Herington |
|---|
| 1057 | -homepage: http://hunit.sourceforge.net/ |
|---|
| 1058 | -category: Testing |
|---|
| 1059 | -synopsis: A unit testing framework for Haskell |
|---|
| 1060 | -maintainer: libraries@haskell.org |
|---|
| 1061 | -cabal-version: >= 1.2 |
|---|
| 1062 | -description: |
|---|
| 1063 | - HUnit is a unit testing framework for Haskell, inspired by the |
|---|
| 1064 | - JUnit tool for Java, see: <http://www.junit.org>. |
|---|
| 1065 | -build-type: Simple |
|---|
| 1066 | +Name: HUnit |
|---|
| 1067 | +Version: 1.2.0.4 |
|---|
| 1068 | +Cabal-Version: >= 1.2 |
|---|
| 1069 | +License: BSD3 |
|---|
| 1070 | +License-File: LICENSE |
|---|
| 1071 | +Author: Dean Herington |
|---|
| 1072 | +Maintainer: libraries@haskell.org |
|---|
| 1073 | +Stability: stable |
|---|
| 1074 | +Homepage: http://hunit.sourceforge.net/ |
|---|
| 1075 | +Category: Testing |
|---|
| 1076 | +Synopsis: A unit testing framework for Haskell |
|---|
| 1077 | +Description: |
|---|
| 1078 | + HUnit is a unit testing framework for Haskell, inspired by the |
|---|
| 1079 | + JUnit tool for Java, see: <http://www.junit.org>. |
|---|
| 1080 | +Tested-With: |
|---|
| 1081 | + GHC == 6.10.1 |
|---|
| 1082 | +Build-Type: Custom |
|---|
| 1083 | +Extra-Source-Files: |
|---|
| 1084 | + tests/HUnitTest98.lhs |
|---|
| 1085 | + tests/HUnitTestBase.lhs |
|---|
| 1086 | + tests/HUnitTestExtended.lhs |
|---|
| 1087 | + tests/HUnitTests.cabal |
|---|
| 1088 | + tests/Setup.hs |
|---|
| 1089 | + tests/TerminalTest.lhs |
|---|
| 1090 | +Data-Files: |
|---|
| 1091 | + doc/Guide.html |
|---|
| 1092 | + examples/Example.hs |
|---|
| 1093 | + prologue.txt |
|---|
| 1094 | + README |
|---|
| 1095 | |
|---|
| 1096 | flag base4 |
|---|
| 1097 | |
|---|
| 1098 | hunk ./HUnit.cabal 33 |
|---|
| 1099 | -library |
|---|
| 1100 | - build-depends: base <5 |
|---|
| 1101 | +Library |
|---|
| 1102 | + Build-Depends: base <5 |
|---|
| 1103 | if flag(base4) |
|---|
| 1104 | hunk ./HUnit.cabal 36 |
|---|
| 1105 | - build-depends: base >=4 |
|---|
| 1106 | - cpp-options: -DBASE4 |
|---|
| 1107 | + Build-Depends: base >=4 |
|---|
| 1108 | + CPP-Options: -DBASE4 |
|---|
| 1109 | else |
|---|
| 1110 | hunk ./HUnit.cabal 39 |
|---|
| 1111 | - build-depends: base <4 |
|---|
| 1112 | + Build-Depends: base <4 |
|---|
| 1113 | if impl(ghc >= 6.10) |
|---|
| 1114 | hunk ./HUnit.cabal 41 |
|---|
| 1115 | - build-depends: base >=4 |
|---|
| 1116 | - exposed-modules: |
|---|
| 1117 | - Test.HUnit.Base, |
|---|
| 1118 | - Test.HUnit.Lang, |
|---|
| 1119 | - Test.HUnit.Terminal, |
|---|
| 1120 | - Test.HUnit.Text, |
|---|
| 1121 | - Test.HUnit |
|---|
| 1122 | - extensions: CPP |
|---|
| 1123 | + Build-Depends: base >=4 |
|---|
| 1124 | + Exposed-Modules: |
|---|
| 1125 | + Test.HUnit.Base, |
|---|
| 1126 | + Test.HUnit.Lang, |
|---|
| 1127 | + Test.HUnit.Terminal, |
|---|
| 1128 | + Test.HUnit.Text, |
|---|
| 1129 | + Test.HUnit |
|---|
| 1130 | + Extensions: CPP |
|---|
| 1131 | |
|---|
| 1132 | hunk ./HUnit.cabal 50 |
|---|
| 1133 | +Executable basic-tests |
|---|
| 1134 | + Main-Is: HUnitTest98.lhs |
|---|
| 1135 | + HS-Source-Dirs: . tests |
|---|
| 1136 | + Build-Depends: base<5 |
|---|
| 1137 | + if flag(base4) |
|---|
| 1138 | + Build-Depends: base >=4 |
|---|
| 1139 | + CPP-Options: -DBASE4 |
|---|
| 1140 | + else |
|---|
| 1141 | + Build-Depends: base <4 |
|---|
| 1142 | + if impl(ghc >= 6.10) |
|---|
| 1143 | + Build-Depends: base >=4 |
|---|
| 1144 | + Extensions: CPP |
|---|
| 1145 | + |
|---|
| 1146 | +Executable extended-tests |
|---|
| 1147 | + Main-Is: HUnitTestExtended.lhs |
|---|
| 1148 | + HS-Source-Dirs: . tests |
|---|
| 1149 | + Build-Depends: base<5 |
|---|
| 1150 | + if flag(base4) |
|---|
| 1151 | + Build-Depends: base >=4 |
|---|
| 1152 | + CPP-Options: -DBASE4 |
|---|
| 1153 | + else |
|---|
| 1154 | + Build-Depends: base <4 |
|---|
| 1155 | + if impl(ghc >= 6.10) |
|---|
| 1156 | + Build-Depends: base >=4 |
|---|
| 1157 | + Extensions: CPP |
|---|
| 1158 | + |
|---|
| 1159 | +Executable terminal-tests |
|---|
| 1160 | + Main-Is: TerminalTest.lhs |
|---|
| 1161 | + HS-Source-Dirs: . tests |
|---|
| 1162 | + Build-Depends: base<5 |
|---|
| 1163 | + if flag(base4) |
|---|
| 1164 | + Build-Depends: base >=4 |
|---|
| 1165 | + CPP-Options: -DBASE4 |
|---|
| 1166 | + else |
|---|
| 1167 | + Build-Depends: base <4 |
|---|
| 1168 | + if impl(ghc >= 6.10) |
|---|
| 1169 | + Build-Depends: base >=4 |
|---|
| 1170 | + Extensions: CPP |
|---|
| 1171 | hunk ./Setup.hs 1 |
|---|
| 1172 | +#!/usr/bin/env runhaskell |
|---|
| 1173 | module Main (main) where |
|---|
| 1174 | |
|---|
| 1175 | hunk ./Setup.hs 4 |
|---|
| 1176 | +import Data.List (isSuffixOf) |
|---|
| 1177 | +import Distribution.PackageDescription |
|---|
| 1178 | import Distribution.Simple |
|---|
| 1179 | hunk ./Setup.hs 7 |
|---|
| 1180 | +import System.Process |
|---|
| 1181 | |
|---|
| 1182 | main :: IO () |
|---|
| 1183 | hunk ./Setup.hs 10 |
|---|
| 1184 | -main = defaultMain |
|---|
| 1185 | - |
|---|
| 1186 | +main = defaultMainWithHooks (simpleUserHooks {runTests = _runTests, instHook = _instHook}) |
|---|
| 1187 | + where |
|---|
| 1188 | + -- Run all executables with names that end in -tests |
|---|
| 1189 | + _runTests _ _ pd _ = do |
|---|
| 1190 | + let exeNames = ["dist/build/" ++ fp ++ "/" ++ fp | fp <- map exeName (executables pd)] |
|---|
| 1191 | + sequence [_runTest e | e <- exeNames, isSuffixOf "-tests" e] |
|---|
| 1192 | + return () |
|---|
| 1193 | + _runTest fp = do |
|---|
| 1194 | + ph <- runCommand fp |
|---|
| 1195 | + waitForProcess ph |
|---|
| 1196 | + |
|---|
| 1197 | + -- Only install executables that don't end in -tests |
|---|
| 1198 | + _instHook pd lbi uhs ifs = do |
|---|
| 1199 | + let execs = filter (\e -> not $ isSuffixOf "-tests" (exeName e)) (executables pd) |
|---|
| 1200 | + (instHook simpleUserHooks) (pd {executables = execs}) lbi uhs ifs |
|---|
| 1201 | + |
|---|
| 1202 | hunk ./Test/HUnit.hs 1 |
|---|
| 1203 | +-- | HUnit is a unit testing framework for Haskell, inspired by the JUnit tool |
|---|
| 1204 | +-- for Java. This guide describes how to use HUnit, assuming you are familiar |
|---|
| 1205 | +-- with Haskell, though not necessarily with JUnit. |
|---|
| 1206 | +-- |
|---|
| 1207 | +-- In the Haskell module where your tests will reside, import module |
|---|
| 1208 | +-- @Test.HUnit@: |
|---|
| 1209 | +-- |
|---|
| 1210 | +-- @ |
|---|
| 1211 | +-- import Test.HUnit |
|---|
| 1212 | +-- @ |
|---|
| 1213 | +-- |
|---|
| 1214 | +-- Define test cases as appropriate: |
|---|
| 1215 | +-- |
|---|
| 1216 | +-- @ |
|---|
| 1217 | +-- test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3)) |
|---|
| 1218 | +-- test2 = TestCase (do (x,y) <- partA 3 |
|---|
| 1219 | +-- assertEqual "for the first result of partA," 5 x |
|---|
| 1220 | +-- b <- partB y |
|---|
| 1221 | +-- assertBool ("(partB " ++ show y ++ ") failed") b) |
|---|
| 1222 | +-- @ |
|---|
| 1223 | +-- |
|---|
| 1224 | +-- Name the test cases and group them together: |
|---|
| 1225 | +-- |
|---|
| 1226 | +-- @ |
|---|
| 1227 | +-- tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2] |
|---|
| 1228 | +-- @ |
|---|
| 1229 | +-- |
|---|
| 1230 | +-- Run the tests as a group. At a Haskell interpreter prompt, apply the function |
|---|
| 1231 | +-- @runTestTT@ to the collected tests. (The /TT/ suggests /T/ext orientation |
|---|
| 1232 | +-- with output to the /T/erminal.) |
|---|
| 1233 | +-- |
|---|
| 1234 | +-- @ |
|---|
| 1235 | +-- \> runTestTT tests |
|---|
| 1236 | +-- Cases: 2 Tried: 2 Errors: 0 Failures: 0 |
|---|
| 1237 | +-- \> |
|---|
| 1238 | +-- @ |
|---|
| 1239 | +-- |
|---|
| 1240 | +-- If the tests are proving their worth, you might see: |
|---|
| 1241 | +-- |
|---|
| 1242 | +-- @ |
|---|
| 1243 | +-- \> runTestTT tests |
|---|
| 1244 | +-- ### Failure in: 0:test1 |
|---|
| 1245 | +-- for (foo 3), |
|---|
| 1246 | +-- expected: (1,2) |
|---|
| 1247 | +-- but got: (1,3) |
|---|
| 1248 | +-- Cases: 2 Tried: 2 Errors: 0 Failures: 1 |
|---|
| 1249 | +-- \> |
|---|
| 1250 | +-- @ |
|---|
| 1251 | +-- |
|---|
| 1252 | +-- You can specify tests even more succinctly using operators and overloaded |
|---|
| 1253 | +-- functions that HUnit provides: |
|---|
| 1254 | +-- |
|---|
| 1255 | +-- @ |
|---|
| 1256 | +-- tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3), |
|---|
| 1257 | +-- "test2" ~: do (x, y) <- partA 3 |
|---|
| 1258 | +-- assertEqual "for the first result of partA," 5 x |
|---|
| 1259 | +-- partB y \@? "(partB " ++ show y ++ ") failed" ] |
|---|
| 1260 | +-- @ |
|---|
| 1261 | +-- |
|---|
| 1262 | +-- Assuming the same test failures as before, you would see: |
|---|
| 1263 | +-- |
|---|
| 1264 | +-- @ |
|---|
| 1265 | +-- \> runTestTT tests |
|---|
| 1266 | +-- ### Failure in: 0:test1:(foo 3) |
|---|
| 1267 | +-- expected: (1,2) |
|---|
| 1268 | +-- but got: (1,3) |
|---|
| 1269 | +-- Cases: 2 Tried: 2 Errors: 0 Failures: 1 |
|---|
| 1270 | +-- \> |
|---|
| 1271 | +-- @ |
|---|
| 1272 | + |
|---|
| 1273 | +module Test.HUnit |
|---|
| 1274 | +( |
|---|
| 1275 | + module Test.HUnit.Base, |
|---|
| 1276 | + module Test.HUnit.Text |
|---|
| 1277 | +) |
|---|
| 1278 | +where |
|---|
| 1279 | + |
|---|
| 1280 | +import Test.HUnit.Base |
|---|
| 1281 | +import Test.HUnit.Text |
|---|
| 1282 | + |
|---|
| 1283 | hunk ./Test/HUnit/Base.hs 1 |
|---|
| 1284 | +-- | Basic definitions for the HUnit library. |
|---|
| 1285 | +-- |
|---|
| 1286 | +-- This module contains what you need to create assertions and test cases and |
|---|
| 1287 | +-- combine them into test suites. |
|---|
| 1288 | +-- |
|---|
| 1289 | +-- This module also provides infrastructure for |
|---|
| 1290 | +-- implementing test controllers (which are used to execute tests). |
|---|
| 1291 | +-- See "Test.HUnit.Text" for a great example of how to implement a test |
|---|
| 1292 | +-- controller. |
|---|
| 1293 | + |
|---|
| 1294 | +module Test.HUnit.Base |
|---|
| 1295 | +( |
|---|
| 1296 | + -- ** Declaring tests |
|---|
| 1297 | + Test(..), |
|---|
| 1298 | + (~=?), (~?=), (~:), (~?), |
|---|
| 1299 | + |
|---|
| 1300 | + -- ** Making assertions |
|---|
| 1301 | + assertFailure, {- from Test.HUnit.Lang: -} |
|---|
| 1302 | + assertBool, assertEqual, assertString, |
|---|
| 1303 | + Assertion, {- from Test.HUnit.Lang: -} |
|---|
| 1304 | + (@=?), (@?=), (@?), |
|---|
| 1305 | + |
|---|
| 1306 | + -- ** Extending the assertion functionality |
|---|
| 1307 | + Assertable(..), ListAssertable(..), |
|---|
| 1308 | + AssertionPredicate, AssertionPredicable(..), |
|---|
| 1309 | + Testable(..), |
|---|
| 1310 | + |
|---|
| 1311 | + -- ** Test execution |
|---|
| 1312 | + -- $testExecutionNote |
|---|
| 1313 | + State(..), Counts(..), |
|---|
| 1314 | + Path, Node(..), |
|---|
| 1315 | + testCasePaths, |
|---|
| 1316 | + testCaseCount, |
|---|
| 1317 | + ReportStart, ReportProblem, |
|---|
| 1318 | + performTest |
|---|
| 1319 | +) |
|---|
| 1320 | +where |
|---|
| 1321 | + |
|---|
| 1322 | +import Control.Monad (unless, foldM) |
|---|
| 1323 | + |
|---|
| 1324 | + |
|---|
| 1325 | +-- Assertion Definition |
|---|
| 1326 | +-- ==================== |
|---|
| 1327 | + |
|---|
| 1328 | +import Test.HUnit.Lang |
|---|
| 1329 | + |
|---|
| 1330 | + |
|---|
| 1331 | +-- Conditional Assertion Functions |
|---|
| 1332 | +-- ------------------------------- |
|---|
| 1333 | + |
|---|
| 1334 | +-- | Asserts that the specified condition holds. |
|---|
| 1335 | +assertBool :: String -- ^ The message that is displayed if the assertion fails |
|---|
| 1336 | + -> Bool -- ^ The condition |
|---|
| 1337 | + -> Assertion |
|---|
| 1338 | +assertBool msg b = unless b (assertFailure msg) |
|---|
| 1339 | + |
|---|
| 1340 | +-- | Signals an assertion failure if a non-empty message (i.e., a message |
|---|
| 1341 | +-- other than @\"\"@) is passed. |
|---|
| 1342 | +assertString :: String -- ^ The message that is displayed with the assertion failure |
|---|
| 1343 | + -> Assertion |
|---|
| 1344 | +assertString s = unless (null s) (assertFailure s) |
|---|
| 1345 | + |
|---|
| 1346 | +-- | Asserts that the specified actual value is equal to the expected value. |
|---|
| 1347 | +-- The output message will contain the prefix, the expected value, and the |
|---|
| 1348 | +-- actual value. |
|---|
| 1349 | +-- |
|---|
| 1350 | +-- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted |
|---|
| 1351 | +-- and only the expected and actual values are output. |
|---|
| 1352 | +assertEqual :: (Eq a, Show a) => String -- ^ The message prefix |
|---|
| 1353 | + -> a -- ^ The expected value |
|---|
| 1354 | + -> a -- ^ The actual value |
|---|
| 1355 | + -> Assertion |
|---|
| 1356 | +assertEqual preface expected actual = |
|---|
| 1357 | + unless (actual == expected) (assertFailure msg) |
|---|
| 1358 | + where msg = (if null preface then "" else preface ++ "\n") ++ |
|---|
| 1359 | + "expected: " ++ show expected ++ "\n but got: " ++ show actual |
|---|
| 1360 | + |
|---|
| 1361 | + |
|---|
| 1362 | +-- Overloaded `assert` Function |
|---|
| 1363 | +-- ---------------------------- |
|---|
| 1364 | + |
|---|
| 1365 | +-- | Allows the extension of the assertion mechanism. |
|---|
| 1366 | +-- |
|---|
| 1367 | +-- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions, |
|---|
| 1368 | +-- there is a fair amount of flexibility of what can be achieved. As a rule, |
|---|
| 1369 | +-- the resulting @Assertion@ should be the body of a 'TestCase' or part of |
|---|
| 1370 | +-- a @TestCase@; it should not be used to assert multiple, independent |
|---|
| 1371 | +-- conditions. |
|---|
| 1372 | +-- |
|---|
| 1373 | +-- If more complex arrangements of assertions are needed, 'Test's and |
|---|
| 1374 | +-- 'Testable' should be used. |
|---|
| 1375 | +class Assertable t |
|---|
| 1376 | + where assert :: t -> Assertion |
|---|
| 1377 | + |
|---|
| 1378 | +instance Assertable () |
|---|
| 1379 | + where assert = return |
|---|
| 1380 | + |
|---|
| 1381 | +instance Assertable Bool |
|---|
| 1382 | + where assert = assertBool "" |
|---|
| 1383 | + |
|---|
| 1384 | +instance (ListAssertable t) => Assertable [t] |
|---|
| 1385 | + where assert = listAssert |
|---|
| 1386 | + |
|---|
| 1387 | +instance (Assertable t) => Assertable (IO t) |
|---|
| 1388 | + where assert = (>>= assert) |
|---|
| 1389 | + |
|---|
| 1390 | +-- | A specialized form of 'Assertable' to handle lists. |
|---|
| 1391 | +class ListAssertable t |
|---|
| 1392 | + where listAssert :: [t] -> Assertion |
|---|
| 1393 | + |
|---|
| 1394 | +instance ListAssertable Char |
|---|
| 1395 | + where listAssert = assertString |
|---|
| 1396 | + |
|---|
| 1397 | + |
|---|
| 1398 | +-- Overloaded `assertionPredicate` Function |
|---|
| 1399 | +-- ---------------------------------------- |
|---|
| 1400 | + |
|---|
| 1401 | +-- | The result of an assertion that hasn't been evaluated yet. |
|---|
| 1402 | +-- |
|---|
| 1403 | +-- Most test cases follow the following steps: |
|---|
| 1404 | +-- |
|---|
| 1405 | +-- 1. Do some processing or an action. |
|---|
| 1406 | +-- |
|---|
| 1407 | +-- 2. Assert certain conditions. |
|---|
| 1408 | +-- |
|---|
| 1409 | +-- However, this flow is not always suitable. @AssertionPredicate@ allows for |
|---|
| 1410 | +-- additional steps to be inserted without the initial action to be affected |
|---|
| 1411 | +-- by side effects. Additionally, clean-up can be done before the test case |
|---|
| 1412 | +-- has a chance to end. A potential work flow is: |
|---|
| 1413 | +-- |
|---|
| 1414 | +-- 1. Write data to a file. |
|---|
| 1415 | +-- |
|---|
| 1416 | +-- 2. Read data from a file, evaluate conditions. |
|---|
| 1417 | +-- |
|---|
| 1418 | +-- 3. Clean up the file. |
|---|
| 1419 | +-- |
|---|
| 1420 | +-- 4. Assert that the side effects of the read operation meet certain conditions. |
|---|
| 1421 | +-- |
|---|
| 1422 | +-- 5. Assert that the conditions evaluated in step 2 are met. |
|---|
| 1423 | +type AssertionPredicate = IO Bool |
|---|
| 1424 | + |
|---|
| 1425 | +-- | Used to signify that a data type can be converted to an assertion |
|---|
| 1426 | +-- predicate. |
|---|
| 1427 | +class AssertionPredicable t |
|---|
| 1428 | + where assertionPredicate :: t -> AssertionPredicate |
|---|
| 1429 | + |
|---|
| 1430 | +instance AssertionPredicable Bool |
|---|
| 1431 | + where assertionPredicate = return |
|---|
| 1432 | + |
|---|
| 1433 | +instance (AssertionPredicable t) => AssertionPredicable (IO t) |
|---|
| 1434 | + where assertionPredicate = (>>= assertionPredicate) |
|---|
| 1435 | + |
|---|
| 1436 | + |
|---|
| 1437 | +-- Assertion Construction Operators |
|---|
| 1438 | +-- -------------------------------- |
|---|
| 1439 | + |
|---|
| 1440 | +infix 1 @?, @=?, @?= |
|---|
| 1441 | + |
|---|
| 1442 | +-- | Asserts that the condition obtained from the specified |
|---|
| 1443 | +-- 'AssertionPredicable' holds. |
|---|
| 1444 | +(@?) :: (AssertionPredicable t) => t -- ^ A value of which the asserted condition is predicated |
|---|
| 1445 | + -> String -- ^ A message that is displayed if the assertion fails |
|---|
| 1446 | + -> Assertion |
|---|
| 1447 | +pred @? msg = assertionPredicate pred >>= assertBool msg |
|---|
| 1448 | + |
|---|
| 1449 | +-- | Asserts that the specified actual value is equal to the expected value |
|---|
| 1450 | +-- (with the expected value on the left-hand side). |
|---|
| 1451 | +(@=?) :: (Eq a, Show a) => a -- ^ The expected value |
|---|
| 1452 | + -> a -- ^ The actual value |
|---|
| 1453 | + -> Assertion |
|---|
| 1454 | +expected @=? actual = assertEqual "" expected actual |
|---|
| 1455 | + |
|---|
| 1456 | +-- | Asserts that the specified actual value is equal to the expected value |
|---|
| 1457 | +-- (with the actual value on the left-hand side). |
|---|
| 1458 | +(@?=) :: (Eq a, Show a) => a -- ^ The actual value |
|---|
| 1459 | + -> a -- ^ The expected value |
|---|
| 1460 | + -> Assertion |
|---|
| 1461 | +actual @?= expected = assertEqual "" expected actual |
|---|
| 1462 | + |
|---|
| 1463 | + |
|---|
| 1464 | + |
|---|
| 1465 | +-- Test Definition |
|---|
| 1466 | +-- =============== |
|---|
| 1467 | + |
|---|
| 1468 | +-- | The basic structure used to create an annotated tree of test cases. |
|---|
| 1469 | +data Test |
|---|
| 1470 | + -- | A single, independent test case composed. |
|---|
| 1471 | + = TestCase Assertion |
|---|
| 1472 | + -- | A set of @Test@s sharing the same level in the hierarchy. |
|---|
| 1473 | + | TestList [Test] |
|---|
| 1474 | + -- | A name or description for a subtree of the @Test@s. |
|---|
| 1475 | + | TestLabel String Test |
|---|
| 1476 | + |
|---|
| 1477 | +instance Show Test where |
|---|
| 1478 | + showsPrec p (TestCase _) = showString "TestCase _" |
|---|
| 1479 | + showsPrec p (TestList ts) = showString "TestList " . showList ts |
|---|
| 1480 | + showsPrec p (TestLabel l t) = showString "TestLabel " . showString l |
|---|
| 1481 | + . showChar ' ' . showsPrec p t |
|---|
| 1482 | + |
|---|
| 1483 | +-- Overloaded `test` Function |
|---|
| 1484 | +-- -------------------------- |
|---|
| 1485 | + |
|---|
| 1486 | +-- | Provides a way to convert data into a @Test@ or set of @Test@. |
|---|
| 1487 | +class Testable t |
|---|
| 1488 | + where test :: t -> Test |
|---|
| 1489 | + |
|---|
| 1490 | +instance Testable Test |
|---|
| 1491 | + where test = id |
|---|
| 1492 | + |
|---|
| 1493 | +instance (Assertable t) => Testable (IO t) |
|---|
| 1494 | + where test = TestCase . assert |
|---|
| 1495 | + |
|---|
| 1496 | +instance (Testable t) => Testable [t] |
|---|
| 1497 | + where test = TestList . map test |
|---|
| 1498 | + |
|---|
| 1499 | + |
|---|
| 1500 | +-- Test Construction Operators |
|---|
| 1501 | +-- --------------------------- |
|---|
| 1502 | + |
|---|
| 1503 | +infix 1 ~?, ~=?, ~?= |
|---|
| 1504 | +infixr 0 ~: |
|---|
| 1505 | + |
|---|
| 1506 | +-- | Creates a test case resulting from asserting the condition obtained |
|---|
| 1507 | +-- from the specified 'AssertionPredicable'. |
|---|
| 1508 | +(~?) :: (AssertionPredicable t) => t -- ^ A value of which the asserted condition is predicated |
|---|
| 1509 | + -> String -- ^ A message that is displayed on test failure |
|---|
| 1510 | + -> Test |
|---|
| 1511 | +pred ~? msg = TestCase (pred @? msg) |
|---|
| 1512 | + |
|---|
| 1513 | +-- | Shorthand for a test case that asserts equality (with the expected |
|---|
| 1514 | +-- value on the left-hand side, and the actual value on the right-hand |
|---|
| 1515 | +-- side). |
|---|
| 1516 | +(~=?) :: (Eq a, Show a) => a -- ^ The expected value |
|---|
| 1517 | + -> a -- ^ The actual value |
|---|
| 1518 | + -> Test |
|---|
| 1519 | +expected ~=? actual = TestCase (expected @=? actual) |
|---|
| 1520 | + |
|---|
| 1521 | +-- | Shorthand for a test case that asserts equality (with the actual |
|---|
| 1522 | +-- value on the left-hand side, and the expected value on the right-hand |
|---|
| 1523 | +-- side). |
|---|
| 1524 | +(~?=) :: (Eq a, Show a) => a -- ^ The actual value |
|---|
| 1525 | + -> a -- ^ The expected value |
|---|
| 1526 | + -> Test |
|---|
| 1527 | +actual ~?= expected = TestCase (actual @?= expected) |
|---|
| 1528 | + |
|---|
| 1529 | +-- | Creates a test from the specified 'Testable', with the specified |
|---|
| 1530 | +-- label attached to it. |
|---|
| 1531 | +-- |
|---|
| 1532 | +-- Since 'Test' is @Testable@, this can be used as a shorthand way of attaching |
|---|
| 1533 | +-- a 'TestLabel' to one or more tests. |
|---|
| 1534 | +(~:) :: (Testable t) => String -> t -> Test |
|---|
| 1535 | +label ~: t = TestLabel label (test t) |
|---|
| 1536 | + |
|---|
| 1537 | + |
|---|
| 1538 | + |
|---|
| 1539 | +-- Test Execution |
|---|
| 1540 | +-- ============== |
|---|
| 1541 | + |
|---|
| 1542 | +-- $testExecutionNote |
|---|
| 1543 | +-- Note: the rest of the functionality in this module is intended for |
|---|
| 1544 | +-- implementors of test controllers. If you just want to run your tests cases, |
|---|
| 1545 | +-- simply use a test controller, such as the text-based controller in |
|---|
| 1546 | +-- "Test.HUnit.Text". |
|---|
| 1547 | + |
|---|
| 1548 | +-- | A data structure that hold the results of tests that have been performed |
|---|
| 1549 | +-- up until this point. |
|---|
| 1550 | +data Counts = Counts { cases, tried, errors, failures :: Int } |
|---|
| 1551 | + deriving (Eq, Show, Read) |
|---|
| 1552 | + |
|---|
| 1553 | +-- | Keeps track of the remaining tests and the results of the performed tests. |
|---|
| 1554 | +-- As each test is performed, the path is removed and the counts are |
|---|
| 1555 | +-- updated as appropriate. |
|---|
| 1556 | +data State = State { path :: Path, counts :: Counts } |
|---|
| 1557 | + deriving (Eq, Show, Read) |
|---|
| 1558 | + |
|---|
| 1559 | +-- | Report generator for reporting the start of a test run. |
|---|
| 1560 | +type ReportStart us = State -> us -> IO us |
|---|
| 1561 | + |
|---|
| 1562 | +-- | Report generator for reporting problems that have occurred during |
|---|
| 1563 | +-- a test run. Problems may be errors or assertion failures. |
|---|
| 1564 | +type ReportProblem us = String -> State -> us -> IO us |
|---|
| 1565 | + |
|---|
| 1566 | +-- | Uniquely describes the location of a test within a test hierarchy. |
|---|
| 1567 | +-- Node order is from test case to root. |
|---|
| 1568 | +type Path = [Node] |
|---|
| 1569 | + |
|---|
| 1570 | +-- | Composed into 'Path's. |
|---|
| 1571 | +data Node = ListItem Int | Label String |
|---|
| 1572 | + deriving (Eq, Show, Read) |
|---|
| 1573 | + |
|---|
| 1574 | +-- | Determines the paths for all 'TestCase's in a tree of @Test@s. |
|---|
| 1575 | +testCasePaths :: Test -> [Path] |
|---|
| 1576 | +testCasePaths t = tcp t [] |
|---|
| 1577 | + where tcp (TestCase _) p = [p] |
|---|
| 1578 | + tcp (TestList ts) p = |
|---|
| 1579 | + concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ] |
|---|
| 1580 | + tcp (TestLabel l t) p = tcp t (Label l : p) |
|---|
| 1581 | + |
|---|
| 1582 | +-- | Counts the number of 'TestCase's in a tree of @Test@s. |
|---|
| 1583 | +testCaseCount :: Test -> Int |
|---|
| 1584 | +testCaseCount (TestCase _) = 1 |
|---|
| 1585 | +testCaseCount (TestList ts) = sum (map testCaseCount ts) |
|---|
| 1586 | +testCaseCount (TestLabel _ t) = testCaseCount t |
|---|
| 1587 | + |
|---|
| 1588 | +-- | Performs a test run with the specified report generators. |
|---|
| 1589 | +-- |
|---|
| 1590 | +-- This handles the actual running of the tests. Most developers will want |
|---|
| 1591 | +-- to use @HUnit.Text.runTestTT@ instead. A developer could use this function |
|---|
| 1592 | +-- to execute tests via another IO system, such as a GUI, or to output the |
|---|
| 1593 | +-- results in a different manner (e.g., upload XML-formatted results to a |
|---|
| 1594 | +-- webservice). |
|---|
| 1595 | +-- |
|---|
| 1596 | +-- Note that the counts in a start report do not include the test case |
|---|
| 1597 | +-- being started, whereas the counts in a problem report do include the |
|---|
| 1598 | +-- test case just finished. The principle is that the counts are sampled |
|---|
| 1599 | +-- only between test case executions. As a result, the number of test |
|---|
| 1600 | +-- case successes always equals the difference of test cases tried and |
|---|
| 1601 | +-- the sum of test case errors and failures. |
|---|
| 1602 | +performTest :: ReportStart us -- ^ report generator for the test run start |
|---|
| 1603 | + -> ReportProblem us -- ^ report generator for errors during the test run |
|---|
| 1604 | + -> ReportProblem us -- ^ report generator for assertion failures during the test run |
|---|
| 1605 | + -> us |
|---|
| 1606 | + -> Test -- ^ the test to be executed |
|---|
| 1607 | + -> IO (Counts, us) |
|---|
| 1608 | +performTest reportStart reportError reportFailure us t = do |
|---|
| 1609 | + (ss', us') <- pt initState us t |
|---|
| 1610 | + unless (null (path ss')) $ error "performTest: Final path is nonnull" |
|---|
| 1611 | + return (counts ss', us') |
|---|
| 1612 | + where |
|---|
| 1613 | + initState = State{ path = [], counts = initCounts } |
|---|
| 1614 | + initCounts = Counts{ cases = testCaseCount t, tried = 0, |
|---|
| 1615 | + errors = 0, failures = 0} |
|---|
| 1616 | + |
|---|
| 1617 | + pt ss us (TestCase a) = do |
|---|
| 1618 | + us' <- reportStart ss us |
|---|
| 1619 | + r <- performTestCase a |
|---|
| 1620 | + case r of Nothing -> do return (ss', us') |
|---|
| 1621 | + Just (True, m) -> do usF <- reportFailure m ssF us' |
|---|
| 1622 | + return (ssF, usF) |
|---|
| 1623 | + Just (False, m) -> do usE <- reportError m ssE us' |
|---|
| 1624 | + return (ssE, usE) |
|---|
| 1625 | + where c@Counts{ tried = t } = counts ss |
|---|
| 1626 | + ss' = ss{ counts = c{ tried = t + 1 } } |
|---|
| 1627 | + ssF = ss{ counts = c{ tried = t + 1, failures = failures c + 1 } } |
|---|
| 1628 | + ssE = ss{ counts = c{ tried = t + 1, errors = errors c + 1 } } |
|---|
| 1629 | + |
|---|
| 1630 | + pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..]) |
|---|
| 1631 | + where f (ss, us) (t, n) = withNode (ListItem n) ss us t |
|---|
| 1632 | + |
|---|
| 1633 | + pt ss us (TestLabel label t) = withNode (Label label) ss us t |
|---|
| 1634 | + |
|---|
| 1635 | + withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t |
|---|
| 1636 | + return (ss2{ path = path0 }, us1) |
|---|
| 1637 | + where path0 = path ss0 |
|---|
| 1638 | + ss1 = ss0{ path = node : path0 } |
|---|
| 1639 | hunk ./Test/HUnit/Lang.hs 1 |
|---|
| 1640 | +-- | This module abstracts the differences between implementations of |
|---|
| 1641 | +-- Haskell (e.g., GHC, Hugs, and NHC). |
|---|
| 1642 | + |
|---|
| 1643 | +module Test.HUnit.Lang |
|---|
| 1644 | +( |
|---|
| 1645 | + Assertion, |
|---|
| 1646 | + assertFailure, |
|---|
| 1647 | + performTestCase |
|---|
| 1648 | +) |
|---|
| 1649 | +where |
|---|
| 1650 | + |
|---|
| 1651 | + |
|---|
| 1652 | +-- When adapting this module for other Haskell language systems, change |
|---|
| 1653 | +-- the imports and the implementations but not the interfaces. |
|---|
| 1654 | + |
|---|
| 1655 | + |
|---|
| 1656 | + |
|---|
| 1657 | +-- Imports |
|---|
| 1658 | +-- ------- |
|---|
| 1659 | + |
|---|
| 1660 | +import Data.List (isPrefixOf) |
|---|
| 1661 | +#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) |
|---|
| 1662 | +import Data.Dynamic |
|---|
| 1663 | +import Control.Exception as E |
|---|
| 1664 | +#else |
|---|
| 1665 | +import System.IO.Error (ioeGetErrorString, try) |
|---|
| 1666 | +#endif |
|---|
| 1667 | + |
|---|
| 1668 | + |
|---|
| 1669 | + |
|---|
| 1670 | +-- Interfaces |
|---|
| 1671 | +-- ---------- |
|---|
| 1672 | + |
|---|
| 1673 | +-- | When an assertion is evaluated, it will output a message if and only if the |
|---|
| 1674 | +-- assertion fails. |
|---|
| 1675 | +-- |
|---|
| 1676 | +-- Test cases are composed of a sequence of one or more assertions. |
|---|
| 1677 | + |
|---|
| 1678 | +type Assertion = IO () |
|---|
| 1679 | + |
|---|
| 1680 | +-- | Unconditionally signals that a failure has occured. All |
|---|
| 1681 | +-- other assertions can be expressed with the form: |
|---|
| 1682 | +-- |
|---|
| 1683 | +-- @ |
|---|
| 1684 | +-- if conditionIsMet |
|---|
| 1685 | +-- then IO () |
|---|
| 1686 | +-- else assertFailure msg |
|---|
| 1687 | +-- @ |
|---|
| 1688 | + |
|---|
| 1689 | +assertFailure :: String -- ^ A message that is displayed with the assertion failure |
|---|
| 1690 | + -> Assertion |
|---|
| 1691 | + |
|---|
| 1692 | +-- | Performs a single test case. The meaning of the result is as follows: |
|---|
| 1693 | +-- |
|---|
| 1694 | +-- [@Nothing@] test case success |
|---|
| 1695 | +-- |
|---|
| 1696 | +-- [@Just (True, msg)@] test case failure with the given message |
|---|
| 1697 | +-- |
|---|
| 1698 | +-- [@Just (False, msg)@] test case error with the given message |
|---|
| 1699 | + |
|---|
| 1700 | +performTestCase :: Assertion -- ^ an assertion to be made during the test case run |
|---|
| 1701 | + -> IO (Maybe (Bool, String)) |
|---|
| 1702 | + |
|---|
| 1703 | + |
|---|
| 1704 | +-- Implementations |
|---|
| 1705 | +-- --------------- |
|---|
| 1706 | + |
|---|
| 1707 | +#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) |
|---|
| 1708 | +data HUnitFailure = HUnitFailure String |
|---|
| 1709 | + deriving Show |
|---|
| 1710 | + |
|---|
| 1711 | +hunitFailureTc :: TyCon |
|---|
| 1712 | +hunitFailureTc = mkTyCon "HUnitFailure" |
|---|
| 1713 | +{-# NOINLINE hunitFailureTc #-} |
|---|
| 1714 | + |
|---|
| 1715 | +instance Typeable HUnitFailure where |
|---|
| 1716 | + typeOf _ = mkTyConApp hunitFailureTc [] |
|---|
| 1717 | +#ifdef BASE4 |
|---|
| 1718 | +instance Exception HUnitFailure |
|---|
| 1719 | + |
|---|
| 1720 | +assertFailure msg = E.throw (HUnitFailure msg) |
|---|
| 1721 | + |
|---|
| 1722 | +performTestCase action = |
|---|
| 1723 | + do action |
|---|
| 1724 | + return Nothing |
|---|
| 1725 | + `E.catches` |
|---|
| 1726 | + [E.Handler (\(HUnitFailure msg) -> return $ Just (True, msg)), |
|---|
| 1727 | + E.Handler (\e -> return $ Just (False, show (e :: E.SomeException)))] |
|---|
| 1728 | +#else |
|---|
| 1729 | +assertFailure msg = E.throwDyn (HUnitFailure msg) |
|---|
| 1730 | + |
|---|
| 1731 | +performTestCase action = |
|---|
| 1732 | + do r <- E.try action |
|---|
| 1733 | + case r of |
|---|
| 1734 | + Right () -> return Nothing |
|---|
| 1735 | + Left e@(E.DynException dyn) -> |
|---|
| 1736 | + case fromDynamic dyn of |
|---|
| 1737 | + Just (HUnitFailure msg) -> return $ Just (True, msg) |
|---|
| 1738 | + Nothing -> return $ Just (False, show e) |
|---|
| 1739 | + Left e -> return $ Just (False, show e) |
|---|
| 1740 | +#endif |
|---|
| 1741 | +#else |
|---|
| 1742 | +hunitPrefix = "HUnit:" |
|---|
| 1743 | + |
|---|
| 1744 | +nhc98Prefix = "I/O error (user-defined), call to function `userError':\n " |
|---|
| 1745 | + |
|---|
| 1746 | +assertFailure msg = ioError (userError (hunitPrefix ++ msg)) |
|---|
| 1747 | + |
|---|
| 1748 | +performTestCase action = do r <- try action |
|---|
| 1749 | + case r of Right () -> return Nothing |
|---|
| 1750 | + Left e -> return (Just (decode e)) |
|---|
| 1751 | + where |
|---|
| 1752 | + decode e = let s0 = ioeGetErrorString e |
|---|
| 1753 | + (_, s1) = dropPrefix nhc98Prefix s0 |
|---|
| 1754 | + in dropPrefix hunitPrefix s1 |
|---|
| 1755 | + dropPrefix pref str = if pref `isPrefixOf` str |
|---|
| 1756 | + then (True, drop (length pref) str) |
|---|
| 1757 | + else (False, str) |
|---|
| 1758 | +#endif |
|---|
| 1759 | hunk ./Test/HUnit/Terminal.hs 1 |
|---|
| 1760 | +-- | This module handles the complexities of writing information to the |
|---|
| 1761 | +-- terminal, including modifying text in place. |
|---|
| 1762 | + |
|---|
| 1763 | +module Test.HUnit.Terminal ( |
|---|
| 1764 | + terminalAppearance |
|---|
| 1765 | + ) where |
|---|
| 1766 | + |
|---|
| 1767 | +import Data.Char (isPrint) |
|---|
| 1768 | + |
|---|
| 1769 | + |
|---|
| 1770 | +-- | Simplifies the input string by interpreting @\\r@ and @\\b@ characters |
|---|
| 1771 | +-- specially so that the result string has the same final (or /terminal/, |
|---|
| 1772 | +-- pun intended) appearance as would the input string when written to a |
|---|
| 1773 | +-- terminal that overwrites character positions following carriage |
|---|
| 1774 | +-- returns and backspaces. |
|---|
| 1775 | + |
|---|
| 1776 | +terminalAppearance :: String -> String |
|---|
| 1777 | +terminalAppearance str = ta id "" "" str |
|---|
| 1778 | + |
|---|
| 1779 | +-- | The helper function @ta@ takes an accumulating @ShowS@-style function |
|---|
| 1780 | +-- that holds /committed/ lines of text, a (reversed) list of characters |
|---|
| 1781 | +-- on the current line /before/ the cursor, a (normal) list of characters |
|---|
| 1782 | +-- on the current line /after/ the cursor, and the remaining input. |
|---|
| 1783 | + |
|---|
| 1784 | +ta |
|---|
| 1785 | + :: ([Char] -> t) -- ^ An accumulating @ShowS@-style function |
|---|
| 1786 | + -- that holds /committed/ lines of text |
|---|
| 1787 | + -> [Char] -- ^ A (reversed) list of characters |
|---|
| 1788 | + -- on the current line /before/ the cursor |
|---|
| 1789 | + -> [Char] -- ^ A (normal) list of characters |
|---|
| 1790 | + -- on the current line /after/ the cursor |
|---|
| 1791 | + -> [Char] -- ^ The remaining input |
|---|
| 1792 | + -> t |
|---|
| 1793 | +ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs |
|---|
| 1794 | +ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs |
|---|
| 1795 | +ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs |
|---|
| 1796 | +ta _ "" _ ('\b': _) = error "'\\b' at beginning of line" |
|---|
| 1797 | +ta f bs as (c:cs) |
|---|
| 1798 | + | not (isPrint c) = error "invalid nonprinting character" |
|---|
| 1799 | + | null as = ta f (c:bs) "" cs |
|---|
| 1800 | + | otherwise = ta f (c:bs) (tail as) cs |
|---|
| 1801 | +ta f bs as "" = f (reverse bs ++ as) |
|---|
| 1802 | hunk ./Test/HUnit/Text.hs 1 |
|---|
| 1803 | +-- | Text-based test controller for running HUnit tests and reporting |
|---|
| 1804 | +-- results as text, usually to a terminal. |
|---|
| 1805 | + |
|---|
| 1806 | +module Test.HUnit.Text |
|---|
| 1807 | +( |
|---|
| 1808 | + PutText(..), |
|---|
| 1809 | + putTextToHandle, putTextToShowS, |
|---|
| 1810 | + runTestText, |
|---|
| 1811 | + showPath, showCounts, |
|---|
| 1812 | + runTestTT |
|---|
| 1813 | +) |
|---|
| 1814 | +where |
|---|
| 1815 | + |
|---|
| 1816 | +import Test.HUnit.Base |
|---|
| 1817 | + |
|---|
| 1818 | +import Control.Monad (when) |
|---|
| 1819 | +import System.IO (Handle, stderr, hPutStr, hPutStrLn) |
|---|
| 1820 | + |
|---|
| 1821 | + |
|---|
| 1822 | +-- | As the general text-based test controller ('runTestText') executes a |
|---|
| 1823 | +-- test, it reports each test case start, error, and failure by |
|---|
| 1824 | +-- constructing a string and passing it to the function embodied in a |
|---|
| 1825 | +-- 'PutText'. A report string is known as a \"line\", although it includes |
|---|
| 1826 | +-- no line terminator; the function in a 'PutText' is responsible for |
|---|
| 1827 | +-- terminating lines appropriately. Besides the line, the function |
|---|
| 1828 | +-- receives a flag indicating the intended \"persistence\" of the line: |
|---|
| 1829 | +-- 'True' indicates that the line should be part of the final overall |
|---|
| 1830 | +-- report; 'False' indicates that the line merely indicates progress of |
|---|
| 1831 | +-- the test execution. Each progress line shows the current values of |
|---|
| 1832 | +-- the cumulative test execution counts; a final, persistent line shows |
|---|
| 1833 | +-- the final count values. |
|---|
| 1834 | +-- |
|---|
| 1835 | +-- The 'PutText' function is also passed, and returns, an arbitrary state |
|---|
| 1836 | +-- value (called 'st' here). The initial state value is given in the |
|---|
| 1837 | +-- 'PutText'; the final value is returned by 'runTestText'. |
|---|
| 1838 | + |
|---|
| 1839 | +data PutText st = PutText (String -> Bool -> st -> IO st) st |
|---|
| 1840 | + |
|---|
| 1841 | + |
|---|
| 1842 | +-- | Two reporting schemes are defined here. @putTextToHandle@ writes |
|---|
| 1843 | +-- report lines to a given handle. 'putTextToShowS' accumulates |
|---|
| 1844 | +-- persistent lines for return as a whole by 'runTestText'. |
|---|
| 1845 | +-- |
|---|
| 1846 | +-- @putTextToHandle@ writes persistent lines to the given handle, |
|---|
| 1847 | +-- following each by a newline character. In addition, if the given flag |
|---|
| 1848 | +-- is @True@, it writes progress lines to the handle as well. A progress |
|---|
| 1849 | +-- line is written with no line termination, so that it can be |
|---|
| 1850 | +-- overwritten by the next report line. As overwriting involves writing |
|---|
| 1851 | +-- carriage return and blank characters, its proper effect is usually |
|---|
| 1852 | +-- only obtained on terminal devices. |
|---|
| 1853 | + |
|---|
| 1854 | +putTextToHandle |
|---|
| 1855 | + :: Handle |
|---|
| 1856 | + -> Bool -- ^ Write progress lines to handle? |
|---|
| 1857 | + -> PutText Int |
|---|
| 1858 | +putTextToHandle handle showProgress = PutText put initCnt |
|---|
| 1859 | + where |
|---|
| 1860 | + initCnt = if showProgress then 0 else -1 |
|---|
| 1861 | + put line pers (-1) = do when pers (hPutStrLn handle line); return (-1) |
|---|
| 1862 | + put line True cnt = do hPutStrLn handle (erase cnt ++ line); return 0 |
|---|
| 1863 | + put line False cnt = do hPutStr handle ('\r' : line); return (length line) |
|---|
| 1864 | + -- The "erasing" strategy with a single '\r' relies on the fact that the |
|---|
| 1865 | + -- lengths of successive summary lines are monotonically nondecreasing. |
|---|
| 1866 | + erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" |
|---|
| 1867 | + |
|---|
| 1868 | + |
|---|
| 1869 | +-- | Accumulates persistent lines (dropping progess lines) for return by |
|---|
| 1870 | +-- 'runTestText'. The accumulated lines are represented by a |
|---|
| 1871 | +-- @'ShowS' ('String' -> 'String')@ function whose first argument is the |
|---|
| 1872 | +-- string to be appended to the accumulated report lines. |
|---|
| 1873 | + |
|---|
| 1874 | +putTextToShowS :: PutText ShowS |
|---|
| 1875 | +putTextToShowS = PutText put id |
|---|
| 1876 | + where put line pers f = return (if pers then acc f line else f) |
|---|
| 1877 | + acc f line tail = f (line ++ '\n' : tail) |
|---|
| 1878 | + |
|---|
| 1879 | + |
|---|
| 1880 | +-- | Executes a test, processing each report line according to the given |
|---|
| 1881 | +-- reporting scheme. The reporting scheme's state is threaded through calls |
|---|
| 1882 | +-- to the reporting scheme's function and finally returned, along with final |
|---|
| 1883 | +-- count values. |
|---|
| 1884 | + |
|---|
| 1885 | +runTestText :: PutText st -> Test -> IO (Counts, st) |
|---|
| 1886 | +runTestText (PutText put us) t = do |
|---|
| 1887 | + (counts, us') <- performTest reportStart reportError reportFailure us t |
|---|
| 1888 | + us'' <- put (showCounts counts) True us' |
|---|
| 1889 | + return (counts, us'') |
|---|
| 1890 | + where |
|---|
| 1891 | + reportStart ss us = put (showCounts (counts ss)) False us |
|---|
| 1892 | + reportError = reportProblem "Error:" "Error in: " |
|---|
| 1893 | + reportFailure = reportProblem "Failure:" "Failure in: " |
|---|
| 1894 | + reportProblem p0 p1 msg ss us = put line True us |
|---|
| 1895 | + where line = "### " ++ kind ++ path' ++ '\n' : msg |
|---|
| 1896 | + kind = if null path' then p0 else p1 |
|---|
| 1897 | + path' = showPath (path ss) |
|---|
| 1898 | + |
|---|
| 1899 | + |
|---|
| 1900 | +-- | Converts test execution counts to a string. |
|---|
| 1901 | + |
|---|
| 1902 | +showCounts :: Counts -> String |
|---|
| 1903 | +showCounts Counts{ cases = cases, tried = tried, |
|---|
| 1904 | + errors = errors, failures = failures } = |
|---|
| 1905 | + "Cases: " ++ show cases ++ " Tried: " ++ show tried ++ |
|---|
| 1906 | + " Errors: " ++ show errors ++ " Failures: " ++ show failures |
|---|
| 1907 | + |
|---|
| 1908 | + |
|---|
| 1909 | +-- | Converts a test case path to a string, separating adjacent elements by |
|---|
| 1910 | +-- the colon (\':\'). An element of the path is quoted (as with 'show') when |
|---|
| 1911 | +-- there is potential ambiguity. |
|---|
| 1912 | + |
|---|
| 1913 | +showPath :: Path -> String |
|---|
| 1914 | +showPath [] = "" |
|---|
| 1915 | +showPath nodes = foldl1 f (map showNode nodes) |
|---|
| 1916 | + where f b a = a ++ ":" ++ b |
|---|
| 1917 | + showNode (ListItem n) = show n |
|---|
| 1918 | + showNode (Label label) = safe label (show label) |
|---|
| 1919 | + safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s |
|---|
| 1920 | + |
|---|
| 1921 | + |
|---|
| 1922 | +-- | Provides the \"standard\" text-based test controller. Reporting is made to |
|---|
| 1923 | +-- standard error, and progress reports are included. For possible |
|---|
| 1924 | +-- programmatic use, the final counts are returned. |
|---|
| 1925 | +-- |
|---|
| 1926 | +-- The \"TT\" in the name suggests \"Text-based reporting to the Terminal\". |
|---|
| 1927 | + |
|---|
| 1928 | +runTestTT :: Test -> IO Counts |
|---|
| 1929 | +runTestTT t = do (counts, 0) <- runTestText (putTextToHandle stderr True) t |
|---|
| 1930 | + return counts |
|---|
| 1931 | hunk ./doc/Guide.html 1 |
|---|
| 1932 | -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> |
|---|
| 1933 | -<html> |
|---|
| 1934 | -<head> |
|---|
| 1935 | - <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> |
|---|
| 1936 | - <meta name="Author" content="Dean Herington"> |
|---|
| 1937 | - <meta name="KeyWords" content="HUnit, unit testing, test-first development, Haskell, JUnit"> |
|---|
| 1938 | - <meta name="Content-Type" content="text/html; charset=iso-8859-1"> |
|---|
| 1939 | - <title>HUnit 1.0 User's Guide</title> |
|---|
| 1940 | -</head> |
|---|
| 1941 | -<body> |
|---|
| 1942 | +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" |
|---|
| 1943 | + "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"> |
|---|
| 1944 | +<html xmlns="http://www.w3.org/1999/xhtml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" |
|---|
| 1945 | + xsi:schemaLocation="http://www.w3.org/MarkUp/SCHEMA/xhtml11.xsd" xml:lang="en"> |
|---|
| 1946 | + <head> |
|---|
| 1947 | + <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/> |
|---|
| 1948 | + <meta name="Author" content="Dean Herington"/> |
|---|
| 1949 | + <meta name="KeyWords" content="HUnit, unit testing, test-first development, Haskell, JUnit"/> |
|---|
| 1950 | + <title>HUnit 1.0 User's Guide</title> |
|---|
| 1951 | + </head> |
|---|
| 1952 | + <body> |
|---|
| 1953 | |
|---|
| 1954 | hunk ./doc/Guide.html 13 |
|---|
| 1955 | -<h1>HUnit 1.0 User's Guide</h1> |
|---|
| 1956 | + <h1>HUnit 1.2 User's Guide</h1> |
|---|
| 1957 | |
|---|
| 1958 | hunk ./doc/Guide.html 15 |
|---|
| 1959 | -HUnit is a unit testing framework for Haskell, inspired by the JUnit |
|---|
| 1960 | -tool for Java. This guide describes how to use HUnit, assuming |
|---|
| 1961 | -you are familiar with Haskell, though not necessarily with |
|---|
| 1962 | -JUnit. You can obtain HUnit, including this guide, at |
|---|
| 1963 | -<a href="http://hunit.sourceforge.net">http://hunit.sourceforge.net</a>. |
|---|
| 1964 | + <p>HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java. This |
|---|
| 1965 | + guide describes how to use HUnit, assuming you are familiar with Haskell, though not |
|---|
| 1966 | + necessarily with JUnit. You can obtain HUnit, including this guide, at <a |
|---|
| 1967 | + href="http://code.haskell.org/HUnit">http://code.haskell.org/HUnit</a>.</p> |
|---|
| 1968 | |
|---|
| 1969 | hunk ./doc/Guide.html 20 |
|---|
| 1970 | -<h2>Introduction</h2> |
|---|
| 1971 | + <h2>Introduction</h2> |
|---|
| 1972 | |
|---|
| 1973 | hunk ./doc/Guide.html 22 |
|---|
| 1974 | -A test-centered methodology for software development is most effective |
|---|
| 1975 | -when tests are easy to create, change, and execute. The <a |
|---|
| 1976 | -href="http://www.junit.org">JUnit</a> tool pioneered support for |
|---|
| 1977 | -test-first development in <a href="http://java.sun.com">Java</a>. |
|---|
| 1978 | -HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely |
|---|
| 1979 | -functional programming language. (To learn more about Haskell, |
|---|
| 1980 | -see <a href="http://www.haskell.org">http://www.haskell.org</a>.) |
|---|
| 1981 | -<p> |
|---|
| 1982 | -With HUnit, as with JUnit, you can easily create tests, name them, |
|---|
| 1983 | -group them into suites, and execute them, with the framework checking |
|---|
| 1984 | -the results automatically. Test specification in HUnit is even |
|---|
| 1985 | -more concise and flexible than in JUnit, thanks to the nature of the |
|---|
| 1986 | -Haskell language. HUnit currently includes only a text-based |
|---|
| 1987 | -test controller, but the framework is designed for easy |
|---|
| 1988 | -extension. (Would anyone care to write a graphical test |
|---|
| 1989 | -controller for HUnit?) |
|---|
| 1990 | -<p> |
|---|
| 1991 | -The next section helps you get started using HUnit in simple |
|---|
| 1992 | -ways. Subsequent sections give details on <a |
|---|
| 1993 | -href="#WritingTests">writing tests</a> and <a |
|---|
| 1994 | -href="#RunningTests">running tests</a>. The document concludes |
|---|
| 1995 | -with a section describing HUnit's <a |
|---|
| 1996 | -href="#ConstituentFiles">constituent files</a> and a section giving |
|---|
| 1997 | -<a href="#References">references</a> to further information. |
|---|
| 1998 | + <p>A test-centered methodology for software development is most effective when tests are |
|---|
| 1999 | + easy to create, change, and execute. The <a href="http://www.junit.org">JUnit</a> tool |
|---|
| 2000 | + pioneered support for test-first development in <a href="http://java.sun.com">Java</a>. |
|---|
| 2001 | + HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely functional |
|---|
| 2002 | + programming language. (To learn more about Haskell, see <a href="http://www.haskell.org" |
|---|
| 2003 | + >http://www.haskell.org</a>.)</p> |
|---|
| 2004 | |
|---|
| 2005 | hunk ./doc/Guide.html 29 |
|---|
| 2006 | -<h2><a name="GettingStarted">Getting Started</a></h2> |
|---|
| 2007 | + <p>With HUnit, as with JUnit, you can easily create tests, name them, group them into |
|---|
| 2008 | + suites, and execute them, with the framework checking the results automatically. Test |
|---|
| 2009 | + specification in HUnit is even more concise and flexible than in JUnit, thanks to the |
|---|
| 2010 | + nature of the Haskell language. HUnit currently includes only a text-based test |
|---|
| 2011 | + controller, but the framework is designed for easy extension. (Would anyone care to |
|---|
| 2012 | + write a graphical test controller for HUnit?)</p> |
|---|
| 2013 | |
|---|
| 2014 | hunk ./doc/Guide.html 36 |
|---|
| 2015 | -In the Haskell module where your tests will reside, import module |
|---|
| 2016 | -<tt>Test.HUnit</tt>: |
|---|
| 2017 | -<pre> |
|---|
| 2018 | + <p>The next section helps you get started using HUnit in simple ways. Subsequent sections |
|---|
| 2019 | + give details on <a href="#WritingTests">writing tests</a> and <a href="#RunningTests" |
|---|
| 2020 | + >running tests</a>. The document concludes with a section describing HUnit's <a |
|---|
| 2021 | + href="#ConstituentFiles">constituent files</a> and a section giving <a |
|---|
| 2022 | + href="#References">references</a> to further information.</p> |
|---|
| 2023 | + |
|---|
| 2024 | + <h2 id="GettingStarted">Getting Started</h2> |
|---|
| 2025 | + |
|---|
| 2026 | + <p>In the Haskell module where your tests will reside, import module <tt>Test.HUnit</tt>:</p> |
|---|
| 2027 | + <pre> |
|---|
| 2028 | import Test.HUnit |
|---|
| 2029 | </pre> |
|---|
| 2030 | hunk ./doc/Guide.html 48 |
|---|
| 2031 | -Define test cases as appropriate: |
|---|
| 2032 | -<pre> |
|---|
| 2033 | + <p>Define test cases as appropriate:</p> |
|---|
| 2034 | + <pre> |
|---|
| 2035 | test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3)) |
|---|
| 2036 | test2 = TestCase (do (x,y) <- partA 3 |
|---|
| 2037 | assertEqual "for the first result of partA," 5 x |
|---|
| 2038 | hunk ./doc/Guide.html 56 |
|---|
| 2039 | b <- partB y |
|---|
| 2040 | assertBool ("(partB " ++ show y ++ ") failed") b) |
|---|
| 2041 | </pre> |
|---|
| 2042 | -Name the test cases and group them together: |
|---|
| 2043 | -<pre> |
|---|
| 2044 | + <p>Name the test cases and group them together:</p> |
|---|
| 2045 | + <pre> |
|---|
| 2046 | tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2] |
|---|
| 2047 | </pre> |
|---|
| 2048 | hunk ./doc/Guide.html 60 |
|---|
| 2049 | -Run the tests as a group. At a Haskell interpreter prompt, apply |
|---|
| 2050 | -the function <tt>runTestTT</tt> to the collected tests. (The |
|---|
| 2051 | -"<tt>TT</tt>" suggests <b><u>t</u></b>ext orientation with output to |
|---|
| 2052 | -the <b><u>t</u></b>erminal.) |
|---|
| 2053 | -<pre> |
|---|
| 2054 | + <p>Run the tests as a group. At a Haskell interpreter prompt, apply the function |
|---|
| 2055 | + <tt>runTestTT</tt> to the collected tests. (The "<tt>TT</tt>" suggests |
|---|
| 2056 | + <strong>T</strong>ext orientation with output to the <strong>T</strong>erminal.)</p> |
|---|
| 2057 | + <pre> |
|---|
| 2058 | > runTestTT tests |
|---|
| 2059 | Cases: 2 Tried: 2 Errors: 0 Failures: 0 |
|---|
| 2060 | > |
|---|
| 2061 | hunk ./doc/Guide.html 68 |
|---|
| 2062 | </pre> |
|---|
| 2063 | -If the tests are proving their worth, you might see: |
|---|
| 2064 | -<pre> |
|---|
| 2065 | + <p>If the tests are proving their worth, you might see:</p> |
|---|
| 2066 | + <pre> |
|---|
| 2067 | > runTestTT tests |
|---|
| 2068 | ### Failure in: 0:test1 |
|---|
| 2069 | for (foo 3), |
|---|
| 2070 | hunk ./doc/Guide.html 78 |
|---|
| 2071 | Cases: 2 Tried: 2 Errors: 0 Failures: 1 |
|---|
| 2072 | > |
|---|
| 2073 | </pre> |
|---|
| 2074 | -Isn't that easy? |
|---|
| 2075 | -<p> |
|---|
| 2076 | -You can specify tests even more succinctly using operators and |
|---|
| 2077 | -overloaded functions that HUnit provides: |
|---|
| 2078 | -<pre> |
|---|
| 2079 | + <p>Isn't that easy?</p> |
|---|
| 2080 | + |
|---|
| 2081 | + <p>You can specify tests even more succinctly using operators and overloaded functions that |
|---|
| 2082 | + HUnit provides:</p> |
|---|
| 2083 | + <pre> |
|---|
| 2084 | tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3), |
|---|
| 2085 | "test2" ~: do (x, y) <- partA 3 |
|---|
| 2086 | assertEqual "for the first result of partA," 5 x |
|---|
| 2087 | hunk ./doc/Guide.html 88 |
|---|
| 2088 | partB y @? "(partB " ++ show y ++ ") failed" ] |
|---|
| 2089 | </pre> |
|---|
| 2090 | -Assuming the same test failures as before, you would see: |
|---|
| 2091 | -<pre> |
|---|
| 2092 | + <p>Assuming the same test failures as before, you would see:</p> |
|---|
| 2093 | + <pre> |
|---|
| 2094 | > runTestTT tests |
|---|
| 2095 | ### Failure in: 0:test1:(foo 3) |
|---|
| 2096 | expected: (1,2) |
|---|
| 2097 | hunk ./doc/Guide.html 98 |
|---|
| 2098 | > |
|---|
| 2099 | </pre> |
|---|
| 2100 | |
|---|
| 2101 | -<h2><a name="WritingTests"></a>Writing Tests</h2> |
|---|
| 2102 | + <h2 id="WritingTests">Writing Tests</h2> |
|---|
| 2103 | |
|---|
| 2104 | hunk ./doc/Guide.html 100 |
|---|
| 2105 | -Tests are specified compositionally. <a |
|---|
| 2106 | -href="#Assertions">Assertions</a> are combined to make a <a |
|---|
| 2107 | -href="#TestCase">test case</a>, and test cases are combined into <a |
|---|
| 2108 | -href="#Tests">tests</a>. HUnit also provides <a |
|---|
| 2109 | -href="#AdvancedFeatures">advanced features</a> for more convenient |
|---|
| 2110 | -test specification. |
|---|
| 2111 | + <p>Tests are specified compositionally. <a href="#Assertions">Assertions</a> are combined to |
|---|
| 2112 | + make a <a href="#TestCase">test case</a>, and test cases are combined into <a |
|---|
| 2113 | + href="#Tests">tests</a>. HUnit also provides <a href="#AdvancedFeatures">advanced |
|---|
| 2114 | + features</a> for more convenient test specification.</p> |
|---|
| 2115 | |
|---|
| 2116 | hunk ./doc/Guide.html 105 |
|---|
| 2117 | -<h3><a name="Assertions"></a>Assertions</h3> |
|---|
| 2118 | + <h3 id="Assertions">Assertions</h3> |
|---|
| 2119 | |
|---|
| 2120 | hunk ./doc/Guide.html 107 |
|---|
| 2121 | -The basic building block of a test is an <b>assertion</b>. |
|---|
| 2122 | -<pre> |
|---|
| 2123 | + <p>The basic building block of a test is an <b>assertion</b>.</p> |
|---|
| 2124 | + <pre> |
|---|
| 2125 | type Assertion = IO () |
|---|
| 2126 | </pre> |
|---|
| 2127 | hunk ./doc/Guide.html 111 |
|---|
| 2128 | -An assertion is an <tt>IO</tt> computation that always produces a void |
|---|
| 2129 | -result. Why is an assertion an <tt>IO</tt> computation? So that |
|---|
| 2130 | -programs with real-world side effects can be tested. How does an |
|---|
| 2131 | -assertion assert anything if it produces no useful result? The answer |
|---|
| 2132 | -is that an assertion can signal failure by calling |
|---|
| 2133 | -<tt>assertFailure</tt>. |
|---|
| 2134 | -<pre> |
|---|
| 2135 | + <p>An assertion is an <tt>IO</tt> computation that always produces a void result. Why is an |
|---|
| 2136 | + assertion an <tt>IO</tt> computation? So that programs with real-world side effects can |
|---|
| 2137 | + be tested. How does an assertion assert anything if it produces no useful result? The |
|---|
| 2138 | + answer is that an assertion can signal failure by calling <tt>assertFailure</tt>.</p> |
|---|
| 2139 | + <pre> |
|---|
| 2140 | assertFailure :: String -> Assertion |
|---|
| 2141 | assertFailure msg = ioError (userError ("HUnit:" ++ msg)) |
|---|
| 2142 | </pre> |
|---|
| 2143 | hunk ./doc/Guide.html 119 |
|---|
| 2144 | -<tt>(assertFailure msg)</tt> raises an exception. The string |
|---|
| 2145 | -argument identifies the failure. The failure message is prefixed |
|---|
| 2146 | -by "<tt>HUnit:</tt>" to mark it as an HUnit assertion failure |
|---|
| 2147 | -message. The HUnit test framework interprets such an exception |
|---|
| 2148 | -as indicating failure of the test whose execution raised the |
|---|
| 2149 | -exception. (Note: The details concerning the implementation of |
|---|
| 2150 | -<tt>assertFailure</tt> are subject to change and should not be relied |
|---|
| 2151 | -upon.) |
|---|
| 2152 | -<p> |
|---|
| 2153 | -<tt>assertFailure</tt> can be used directly, but it is much more |
|---|
| 2154 | -common to use it indirectly through other assertion functions that |
|---|
| 2155 | -conditionally assert failure. |
|---|
| 2156 | -<pre> |
|---|
| 2157 | + <p><tt>(assertFailure msg)</tt> raises an exception. The string argument identifies the |
|---|
| 2158 | + failure. The failure message is prefixed by "<tt>HUnit:</tt>" to mark it as an HUnit |
|---|
| 2159 | + assertion failure message. The HUnit test framework interprets such an exception as |
|---|
| 2160 | + indicating failure of the test whose execution raised the exception. (Note: The details |
|---|
| 2161 | + concerning the implementation of <tt>assertFailure</tt> are subject to change and should |
|---|
| 2162 | + not be relied upon.)</p> |
|---|
| 2163 | + |
|---|
| 2164 | + <p><tt>assertFailure</tt> can be used directly, but it is much more common to use it |
|---|
| 2165 | + indirectly through other assertion functions that conditionally assert failure.</p> |
|---|
| 2166 | + <pre> |
|---|
| 2167 | assertBool :: String -> Bool -> Assertion |
|---|
| 2168 | assertBool msg b = unless b (assertFailure msg) |
|---|
| 2169 | |
|---|
| 2170 | hunk ./doc/Guide.html 141 |
|---|
| 2171 | where msg = (if null preface then "" else preface ++ "\n") ++ |
|---|
| 2172 | "expected: " ++ show expected ++ "\n but got: " ++ show actual |
|---|
| 2173 | </pre> |
|---|
| 2174 | -With <tt>assertBool</tt> you give the assertion condition and failure |
|---|
| 2175 | -message separately. With <tt>assertString</tt> the two are |
|---|
| 2176 | -combined. With <tt>assertEqual</tt> you provide a "preface", an |
|---|
| 2177 | -expected value, and an actual value; the failure message shows the two |
|---|
| 2178 | -unequal values and is prefixed by the preface. Additional ways |
|---|
| 2179 | -to create assertions are described later under <a |
|---|
| 2180 | -href="#AdvancedFeatures">Advanced Features</a>. |
|---|
| 2181 | -<p> |
|---|
| 2182 | -Since assertions are <tt>IO</tt> computations, they may be |
|---|
| 2183 | -combined--along with other <tt>IO</tt> computations--using |
|---|
| 2184 | -<tt>(>>=)</tt>, <tt>(>>)</tt>, and the <tt>do</tt> notation. As |
|---|
| 2185 | -long as its result is of type <tt>(IO ())</tt>, such a combination |
|---|
| 2186 | -constitutes a single, collective assertion, incorporating any number |
|---|
| 2187 | -of constituent assertions. The important features of such a |
|---|
| 2188 | -collective assertion are that it fails if any of its constituent |
|---|
| 2189 | -assertions is executed and fails, and that the first constituent |
|---|
| 2190 | -assertion to fail terminates execution of the collective |
|---|
| 2191 | -assertion. Such behavior is essential to specifying a test case. |
|---|
| 2192 | + <p>With <tt>assertBool</tt> you give the assertion condition and failure message separately. |
|---|
| 2193 | + With <tt>assertString</tt> the two are combined. With <tt>assertEqual</tt> you provide a |
|---|
| 2194 | + "preface", an expected value, and an actual value; the failure message shows the two |
|---|
| 2195 | + unequal values and is prefixed by the preface. Additional ways to create assertions are |
|---|
| 2196 | + described later under <a href="#AdvancedFeatures">Advanced Features</a>.</p> |
|---|
| 2197 | + |
|---|
| 2198 | + <p>Since assertions are <tt>IO</tt> computations, they may be combined--along with other |
|---|
| 2199 | + <tt>IO</tt> computations--using <tt>(>>=)</tt>, <tt>(>>)</tt>, and the <tt>do</tt> |
|---|
| 2200 | + notation. As long as its result is of type <tt>(IO ())</tt>, such a combination |
|---|
| 2201 | + constitutes a single, collective assertion, incorporating any number of constituent |
|---|
| 2202 | + assertions. The important features of such a collective assertion are that it fails if |
|---|
| 2203 | + any of its constituent assertions is executed and fails, and that the first constituent |
|---|
| 2204 | + assertion to fail terminates execution of the collective assertion. Such behavior is |
|---|
| 2205 | + essential to specifying a test case.</p> |
|---|
| 2206 | + |
|---|
| 2207 | + <h3 id="TestCase">Test Case</h3> |
|---|
| 2208 | + |
|---|
| 2209 | + <p>A <b>test case</b> is the unit of test execution. That is, distinct test cases are |
|---|
| 2210 | + executed independently. The failure of one is independent of the failure of any other.</p> |
|---|
| 2211 | |
|---|
| 2212 | hunk ./doc/Guide.html 161 |
|---|
| 2213 | -<h3><a name="TestCase"></a>Test Case</h3> |
|---|
| 2214 | + <p>A test case consists of a single, possibly collective, assertion. The possibly multiple |
|---|
| 2215 | + constituent assertions in a test case's collective assertion are <b>not</b> independent. |
|---|
| 2216 | + Their interdependence may be crucial to specifying correct operation for a test. A test |
|---|
| 2217 | + case may involve a series of steps, each concluding in an assertion, where each step |
|---|
| 2218 | + must succeed in order for the test case to continue. As another example, a test may |
|---|
| 2219 | + require some "set up" to be performed that must be undone ("torn down" in JUnit |
|---|
| 2220 | + parlance) once the test is complete. In this case, you could use Haskell's |
|---|
| 2221 | + <tt>IO.bracket</tt> function to achieve the desired effect.</p> |
|---|
| 2222 | |
|---|
| 2223 | hunk ./doc/Guide.html 170 |
|---|
| 2224 | -A <b>test case</b> is the unit of test execution. That is, |
|---|
| 2225 | -distinct test cases are executed independently. The failure of |
|---|
| 2226 | -one is independent of the failure of any other. |
|---|
| 2227 | -<p> |
|---|
| 2228 | -A test case consists of a single, possibly collective, |
|---|
| 2229 | -assertion. The possibly multiple constituent assertions in a |
|---|
| 2230 | -test case's collective assertion are <b>not</b> independent. |
|---|
| 2231 | -Their interdependence may be crucial to specifying correct operation |
|---|
| 2232 | -for a test. A test case may involve a series of steps, each |
|---|
| 2233 | -concluding in an assertion, where each step must succeed in order for |
|---|
| 2234 | -the test case to continue. As another example, a test may |
|---|
| 2235 | -require some "set up" to be performed that must be undone ("torn down" |
|---|
| 2236 | -in JUnit parlance) once the test is complete. In this case, you |
|---|
| 2237 | -could use Haskell's <tt>IO.bracket</tt> function to achieve the |
|---|
| 2238 | -desired effect. |
|---|
| 2239 | -<p> |
|---|
| 2240 | -You can make a test case from an assertion by applying the |
|---|
| 2241 | -<tt>TestCase</tt> constructor. For example, |
|---|
| 2242 | -<tt>(TestCase (return ()))</tt> is a test case that never |
|---|
| 2243 | -fails, and |
|---|
| 2244 | -<tt>(TestCase (assertEqual "for x," 3 x))</tt> |
|---|
| 2245 | -is a test case that checks that the value of <tt>x</tt> is 3. |
|---|
| 2246 | -Additional ways to create test cases are described later under |
|---|
| 2247 | -<a href="#AdvancedFeatures">Advanced Features</a>. |
|---|
| 2248 | + <p>You can make a test case from an assertion by applying the <tt>TestCase</tt> constructor. |
|---|
| 2249 | + For example, <tt>(TestCase (return ()))</tt> is a test case that never |
|---|
| 2250 | + fails, and |
|---|
| 2251 | + <tt>(TestCase (assertEqual "for x," 3 x))</tt> |
|---|
| 2252 | + is a test case that checks that the value of <tt>x</tt> is 3. Additional ways |
|---|
| 2253 | + to create test cases are described later under <a href="#AdvancedFeatures">Advanced |
|---|
| 2254 | + Features</a>.</p> |
|---|
| 2255 | |
|---|
| 2256 | hunk ./doc/Guide.html 178 |
|---|
| 2257 | -<h3><a name="Tests"></a>Tests</h3> |
|---|
| 2258 | + <h3 id="Tests">Tests</h3> |
|---|
| 2259 | |
|---|
| 2260 | hunk ./doc/Guide.html 180 |
|---|
| 2261 | -As soon as you have more than one test, you'll want to name them to |
|---|
| 2262 | -tell them apart. As soon as you have more than several tests, |
|---|
| 2263 | -you'll want to group them to process them more easily. So, |
|---|
| 2264 | -naming and grouping are the two keys to managing collections of tests. |
|---|
| 2265 | -<p> |
|---|
| 2266 | -In tune with the "composite" design pattern [<a |
|---|
| 2267 | -href="#DesignPatterns">1</a>], a <b>test</b> is defined as a package |
|---|
| 2268 | -of test cases. Concretely, a test is either a single test case, |
|---|
| 2269 | -a group of tests, or either of the first two identified by a label. |
|---|
| 2270 | -<pre> |
|---|
| 2271 | + <p>As soon as you have more than one test, you'll want to name them to tell them apart. As |
|---|
| 2272 | + soon as you have more than several tests, you'll want to group them to process them more |
|---|
| 2273 | + easily. So, naming and grouping are the two keys to managing collections of tests.</p> |
|---|
| 2274 | + |
|---|
| 2275 | + <p>In tune with the "composite" design pattern [<a href="#DesignPatterns">1</a>], a |
|---|
| 2276 | + <b>test</b> is defined as a package of test cases. Concretely, a test is either a single |
|---|
| 2277 | + test case, a group of tests, or either of the first two identified by a label.</p> |
|---|
| 2278 | + <pre> |
|---|
| 2279 | data Test = TestCase Assertion |
|---|
| 2280 | | TestList [Test] |
|---|
| 2281 | | TestLabel String Test |
|---|
| 2282 | hunk ./doc/Guide.html 192 |
|---|
| 2283 | </pre> |
|---|
| 2284 | -There are three important features of this definition to note: |
|---|
| 2285 | -<ul> |
|---|
| 2286 | -<li> |
|---|
| 2287 | -A <tt>TestList</tt> consists of a list of tests rather than a list of |
|---|
| 2288 | -test cases. This means that the structure of a <tt>Test</tt> is |
|---|
| 2289 | -actually a tree. Using a hierarchy helps organize tests just as |
|---|
| 2290 | -it helps organize files in a file system. |
|---|
| 2291 | -</li> |
|---|
| 2292 | -<li> |
|---|
| 2293 | -A <tt>TestLabel</tt> is attached to a test rather than to a test |
|---|
| 2294 | -case. This means that all nodes in the test tree, not just test |
|---|
| 2295 | -case (leaf) nodes, can be labeled. Hierarchical naming helps |
|---|
| 2296 | -organize tests just as it helps organize files in a file system. |
|---|
| 2297 | -</li> |
|---|
| 2298 | -<li> |
|---|
| 2299 | -A <tt>TestLabel</tt> is separate from both <tt>TestCase</tt> and |
|---|
| 2300 | -<tt>TestList</tt>. This means that labeling is optional |
|---|
| 2301 | -everywhere in the tree. Why is this a good thing? Because of |
|---|
| 2302 | -the hierarchical structure of a test, each constituent test case is |
|---|
| 2303 | -uniquely identified by its path in the tree, ignoring all |
|---|
| 2304 | -labels. Sometimes a test case's path (or perhaps its subpath |
|---|
| 2305 | -below a certain node) is a perfectly adequate "name" for the test case |
|---|
| 2306 | -(perhaps relative to a certain node). In this case, creating a |
|---|
| 2307 | -label for the test case is both unnecessary and inconvenient. |
|---|
| 2308 | -</li> |
|---|
| 2309 | -</ul> |
|---|
| 2310 | -<p> |
|---|
| 2311 | -The number of test cases that a test comprises can be computed with |
|---|
| 2312 | -<tt>testCaseCount</tt>. |
|---|
| 2313 | -<pre> |
|---|
| 2314 | + <p>There are three important features of this definition to note:</p> |
|---|
| 2315 | + <ul> |
|---|
| 2316 | + <li>A <tt>TestList</tt> consists of a list of tests rather than a list of test cases. |
|---|
| 2317 | + This means that the structure of a <tt>Test</tt> is actually a tree. Using a |
|---|
| 2318 | + hierarchy helps organize tests just as it helps organize files in a file system.</li> |
|---|
| 2319 | + <li>A <tt>TestLabel</tt> is attached to a test rather than to a test case. This means |
|---|
| 2320 | + that all nodes in the test tree, not just test case (leaf) nodes, can be labeled. |
|---|
| 2321 | + Hierarchical naming helps organize tests just as it helps organize files in a file |
|---|
| 2322 | + system.</li> |
|---|
| 2323 | + <li>A <tt>TestLabel</tt> is separate from both <tt>TestCase</tt> and <tt>TestList</tt>. |
|---|
| 2324 | + This means that labeling is optional everywhere in the tree. Why is this a good |
|---|
| 2325 | + thing? Because of the hierarchical structure of a test, each constituent test case |
|---|
| 2326 | + is uniquely identified by its path in the tree, ignoring all labels. Sometimes a |
|---|
| 2327 | + test case's path (or perhaps its subpath below a certain node) is a perfectly |
|---|
| 2328 | + adequate "name" for the test case (perhaps relative to a certain node). In this |
|---|
| 2329 | + case, creating a label for the test case is both unnecessary and inconvenient.</li> |
|---|
| 2330 | + </ul> |
|---|
| 2331 | + <p>The number of test cases that a test comprises can be computed with |
|---|
| 2332 | + <tt>testCaseCount</tt>.</p> |
|---|
| 2333 | + <pre> |
|---|
| 2334 | testCaseCount :: Test -> Int |
|---|
| 2335 | </pre> |
|---|
| 2336 | hunk ./doc/Guide.html 214 |
|---|
| 2337 | -<p> |
|---|
| 2338 | -As mentioned above, a test is identified by its <b>path</b> in the |
|---|
| 2339 | -test hierarchy. |
|---|
| 2340 | -<pre> |
|---|
| 2341 | + <p>As mentioned above, a test is identified by its <b>path</b> in the test hierarchy.</p> |
|---|
| 2342 | + <pre> |
|---|
| 2343 | data Node = ListItem Int | Label String |
|---|
| 2344 | deriving (Eq, Show, Read) |
|---|
| 2345 | |
|---|
| 2346 | hunk ./doc/Guide.html 221 |
|---|
| 2347 | type Path = [Node] -- Node order is from test case to root. |
|---|
| 2348 | </pre> |
|---|
| 2349 | -Each occurrence of <tt>TestList</tt> gives rise to a <tt>ListItem</tt> |
|---|
| 2350 | -and each occurrence of <tt>TestLabel</tt> gives rise to a |
|---|
| 2351 | -<tt>Label</tt>. The <tt>ListItem</tt>s by themselves ensure |
|---|
| 2352 | -uniqueness among test case paths, while the <tt>Label</tt>s allow you |
|---|
| 2353 | -to add mnemonic names for individual test cases and collections of |
|---|
| 2354 | -them. |
|---|
| 2355 | -<p> |
|---|
| 2356 | -Note that the order of nodes in a path is reversed from what you might |
|---|
| 2357 | -expect: The first node in the list is the one deepest in the |
|---|
| 2358 | -tree. This order is a concession to efficiency: It allows common |
|---|
| 2359 | -path prefixes to be shared. |
|---|
| 2360 | -<p> |
|---|
| 2361 | -The paths of the test cases that a test comprises can be computed with |
|---|
| 2362 | -<tt>testCasePaths</tt>. The paths are listed in the order in |
|---|
| 2363 | -which the corresponding test cases would be executed. |
|---|
| 2364 | -<pre> |
|---|
| 2365 | + <p>Each occurrence of <tt>TestList</tt> gives rise to a <tt>ListItem</tt> and each |
|---|
| 2366 | + occurrence of <tt>TestLabel</tt> gives rise to a <tt>Label</tt>. The <tt>ListItem</tt>s |
|---|
| 2367 | + by themselves ensure uniqueness among test case paths, while the <tt>Label</tt>s allow |
|---|
| 2368 | + you to add mnemonic names for individual test cases and collections of them.</p> |
|---|
| 2369 | + |
|---|
| 2370 | + <p>Note that the order of nodes in a path is reversed from what you might expect: The first |
|---|
| 2371 | + node in the list is the one deepest in the tree. This order is a concession to |
|---|
| 2372 | + efficiency: It allows common path prefixes to be shared.</p> |
|---|
| 2373 | + |
|---|
| 2374 | + <p>The paths of the test cases that a test comprises can be computed with |
|---|
| 2375 | + <tt>testCasePaths</tt>. The paths are listed in the order in which the corresponding |
|---|
| 2376 | + test cases would be executed.</p> |
|---|
| 2377 | + <pre> |
|---|
| 2378 | testCasePaths :: Test -> [Path] |
|---|
| 2379 | </pre> |
|---|
| 2380 | hunk ./doc/Guide.html 236 |
|---|
| 2381 | -<p> |
|---|
| 2382 | -The three variants of <tt>Test</tt> can be constructed simply by |
|---|
| 2383 | -applying <tt>TestCase</tt>, <tt>TestList</tt>, and <tt>TestLabel</tt> |
|---|
| 2384 | -to appropriate arguments. Additional ways to create tests are |
|---|
| 2385 | -described later under <a href="#AdvancedFeatures">Advanced |
|---|
| 2386 | -Features</a>. |
|---|
| 2387 | -<p> |
|---|
| 2388 | -The design of the type <tt>Test</tt> provides great conciseness, |
|---|
| 2389 | -flexibility, and convenience in specifying tests. Moreover, the |
|---|
| 2390 | -nature of Haskell significantly augments these qualities: |
|---|
| 2391 | -<ul> |
|---|
| 2392 | -<li> |
|---|
| 2393 | -Combining assertions and other code to construct test cases is easy |
|---|
| 2394 | -with the <tt>IO</tt> monad. |
|---|
| 2395 | -</li> |
|---|
| 2396 | -<li> |
|---|
| 2397 | -Using overloaded functions and special operators (see below), |
|---|
| 2398 | -specification of assertions and tests is extremely compact. |
|---|
| 2399 | -</li> |
|---|
| 2400 | -<li> |
|---|
| 2401 | -Structuring a test tree by value, rather than by name as in JUnit, |
|---|
| 2402 | -provides for more convenient, flexible, and robust test suite |
|---|
| 2403 | -specification. In particular, a test suite can more easily be |
|---|
| 2404 | -computed "on the fly" than in other test frameworks. |
|---|
| 2405 | -</li> |
|---|
| 2406 | -<li> |
|---|
| 2407 | -Haskell's powerful abstraction facilities provide unmatched support |
|---|
| 2408 | -for test refactoring. |
|---|
| 2409 | -</li> |
|---|
| 2410 | -</ul> |
|---|
| 2411 | |
|---|
| 2412 | hunk ./doc/Guide.html 237 |
|---|
| 2413 | -<h3><a name="AdvancedFeatures"></a>Advanced Features</h3> |
|---|
| 2414 | + <p>The three variants of <tt>Test</tt> can be constructed simply by applying |
|---|
| 2415 | + <tt>TestCase</tt>, <tt>TestList</tt>, and <tt>TestLabel</tt> to appropriate arguments. |
|---|
| 2416 | + Additional ways to create tests are described later under <a href="#AdvancedFeatures" |
|---|
| 2417 | + >Advanced Features</a>.</p> |
|---|
| 2418 | + |
|---|
| 2419 | + <p>The design of the type <tt>Test</tt> provides great conciseness, flexibility, and |
|---|
| 2420 | + convenience in specifying tests. Moreover, the nature of Haskell significantly augments |
|---|
| 2421 | + these qualities:</p> |
|---|
| 2422 | + <ul> |
|---|
| 2423 | + <li>Combining assertions and other code to construct test cases is easy with the |
|---|
| 2424 | + <tt>IO</tt> monad.</li> |
|---|
| 2425 | + <li>Using overloaded functions and special operators (see below), specification of |
|---|
| 2426 | + assertions and tests is extremely compact.</li> |
|---|
| 2427 | + <li>Structuring a test tree by value, rather than by name as in JUnit, provides for more |
|---|
| 2428 | + convenient, flexible, and robust test suite specification. In particular, a test |
|---|
| 2429 | + suite can more easily be computed "on the fly" than in other test frameworks.</li> |
|---|
| 2430 | + <li>Haskell's powerful abstraction facilities provide unmatched support for test |
|---|
| 2431 | + refactoring.</li> |
|---|
| 2432 | + </ul> |
|---|
| 2433 | + |
|---|
| 2434 | + <h3 id="AdvancedFeatures">Advanced Features</h3> |
|---|
| 2435 | + |
|---|
| 2436 | + <p>HUnit provides additional features for specifying assertions and tests more conveniently |
|---|
| 2437 | + and concisely. These facilities make use of Haskell type classes.</p> |
|---|
| 2438 | |
|---|
| 2439 | hunk ./doc/Guide.html 262 |
|---|
| 2440 | -HUnit provides additional features for specifying assertions and tests |
|---|
| 2441 | -more conveniently and concisely. These facilities make use of |
|---|
| 2442 | -Haskell type classes. |
|---|
| 2443 | -<p> |
|---|
| 2444 | -The following operators can be used to construct assertions. |
|---|
| 2445 | -<pre> |
|---|
| 2446 | + <p>The following operators can be used to construct assertions.</p> |
|---|
| 2447 | + <pre> |
|---|
| 2448 | infix 1 @?, @=?, @?= |
|---|
| 2449 | |
|---|
| 2450 | (@?) :: (AssertionPredicable t) => t -> String -> Assertion |
|---|
| 2451 | hunk ./doc/Guide.html 275 |
|---|
| 2452 | (@?=) :: (Eq a, Show a) => a -> a -> Assertion |
|---|
| 2453 | actual @?= expected = assertEqual "" expected actual |
|---|
| 2454 | </pre> |
|---|
| 2455 | -You provide a boolean condition and failure message separately to |
|---|
| 2456 | -<tt>(@?)</tt>, as for <tt>assertBool</tt>, but in a different |
|---|
| 2457 | -order. The <tt>(@=?)</tt> and <tt>(@?=)</tt> operators provide |
|---|
| 2458 | -shorthands for <tt>assertEqual</tt> when no preface is required. |
|---|
| 2459 | -They differ only in the order in which the expected and actual values |
|---|
| 2460 | -are provided. (The actual value--the uncertain one--goes on the |
|---|
| 2461 | -"?" side of the operator.) |
|---|
| 2462 | -<p> |
|---|
| 2463 | -The <tt>(@?)</tt> operator's first argument is something from which an |
|---|
| 2464 | -assertion predicate can be made, that is, its type must be |
|---|
| 2465 | -<tt>AssertionPredicable</tt>. |
|---|
| 2466 | -<pre> |
|---|
| 2467 | + <p>You provide a boolean condition and failure message separately to <tt>(@?)</tt>, as for |
|---|
| 2468 | + <tt>assertBool</tt>, but in a different order. The <tt>(@=?)</tt> and <tt>(@?=)</tt> |
|---|
| 2469 | + operators provide shorthands for <tt>assertEqual</tt> when no preface is required. They |
|---|
| 2470 | + differ only in the order in which the expected and actual values are provided. (The |
|---|
| 2471 | + actual value--the uncertain one--goes on the "?" side of the operator.)</p> |
|---|
| 2472 | + |
|---|
| 2473 | + <p>The <tt>(@?)</tt> operator's first argument is something from which an assertion |
|---|
| 2474 | + predicate can be made, that is, its type must be <tt>AssertionPredicable</tt>.</p> |
|---|
| 2475 | + <pre> |
|---|
| 2476 | type AssertionPredicate = IO Bool |
|---|
| 2477 | |
|---|
| 2478 | class AssertionPredicable t |
|---|
| 2479 | hunk ./doc/Guide.html 295 |
|---|
| 2480 | instance (AssertionPredicable t) => AssertionPredicable (IO t) |
|---|
| 2481 | where assertionPredicate = (>>= assertionPredicate) |
|---|
| 2482 | </pre> |
|---|
| 2483 | -The overloaded <tt>assert</tt> function in the <tt>Assertable</tt> |
|---|
| 2484 | -type class constructs an assertion. |
|---|
| 2485 | -<pre> |
|---|
| 2486 | + <p>The overloaded <tt>assert</tt> function in the <tt>Assertable</tt> type class constructs |
|---|
| 2487 | + an assertion.</p> |
|---|
| 2488 | + <pre> |
|---|
| 2489 | class Assertable t |
|---|
| 2490 | where assert :: t -> Assertion |
|---|
| 2491 | |
|---|
| 2492 | hunk ./doc/Guide.html 313 |
|---|
| 2493 | instance (Assertable t) => Assertable (IO t) |
|---|
| 2494 | where assert = (>>= assert) |
|---|
| 2495 | </pre> |
|---|
| 2496 | -The <tt>ListAssertable</tt> class allows <tt>assert</tt> to be applied |
|---|
| 2497 | -to <tt>[Char]</tt> (that is, <tt>String</tt>). |
|---|
| 2498 | -<pre> |
|---|
| 2499 | + <p>The <tt>ListAssertable</tt> class allows <tt>assert</tt> to be applied to <tt>[Char]</tt> |
|---|
| 2500 | + (that is, <tt>String</tt>).</p> |
|---|
| 2501 | + <pre> |
|---|
| 2502 | class ListAssertable t |
|---|
| 2503 | where listAssert :: [t] -> Assertion |
|---|
| 2504 | |
|---|
| 2505 | hunk ./doc/Guide.html 322 |
|---|
| 2506 | instance ListAssertable Char |
|---|
| 2507 | where listAssert = assertString |
|---|
| 2508 | </pre> |
|---|
| 2509 | -With the above declarations, <tt>(assert ())</tt>, |
|---|
| 2510 | -<tt>(assert True)</tt>, and <tt>(assert "")</tt> (as well as |
|---|
| 2511 | -<tt>IO</tt> forms of these values, such as <tt>(return ())</tt>) |
|---|
| 2512 | -are all assertions that never fail, while <tt>(assert False)</tt> |
|---|
| 2513 | -and <tt>(assert "some failure message")</tt> (and their |
|---|
| 2514 | -<tt>IO</tt> forms) are assertions that always fail. You may |
|---|
| 2515 | -define additional instances for the type classes <tt>Assertable</tt>, |
|---|
| 2516 | -<tt>ListAssertable</tt>, and <tt>AssertionPredicable</tt> if that |
|---|
| 2517 | -should be useful in your application. |
|---|
| 2518 | -<p> |
|---|
| 2519 | -The overloaded <tt>test</tt> function in the <tt>Testable</tt> type |
|---|
| 2520 | -class constructs a test. |
|---|
| 2521 | -<pre> |
|---|
| 2522 | + <p>With the above declarations, <tt>(assert ())</tt>, |
|---|
| 2523 | + <tt>(assert True)</tt>, and <tt>(assert "")</tt> (as well as |
|---|
| 2524 | + <tt>IO</tt> forms of these values, such as <tt>(return ())</tt>) are all |
|---|
| 2525 | + assertions that never fail, while <tt>(assert False)</tt> and |
|---|
| 2526 | + <tt>(assert "some failure message")</tt> (and their |
|---|
| 2527 | + <tt>IO</tt> forms) are assertions that always fail. You may define additional |
|---|
| 2528 | + instances for the type classes <tt>Assertable</tt>, <tt>ListAssertable</tt>, and |
|---|
| 2529 | + <tt>AssertionPredicable</tt> if that should be useful in your application.</p> |
|---|
| 2530 | + |
|---|
| 2531 | + <p>The overloaded <tt>test</tt> function in the <tt>Testable</tt> type class constructs a |
|---|
| 2532 | + test.</p> |
|---|
| 2533 | + <pre> |
|---|
| 2534 | class Testable t |
|---|
| 2535 | where test :: t -> Test |
|---|
| 2536 | |
|---|
| 2537 | hunk ./doc/Guide.html 346 |
|---|
| 2538 | instance (Testable t) => Testable [t] |
|---|
| 2539 | where test = TestList . map test |
|---|
| 2540 | </pre> |
|---|
| 2541 | -The <tt>test</tt> function makes a test from either an |
|---|
| 2542 | -<tt>Assertion</tt> (using <tt>TestCase</tt>), a list of |
|---|
| 2543 | -<tt>Testable</tt> items (using <tt>TestList</tt>), or a <tt>Test</tt> |
|---|
| 2544 | -(making no change). |
|---|
| 2545 | -<p> |
|---|
| 2546 | -The following operators can be used to construct tests. |
|---|
| 2547 | -<pre> |
|---|
| 2548 | + <p>The <tt>test</tt> function makes a test from either an <tt>Assertion</tt> (using |
|---|
| 2549 | + <tt>TestCase</tt>), a list of <tt>Testable</tt> items (using <tt>TestList</tt>), or |
|---|
| 2550 | + a <tt>Test</tt> (making no change).</p> |
|---|
| 2551 | + |
|---|
| 2552 | + <p>The following operators can be used to construct tests.</p> |
|---|
| 2553 | + <pre> |
|---|
| 2554 | infix 1 ~?, ~=?, ~?= |
|---|
| 2555 | infixr 0 ~: |
|---|
| 2556 | |
|---|
| 2557 | hunk ./doc/Guide.html 367 |
|---|
| 2558 | (~:) :: (Testable t) => String -> t -> Test |
|---|
| 2559 | label ~: t = TestLabel label (test t) |
|---|
| 2560 | </pre> |
|---|
| 2561 | -<tt>(~?)</tt>, <tt>(~=?)</tt>, and <tt>(~?=)</tt> each make an |
|---|
| 2562 | -assertion, as for <tt>(@?)</tt>, <tt>(@=?)</tt>, and <tt>(@?=)</tt>, |
|---|
| 2563 | -respectively, and then a test case from that assertion. |
|---|
| 2564 | -<tt>(~:)</tt> attaches a label to something that is |
|---|
| 2565 | -<tt>Testable</tt>. You may define additional instances for the |
|---|
| 2566 | -type class <tt>Testable</tt> should that be useful. |
|---|
| 2567 | + <p><tt>(~?)</tt>, <tt>(~=?)</tt>, and <tt>(~?=)</tt> each make an assertion, as for |
|---|
| 2568 | + <tt>(@?)</tt>, <tt>(@=?)</tt>, and <tt>(@?=)</tt>, respectively, and then a test case |
|---|
| 2569 | + from that assertion. <tt>(~:)</tt> attaches a label to something that is |
|---|
| 2570 | + <tt>Testable</tt>. You may define additional instances for the type class |
|---|
| 2571 | + <tt>Testable</tt> should that be useful.</p> |
|---|
| 2572 | + |
|---|
| 2573 | + <h2 id="RunningTests">Running Tests</h2> |
|---|
| 2574 | |
|---|
| 2575 | hunk ./doc/Guide.html 375 |
|---|
| 2576 | -<h2><a name="RunningTests"></a>Running Tests</h2> |
|---|
| 2577 | + <p>HUnit is structured to support multiple test controllers. The first subsection below |
|---|
| 2578 | + describes the <a href="#TestExecution">test execution</a> characteristics common to all |
|---|
| 2579 | + test controllers. The second subsection describes the <a href="#Text-BasedController" |
|---|
| 2580 | + >text-based controller</a> that is included with HUnit.</p> |
|---|
| 2581 | |
|---|
| 2582 | hunk ./doc/Guide.html 380 |
|---|
| 2583 | -HUnit is structured to support multiple test controllers. The |
|---|
| 2584 | -first subsection below describes the <a href="#TestExecution">test |
|---|
| 2585 | -execution</a> characteristics common to all test controllers. |
|---|
| 2586 | -The second subsection describes the |
|---|
| 2587 | -<a href="#Text-BasedController">text-based controller</a> that is |
|---|
| 2588 | -included with HUnit. |
|---|
| 2589 | + <h3 id="TestExecution">Test Execution</h3> |
|---|
| 2590 | |
|---|
| 2591 | hunk ./doc/Guide.html 382 |
|---|
| 2592 | -<h3><a name="TestExecution">Test Execution</a></h3> |
|---|
| 2593 | + <p>All test controllers share a common test execution model. They differ only in how the |
|---|
| 2594 | + results of test execution are shown.</p> |
|---|
| 2595 | |
|---|
| 2596 | hunk ./doc/Guide.html 385 |
|---|
| 2597 | -All test controllers share a common test execution model. They |
|---|
| 2598 | -differ only in how the results of test execution are shown. |
|---|
| 2599 | -<p> |
|---|
| 2600 | -The execution of a test (a value of type <tt>Test</tt>) involves the |
|---|
| 2601 | -serial execution (in the <tt>IO</tt> monad) of its constituent test |
|---|
| 2602 | -cases. The test cases are executed in a depth-first, |
|---|
| 2603 | -left-to-right order. During test execution, four counts of test |
|---|
| 2604 | -cases are maintained: |
|---|
| 2605 | -<pre> |
|---|
| 2606 | + <p>The execution of a test (a value of type <tt>Test</tt>) involves the serial execution (in |
|---|
| 2607 | + the <tt>IO</tt> monad) of its constituent test cases. The test cases are executed in a |
|---|
| 2608 | + depth-first, left-to-right order. During test execution, four counts of test cases are |
|---|
| 2609 | + maintained:</p> |
|---|
| 2610 | + <pre> |
|---|
| 2611 | data Counts = Counts { cases, tried, errors, failures :: Int } |
|---|
| 2612 | deriving (Eq, Show, Read) |
|---|
| 2613 | </pre> |
|---|
| 2614 | hunk ./doc/Guide.html 393 |
|---|
| 2615 | -<ul> |
|---|
| 2616 | -<li> |
|---|
| 2617 | -<tt>cases</tt> is the number of test cases included in the test. |
|---|
| 2618 | -This number is a static property of a test and remains unchanged |
|---|
| 2619 | -during test execution. |
|---|
| 2620 | -</li> |
|---|
| 2621 | -<li> |
|---|
| 2622 | -<tt>tried</tt> is the number of test cases that have been executed so |
|---|
| 2623 | -far during the test execution. |
|---|
| 2624 | -</li> |
|---|
| 2625 | -<li> |
|---|
| 2626 | -<tt>errors</tt> is the number of test cases whose execution ended with |
|---|
| 2627 | -an unexpected exception being raised. Errors indicate problems |
|---|
| 2628 | -with test cases, as opposed to the code under test. |
|---|
| 2629 | -</li> |
|---|
| 2630 | -<li> |
|---|
| 2631 | -<tt>failures</tt> is the number of test cases whose execution asserted |
|---|
| 2632 | -failure. Failures indicate problems with the code under test. |
|---|
| 2633 | -</li> |
|---|
| 2634 | -</ul> |
|---|
| 2635 | -Why is there no count for test case successes? The technical reason |
|---|
| 2636 | -is that the counts are maintained such that the number of test case |
|---|
| 2637 | -successes is always equal to |
|---|
| 2638 | -<tt>(tried - (errors + failures))</tt>. The |
|---|
| 2639 | -psychosocial reason is that, with test-centered development and the |
|---|
| 2640 | -expectation that test failures will be few and short-lived, attention |
|---|
| 2641 | -should be focused on the failures rather than the successes. |
|---|
| 2642 | -<p> |
|---|
| 2643 | -As test execution proceeds, three kinds of reporting event are |
|---|
| 2644 | -communicated to the test controller. (What the controller does |
|---|
| 2645 | -in response to the reporting events depends on the controller.) |
|---|
| 2646 | -<ul> |
|---|
| 2647 | -<li> |
|---|
| 2648 | -<i>start</i> -- |
|---|
| 2649 | -Just prior to initiation of a test case, the path of the test case and |
|---|
| 2650 | -the current counts (excluding the current test case) are reported. |
|---|
| 2651 | -</li> |
|---|
| 2652 | -<li> |
|---|
| 2653 | -<i>error</i> -- |
|---|
| 2654 | -When a test case terminates with an error, the error message is |
|---|
| 2655 | -reported, along with the test case path and current counts (including |
|---|
| 2656 | -the current test case). |
|---|
| 2657 | -</li> |
|---|
| 2658 | -<li> |
|---|
| 2659 | -<i>failure</i> -- |
|---|
| 2660 | -When a test case terminates with a failure, the failure message is |
|---|
| 2661 | -reported, along with the test case path and current counts (including |
|---|
| 2662 | -the current test case). |
|---|
| 2663 | -</li> |
|---|
| 2664 | -</ul> |
|---|
| 2665 | -Typically, a test controller shows <i>error</i> and <i>failure</i> |
|---|
| 2666 | -reports immediately but uses the <i>start</i> report merely to update |
|---|
| 2667 | -an indication of overall test execution progress. |
|---|
| 2668 | + <ul> |
|---|
| 2669 | + <li><tt>cases</tt> is the number of test cases included in the test. This number is a |
|---|
| 2670 | + static property of a test and remains unchanged during test execution.</li> |
|---|
| 2671 | + <li><tt>tried</tt> is the number of test cases that have been executed so far during the |
|---|
| 2672 | + test execution.</li> |
|---|
| 2673 | + <li><tt>errors</tt> is the number of test cases whose execution ended with an unexpected |
|---|
| 2674 | + exception being raised. Errors indicate problems with test cases, as opposed to the |
|---|
| 2675 | + code under test.</li> |
|---|
| 2676 | + <li><tt>failures</tt> is the number of test cases whose execution asserted failure. |
|---|
| 2677 | + Failures indicate problems with the code under test.</li> |
|---|
| 2678 | + </ul> |
|---|
| 2679 | + <p>Why is there no count for test case successes? The technical reason is that the counts |
|---|
| 2680 | + are maintained such that the number of test case successes is always equal to |
|---|
| 2681 | + <tt>(tried - (errors + failures))</tt>. The |
|---|
| 2682 | + psychosocial reason is that, with test-centered development and the expectation that |
|---|
| 2683 | + test failures will be few and short-lived, attention should be focused on the failures |
|---|
| 2684 | + rather than the successes.</p> |
|---|
| 2685 | |
|---|
| 2686 | hunk ./doc/Guide.html 411 |
|---|
| 2687 | -<h3><a name="Text-BasedController">Text-Based Controller</a></h3> |
|---|
| 2688 | + <p>As test execution proceeds, three kinds of reporting event are communicated to the test |
|---|
| 2689 | + controller. (What the controller does in response to the reporting events depends on the |
|---|
| 2690 | + controller.)</p> |
|---|
| 2691 | + <ul> |
|---|
| 2692 | + <li><i>start</i> -- Just prior to initiation of a test case, the path of the test case |
|---|
| 2693 | + and the current counts (excluding the current test case) are reported.</li> |
|---|
| 2694 | + <li><i>error</i> -- When a test case terminates with an error, the error message is |
|---|
| 2695 | + reported, along with the test case path and current counts (including the current |
|---|
| 2696 | + test case).</li> |
|---|
| 2697 | + <li><i>failure</i> -- When a test case terminates with a failure, the failure message is |
|---|
| 2698 | + reported, along with the test case path and current counts (including the current |
|---|
| 2699 | + test case).</li> |
|---|
| 2700 | + </ul> |
|---|
| 2701 | + <p>Typically, a test controller shows <i>error</i> and <i>failure</i> reports immediately |
|---|
| 2702 | + but uses the <i>start</i> report merely to update an indication of overall test |
|---|
| 2703 | + execution progress.</p> |
|---|
| 2704 | |
|---|
| 2705 | hunk ./doc/Guide.html 428 |
|---|
| 2706 | -A text-based test controller is included with HUnit. |
|---|
| 2707 | -<pre> |
|---|
| 2708 | + <h3 id="Text-BasedController">Text-Based Controller</h3> |
|---|
| 2709 | + |
|---|
| 2710 | + <p>A text-based test controller is included with HUnit.</p> |
|---|
| 2711 | + <pre> |
|---|
| 2712 | runTestText :: PutText st -> Test -> IO (Counts, st) |
|---|
| 2713 | </pre> |
|---|
| 2714 | hunk ./doc/Guide.html 434 |
|---|
| 2715 | -<tt>runTestText</tt> is generalized on a <i>reporting scheme</i> given |
|---|
| 2716 | -as its first argument. During execution of the test given as its |
|---|
| 2717 | -second argument, the controller creates a string for each reporting |
|---|
| 2718 | -event and processes it according to the reporting scheme. When |
|---|
| 2719 | -test execution is complete, the controller returns the final counts |
|---|
| 2720 | -along with the final state for the reporting scheme. |
|---|
| 2721 | -<p> |
|---|
| 2722 | -The strings for the three kinds of reporting event are as follows. |
|---|
| 2723 | -<ul> |
|---|
| 2724 | -<li> |
|---|
| 2725 | -A <i>start</i> report is the result of the function |
|---|
| 2726 | -<tt>showCounts</tt> applied to the counts current immediately prior to |
|---|
| 2727 | -initiation of the test case being started. |
|---|
| 2728 | -</li> |
|---|
| 2729 | -<li> |
|---|
| 2730 | -An <i>error</i> report is of the form |
|---|
| 2731 | -"<tt>Error in: <i>path</i>\n<i>message</i></tt>", |
|---|
| 2732 | -where <i>path</i> is the path of the test case in error, as shown by |
|---|
| 2733 | -<tt>showPath</tt>, and <i>message</i> is a message describing the |
|---|
| 2734 | -error. If the path is empty, the report has the form |
|---|
| 2735 | -"<tt>Error:\n<i>message</i></tt>". |
|---|
| 2736 | -</li> |
|---|
| 2737 | -<li> |
|---|
| 2738 | -A <i>failure</i> report is of the form |
|---|
| 2739 | -"<tt>Failure in: <i>path</i>\n<i>message</i></tt>", where |
|---|
| 2740 | -<i>path</i> is the path of the test case in error, as shown by |
|---|
| 2741 | -<tt>showPath</tt>, and <i>message</i> is the failure message. If |
|---|
| 2742 | -the path is empty, the report has the form |
|---|
| 2743 | -"<tt>Failure:\n<i>message</i></tt>". |
|---|
| 2744 | -</li> |
|---|
| 2745 | -</ul> |
|---|
| 2746 | -<p> |
|---|
| 2747 | -The function <tt>showCounts</tt> shows a set of counts. |
|---|
| 2748 | -<pre> |
|---|
| 2749 | + <p><tt>runTestText</tt> is generalized on a <i>reporting scheme</i> given as its first |
|---|
| 2750 | + argument. During execution of the test given as its second argument, the controller |
|---|
| 2751 | + creates a string for each reporting event and processes it according to the reporting |
|---|
| 2752 | + scheme. When test execution is complete, the controller returns the final counts along |
|---|
| 2753 | + with the final state for the reporting scheme.</p> |
|---|
| 2754 | + |
|---|
| 2755 | + <p>The strings for the three kinds of reporting event are as follows.</p> |
|---|
| 2756 | + <ul> |
|---|
| 2757 | + <li>A <i>start</i> report is the result of the function <tt>showCounts</tt> applied to |
|---|
| 2758 | + the counts current immediately prior to initiation of the test case being started.</li> |
|---|
| 2759 | + <li>An <i>error</i> report is of the form |
|---|
| 2760 | + "<tt>Error in: <i>path</i>\n<i>message</i></tt>", |
|---|
| 2761 | + where <i>path</i> is the path of the test case in error, as shown by |
|---|
| 2762 | + <tt>showPath</tt>, and <i>message</i> is a message describing the error. If the path |
|---|
| 2763 | + is empty, the report has the form "<tt>Error:\n<i>message</i></tt>".</li> |
|---|
| 2764 | + <li>A <i>failure</i> report is of the form |
|---|
| 2765 | + "<tt>Failure in: <i>path</i>\n<i>message</i></tt>", where |
|---|
| 2766 | + <i>path</i> is the path of the test case in error, as shown by |
|---|
| 2767 | + <tt>showPath</tt>, and <i>message</i> is the failure message. If the path is empty, |
|---|
| 2768 | + the report has the form "<tt>Failure:\n<i>message</i></tt>".</li> |
|---|
| 2769 | + </ul> |
|---|
| 2770 | + |
|---|
| 2771 | + <p>The function <tt>showCounts</tt> shows a set of counts.</p> |
|---|
| 2772 | + <pre> |
|---|
| 2773 | showCounts :: Counts -> String |
|---|
| 2774 | </pre> |
|---|
| 2775 | hunk ./doc/Guide.html 460 |
|---|
| 2776 | -The form of its result is |
|---|
| 2777 | -"<tt>Cases: <i>cases</i> Tried: <i>tried</i> Errors: <i>errors</i> Failures: <i>failures</i></tt>" |
|---|
| 2778 | -where <i>cases</i>, <i>tried</i>, <i>errors</i>, and <i>failures</i> |
|---|
| 2779 | -are the count values. |
|---|
| 2780 | -<p> |
|---|
| 2781 | -The function <tt>showPath</tt> shows a test case path. |
|---|
| 2782 | -<pre> |
|---|
| 2783 | + <p>The form of its result is |
|---|
| 2784 | + "<tt>Cases: <i>cases</i> Tried: <i>tried</i> Errors: <i>errors</i> Failures: <i>failures</i></tt>" |
|---|
| 2785 | + where <i>cases</i>, <i>tried</i>, <i>errors</i>, and <i>failures</i> are the count |
|---|
| 2786 | + values.</p> |
|---|
| 2787 | + |
|---|
| 2788 | + <p>The function <tt>showPath</tt> shows a test case path.</p> |
|---|
| 2789 | + <pre> |
|---|
| 2790 | showPath :: Path -> String |
|---|
| 2791 | </pre> |
|---|
| 2792 | hunk ./doc/Guide.html 469 |
|---|
| 2793 | -The nodes in the path are reversed (so that the path reads from the |
|---|
| 2794 | -root down to the test case), and the representations for the nodes are |
|---|
| 2795 | -joined by '<tt>:</tt>' separators. The representation for |
|---|
| 2796 | -<tt>(ListItem <i>n</i>)</tt> is <tt>(show n)</tt>. The |
|---|
| 2797 | -representation for <tt>(Label <i>label</i>)</tt> is normally |
|---|
| 2798 | -<i>label</i>. However, if <i>label</i> contains a colon or if |
|---|
| 2799 | -<tt>(show <i>label</i>)</tt> is different from <i>label</i> surrounded |
|---|
| 2800 | -by quotation marks--that is, if any ambiguity could exist--then |
|---|
| 2801 | -<tt>(Label <i>label</i>)</tt> is represented as <tt>(show |
|---|
| 2802 | -<i>label</i>)</tt>. |
|---|
| 2803 | -<p> |
|---|
| 2804 | -HUnit includes two reporting schemes for the text-based test |
|---|
| 2805 | -controller. You may define others if you wish. |
|---|
| 2806 | -<pre> |
|---|
| 2807 | + <p>The nodes in the path are reversed (so that the path reads from the root down to the test |
|---|
| 2808 | + case), and the representations for the nodes are joined by '<tt>:</tt>' separators. The |
|---|
| 2809 | + representation for <tt>(ListItem <i>n</i>)</tt> is <tt>(show n)</tt>. The representation |
|---|
| 2810 | + for <tt>(Label <i>label</i>)</tt> is normally <i>label</i>. However, if <i>label</i> |
|---|
| 2811 | + contains a colon or if <tt>(show <i>label</i>)</tt> is different from <i>label</i> |
|---|
| 2812 | + surrounded by quotation marks--that is, if any ambiguity could exist--then <tt>(Label |
|---|
| 2813 | + <i>label</i>)</tt> is represented as <tt>(show <i>label</i>)</tt>.</p> |
|---|
| 2814 | + |
|---|
| 2815 | + <p>HUnit includes two reporting schemes for the text-based test controller. You may define |
|---|
| 2816 | + others if you wish.</p> |
|---|
| 2817 | + <pre> |
|---|
| 2818 | putTextToHandle :: Handle -> Bool -> PutText Int |
|---|
| 2819 | </pre> |
|---|
| 2820 | hunk ./doc/Guide.html 482 |
|---|
| 2821 | -<tt>putTextToHandle</tt> writes error and failure reports, plus a |
|---|
| 2822 | -report of the final counts, to the given handle. Each of these |
|---|
| 2823 | -reports is terminated by a newline. In addition, if the given |
|---|
| 2824 | -flag is <tt>True</tt>, it writes start reports to the handle as |
|---|
| 2825 | -well. A start report, however, is not terminated by a |
|---|
| 2826 | -newline. Before the next report is written, the start report is |
|---|
| 2827 | -"erased" with an appropriate sequence of carriage return and space |
|---|
| 2828 | -characters. Such overwriting realizes its intended effect on |
|---|
| 2829 | -terminal devices. |
|---|
| 2830 | -<pre> |
|---|
| 2831 | + <p><tt>putTextToHandle</tt> writes error and failure reports, plus a report of the final |
|---|
| 2832 | + counts, to the given handle. Each of these reports is terminated by a newline. In |
|---|
| 2833 | + addition, if the given flag is <tt>True</tt>, it writes start reports to the handle as |
|---|
| 2834 | + well. A start report, however, is not terminated by a newline. Before the next report is |
|---|
| 2835 | + written, the start report is "erased" with an appropriate sequence of carriage return |
|---|
| 2836 | + and space characters. Such overwriting realizes its intended effect on terminal devices.</p> |
|---|
| 2837 | + <pre> |
|---|
| 2838 | putTextToShowS :: PutText ShowS |
|---|
| 2839 | </pre> |
|---|
| 2840 | hunk ./doc/Guide.html 491 |
|---|
| 2841 | -<tt>putTextToShowS</tt> ignores start reports and simply accumulates |
|---|
| 2842 | -error and failure reports, terminating them with newlines. The |
|---|
| 2843 | -accumulated reports are returned (as the second element of the pair |
|---|
| 2844 | -returned by <tt>runTestText</tt>) as a <tt>ShowS</tt> function (that |
|---|
| 2845 | -is, one with type <tt>(String -> String)</tt>) whose first |
|---|
| 2846 | -argument is a string to be appended to the accumulated report lines. |
|---|
| 2847 | -<p> |
|---|
| 2848 | -HUnit provides a shorthand for the most common use of the text-based |
|---|
| 2849 | -test controller. |
|---|
| 2850 | -<pre> |
|---|
| 2851 | + <p><tt>putTextToShowS</tt> ignores start reports and simply accumulates error and failure |
|---|
| 2852 | + reports, terminating them with newlines. The accumulated reports are returned (as the |
|---|
| 2853 | + second element of the pair returned by <tt>runTestText</tt>) as a <tt>ShowS</tt> |
|---|
| 2854 | + function (that is, one with type <tt>(String -> String)</tt>) whose |
|---|
| 2855 | + first argument is a string to be appended to the accumulated report lines.</p> |
|---|
| 2856 | + |
|---|
| 2857 | + <p>HUnit provides a shorthand for the most common use of the text-based test controller.</p> |
|---|
| 2858 | + <pre> |
|---|
| 2859 | runTestTT :: Test -> IO Counts |
|---|
| 2860 | </pre> |
|---|
| 2861 | hunk ./doc/Guide.html 501 |
|---|
| 2862 | -<tt>runTestTT</tt> invokes <tt>runTestText</tt>, specifying |
|---|
| 2863 | -<tt>(putTextToHandle stderr True)</tt> for the reporting scheme, and |
|---|
| 2864 | -returns the final counts from the test execution. |
|---|
| 2865 | - |
|---|
| 2866 | -<h2><a name="ConstituentFiles">Constituent Files</a></h2> |
|---|
| 2867 | - |
|---|
| 2868 | -HUnit 1.0 consists of the following files. |
|---|
| 2869 | -<dl> |
|---|
| 2870 | - |
|---|
| 2871 | -<dt> doc/Guide.html |
|---|
| 2872 | -<dd> |
|---|
| 2873 | -This document. |
|---|
| 2874 | -<dt> examples/Example.hs |
|---|
| 2875 | -<dd> |
|---|
| 2876 | -Haskell module that includes the examples given in the <a |
|---|
| 2877 | -href="#GettingStarted">Getting Started</a> section. Run this |
|---|
| 2878 | -program to make sure you understand how to use HUnit. |
|---|
| 2879 | -<dt> Test/HUnit.lhs |
|---|
| 2880 | -<dd> |
|---|
| 2881 | -Haskell module that you import to use HUnit. |
|---|
| 2882 | -<dt> Test/HUnit/Base.lhs |
|---|
| 2883 | -<dd> |
|---|
| 2884 | -Haskell module that defines HUnit's basic facilities. |
|---|
| 2885 | -<dt> Test/HUnit/Lang.lhs |
|---|
| 2886 | -<dd> |
|---|
| 2887 | -Haskell module that defines how assertion failure is signaled and |
|---|
| 2888 | -caught. By default, it is a copy of |
|---|
| 2889 | -<tt>Test/HUnit/Lang98.lhs</tt>. Replace it by a copy of |
|---|
| 2890 | -<tt>Test/HUnit/LangExtended.lhs</tt> for more robust exception behavior. |
|---|
| 2891 | -<dt> Test/HUnit/Lang98.lhs |
|---|
| 2892 | -<dd> |
|---|
| 2893 | -Haskell module that defines generic assertion failure handling. |
|---|
| 2894 | -It is compliant to Haskell 98 but catches only <tt>IO</tt> errors. |
|---|
| 2895 | -<dt> Test/HUnit/LangExtended.lhs |
|---|
| 2896 | -<dd> |
|---|
| 2897 | -Haskell module that defines more robust assertion failure |
|---|
| 2898 | -handling. It catches more (though unfortunately not all) kinds |
|---|
| 2899 | -of exceptions. However, it works only with Hugs (Dec. 2001 or |
|---|
| 2900 | -later) and GHC (5.00 and later). |
|---|
| 2901 | -<dt> examples/test/HUnitTest98.lhs |
|---|
| 2902 | -<dd> |
|---|
| 2903 | -Haskell module that tests HUnit, assuming the generic assertion |
|---|
| 2904 | -failure handling of <tt>HUnitLang98.lhs</tt>. |
|---|
| 2905 | -<dt> examples/test/HUnitTestBase.lhs |
|---|
| 2906 | -<dd> |
|---|
| 2907 | -Haskell module that defines testing support and basic (Haskell 98 |
|---|
| 2908 | -compliant) tests of HUnit (using HUnit, of course!). Contains |
|---|
| 2909 | -more extensive and advanced examples of testing with HUnit. |
|---|
| 2910 | -<dt> examples/test/HUnitTestExtended.lhs |
|---|
| 2911 | -<dd> |
|---|
| 2912 | -Haskell module that tests HUnit, assuming the extended assertion |
|---|
| 2913 | -failure handling of <tt>HUnitLangExc.lhs</tt>. |
|---|
| 2914 | -<dt> Test/HUnit/Text.lhs |
|---|
| 2915 | -<dd> |
|---|
| 2916 | -Haskell module that defines HUnit's text-based test controller. |
|---|
| 2917 | -<dt> LICENSE |
|---|
| 2918 | -<dd> |
|---|
| 2919 | -The license for use of HUnit. |
|---|
| 2920 | -<dt> Test/HUnit/Terminal.lhs |
|---|
| 2921 | -<dd> |
|---|
| 2922 | -Haskell module that assists in checking the output of HUnit tests |
|---|
| 2923 | -performed by the text-based test controller. |
|---|
| 2924 | -<dt> examples/test/TerminalTest.lhs |
|---|
| 2925 | -<dd> |
|---|
| 2926 | -Haskell module that tests <tt>Test/HUnit/Terminal.lhs</tt> (using HUnit, of |
|---|
| 2927 | -course!). |
|---|
| 2928 | -</dl> |
|---|
| 2929 | + <p><tt>runTestTT</tt> invokes <tt>runTestText</tt>, specifying <tt>(putTextToHandle stderr |
|---|
| 2930 | + True)</tt> for the reporting scheme, and returns the final counts from the test |
|---|
| 2931 | + execution.</p> |
|---|
| 2932 | |
|---|
| 2933 | hunk ./doc/Guide.html 505 |
|---|
| 2934 | -<h2><a name="References">References</a></h2> |
|---|
| 2935 | |
|---|
| 2936 | hunk ./doc/Guide.html 506 |
|---|
| 2937 | -<dl> |
|---|
| 2938 | + <h2 id="References">References</h2> |
|---|
| 2939 | |
|---|
| 2940 | hunk ./doc/Guide.html 508 |
|---|
| 2941 | -<dt> |
|---|
| 2942 | -<a name="DesignPatterns"></a>[1] Gamma, E., et al. Design Patterns: |
|---|
| 2943 | -Elements of Reusable Object-Oriented Software, Addison-Wesley, |
|---|
| 2944 | -Reading, MA, 1995. |
|---|
| 2945 | -<dd> |
|---|
| 2946 | -The classic book describing design patterns in an object-oriented |
|---|
| 2947 | -context. |
|---|
| 2948 | + <dl> |
|---|
| 2949 | |
|---|
| 2950 | hunk ./doc/Guide.html 510 |
|---|
| 2951 | -<dt> |
|---|
| 2952 | -<a href="http://www.junit.org">http://www.junit.org</a> |
|---|
| 2953 | -<dd> |
|---|
| 2954 | -Web page for JUnit, the tool after which HUnit is modeled. |
|---|
| 2955 | + <dt id="DesignPatterns">[1] Gamma, E., et al. Design Patterns: Elements of Reusable |
|---|
| 2956 | + Object-Oriented Software, Addison-Wesley, Reading, MA, 1995.</dt> |
|---|
| 2957 | + <dd>The classic book describing design patterns in an object-oriented context.</dd> |
|---|
| 2958 | |
|---|
| 2959 | hunk ./doc/Guide.html 514 |
|---|
| 2960 | -<dt> |
|---|
| 2961 | -<a href="http://junit.sourceforge.net/doc/testinfected/testing.htm"> |
|---|
| 2962 | -http://junit.sourceforge.net/doc/testinfected/testing.htm</a> |
|---|
| 2963 | -<dd> |
|---|
| 2964 | -A good introduction to test-first development and the use of JUnit. |
|---|
| 2965 | + <dt> |
|---|
| 2966 | + <a href="http://www.junit.org">http://www.junit.org</a> |
|---|
| 2967 | + </dt> |
|---|
| 2968 | + <dd>Web page for JUnit, the tool after which HUnit is modeled.</dd> |
|---|
| 2969 | |
|---|
| 2970 | hunk ./doc/Guide.html 519 |
|---|
| 2971 | -<dt> |
|---|
| 2972 | -<a href="http://junit.sourceforge.net/doc/cookstour/cookstour.htm"> |
|---|
| 2973 | -http://junit.sourceforge.net/doc/cookstour/cookstour.htm</a> |
|---|
| 2974 | -<dd> |
|---|
| 2975 | -A description of the internal structure of JUnit. Makes for an |
|---|
| 2976 | -interesting comparison between JUnit and HUnit. |
|---|
| 2977 | + <dt> |
|---|
| 2978 | + <a href="http://junit.sourceforge.net/doc/testinfected/testing.htm"> |
|---|
| 2979 | + http://junit.sourceforge.net/doc/testinfected/testing.htm</a> |
|---|
| 2980 | + </dt> |
|---|
| 2981 | + <dd>A good introduction to test-first development and the use of JUnit.</dd> |
|---|
| 2982 | |
|---|
| 2983 | hunk ./doc/Guide.html 525 |
|---|
| 2984 | -</dl> |
|---|
| 2985 | + <dt> |
|---|
| 2986 | + <a href="http://junit.sourceforge.net/doc/cookstour/cookstour.htm"> |
|---|
| 2987 | + http://junit.sourceforge.net/doc/cookstour/cookstour.htm</a> |
|---|
| 2988 | + </dt> |
|---|
| 2989 | + <dd>A description of the internal structure of JUnit. Makes for an interesting |
|---|
| 2990 | + comparison between JUnit and HUnit.</dd> |
|---|
| 2991 | |
|---|
| 2992 | hunk ./doc/Guide.html 532 |
|---|
| 2993 | -<p> |
|---|
| 2994 | -<hr> |
|---|
| 2995 | + </dl> |
|---|
| 2996 | |
|---|
| 2997 | hunk ./doc/Guide.html 534 |
|---|
| 2998 | -The HUnit software and this guide were written by Dean Herington |
|---|
| 2999 | -(<a href="mailto:heringto@cs.unc.edu">heringto@cs.unc.edu</a>). |
|---|
| 3000 | + <hr/> |
|---|
| 3001 | |
|---|
| 3002 | hunk ./doc/Guide.html 536 |
|---|
| 3003 | -<p> |
|---|
| 3004 | -HUnit development is supported by |
|---|
| 3005 | -<a href="http://sourceforge.net"> |
|---|
| 3006 | -<img src="http://sourceforge.net/sflogo.php?group_id=46796&type=1" |
|---|
| 3007 | - width="88" height="31" border="0" alt="SourceForge.net Logo"> |
|---|
| 3008 | -</a> |
|---|
| 3009 | -</body> |
|---|
| 3010 | + <p>The HUnit software and this guide were written by Dean Herington (<a |
|---|
| 3011 | + href="mailto:heringto@cs.unc.edu">heringto@cs.unc.edu</a>).</p> |
|---|
| 3012 | + </body> |
|---|
| 3013 | </html> |
|---|
| 3014 | hunk ./examples/Example.hs 2 |
|---|
| 3015 | -- Example.hs -- Examples from HUnit user's guide |
|---|
| 3016 | +-- |
|---|
| 3017 | +-- For more examples, check out the tests directory. It contains unit tests |
|---|
| 3018 | +-- for HUnit. |
|---|
| 3019 | |
|---|
| 3020 | module Main where |
|---|
| 3021 | |
|---|
| 3022 | addfile ./tests/HUnitTest98.lhs |
|---|
| 3023 | hunk ./tests/HUnitTest98.lhs 1 |
|---|
| 3024 | +HUnitTest98.lhs -- test for HUnit, using Haskell language system "98" |
|---|
| 3025 | + |
|---|
| 3026 | +> module Main (main) where |
|---|
| 3027 | + |
|---|
| 3028 | +> import Test.HUnit |
|---|
| 3029 | +> import HUnitTestBase |
|---|
| 3030 | + |
|---|
| 3031 | +> main :: IO Counts |
|---|
| 3032 | +> main = runTestTT (test [baseTests]) |
|---|
| 3033 | addfile ./tests/HUnitTestBase.lhs |
|---|
| 3034 | hunk ./tests/HUnitTestBase.lhs 1 |
|---|
| 3035 | +HUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant) |
|---|
| 3036 | + |
|---|
| 3037 | +> module HUnitTestBase where |
|---|
| 3038 | + |
|---|
| 3039 | +> import Test.HUnit |
|---|
| 3040 | +> import Test.HUnit.Terminal (terminalAppearance) |
|---|
| 3041 | +> import System.IO (IOMode(..), openFile, hClose) |
|---|
| 3042 | + |
|---|
| 3043 | + |
|---|
| 3044 | +> data Report = Start State |
|---|
| 3045 | +> | Error String State |
|---|
| 3046 | +> | UnspecifiedError State |
|---|
| 3047 | +> | Failure String State |
|---|
| 3048 | +> deriving (Show, Read) |
|---|
| 3049 | + |
|---|
| 3050 | +> instance Eq Report where |
|---|
| 3051 | +> Start s1 == Start s2 = s1 == s2 |
|---|
| 3052 | +> Error m1 s1 == Error m2 s2 = m1 == m2 && s1 == s2 |
|---|
| 3053 | +> Error m1 s1 == UnspecifiedError s2 = s1 == s2 |
|---|
| 3054 | +> UnspecifiedError s1 == Error m2 s2 = s1 == s2 |
|---|
| 3055 | +> UnspecifiedError s1 == UnspecifiedError s2 = s1 == s2 |
|---|
| 3056 | +> Failure m1 s1 == Failure m2 s2 = m1 == m2 && s1 == s2 |
|---|
| 3057 | +> _ == _ = False |
|---|
| 3058 | + |
|---|
| 3059 | + |
|---|
| 3060 | +> expectReports :: [Report] -> Counts -> Test -> Test |
|---|
| 3061 | +> expectReports reports counts test = TestCase $ do |
|---|
| 3062 | +> (counts', reports') <- performTest (\ ss us -> return (Start ss : us)) |
|---|
| 3063 | +> (\m ss us -> return (Error m ss : us)) |
|---|
| 3064 | +> (\m ss us -> return (Failure m ss : us)) |
|---|
| 3065 | +> [] test |
|---|
| 3066 | +> assertEqual "for the reports from a test," reports (reverse reports') |
|---|
| 3067 | +> assertEqual "for the counts from a test," counts counts' |
|---|
| 3068 | + |
|---|
| 3069 | + |
|---|
| 3070 | +> simpleStart = Start (State [] (Counts 1 0 0 0)) |
|---|
| 3071 | + |
|---|
| 3072 | +> expectSuccess :: Test -> Test |
|---|
| 3073 | +> expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0) |
|---|
| 3074 | + |
|---|
| 3075 | +> expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test |
|---|
| 3076 | +> expectProblem kind err msg = |
|---|
| 3077 | +> expectReports [simpleStart, kind msg (State [] counts)] counts |
|---|
| 3078 | +> where counts = Counts 1 1 err (1-err) |
|---|
| 3079 | + |
|---|
| 3080 | +> expectError, expectFailure :: String -> Test -> Test |
|---|
| 3081 | +> expectError = expectProblem Error 1 |
|---|
| 3082 | +> expectFailure = expectProblem Failure 0 |
|---|
| 3083 | + |
|---|
| 3084 | +> expectUnspecifiedError :: Test -> Test |
|---|
| 3085 | +> expectUnspecifiedError = expectProblem (\ msg st -> UnspecifiedError st) 1 undefined |
|---|
| 3086 | + |
|---|
| 3087 | + |
|---|
| 3088 | +> data Expect = Succ | Err String | UErr | Fail String |
|---|
| 3089 | + |
|---|
| 3090 | +> expect :: Expect -> Test -> Test |
|---|
| 3091 | +> expect Succ test = expectSuccess test |
|---|
| 3092 | +> expect (Err m) test = expectError m test |
|---|
| 3093 | +> expect UErr test = expectUnspecifiedError test |
|---|
| 3094 | +> expect (Fail m) test = expectFailure m test |
|---|
| 3095 | + |
|---|
| 3096 | + |
|---|
| 3097 | + |
|---|
| 3098 | +> baseTests = test [ assertTests, |
|---|
| 3099 | +> testCaseCountTests, |
|---|
| 3100 | +> testCasePathsTests, |
|---|
| 3101 | +> reportTests, |
|---|
| 3102 | +> textTests, |
|---|
| 3103 | +> showPathTests, |
|---|
| 3104 | +> showCountsTests, |
|---|
| 3105 | +> assertableTests, |
|---|
| 3106 | +> predicableTests, |
|---|
| 3107 | +> compareTests, |
|---|
| 3108 | +> extendedTestTests ] |
|---|
| 3109 | + |
|---|
| 3110 | + |
|---|
| 3111 | +> ok = test (assert ()) |
|---|
| 3112 | +> bad m = test (assertFailure m) |
|---|
| 3113 | + |
|---|
| 3114 | + |
|---|
| 3115 | +> assertTests = test [ |
|---|
| 3116 | + |
|---|
| 3117 | +> "null" ~: expectSuccess ok, |
|---|
| 3118 | + |
|---|
| 3119 | +> "userError" ~: |
|---|
| 3120 | +#if defined(__GLASGOW_HASKELL__) |
|---|
| 3121 | +> expectError "user error (error)" (TestCase (ioError (userError "error"))), |
|---|
| 3122 | +#else |
|---|
| 3123 | +> expectError "error" (TestCase (ioError (userError "error"))), |
|---|
| 3124 | +#endif |
|---|
| 3125 | + |
|---|
| 3126 | +> "IO error (file missing)" ~: |
|---|
| 3127 | +> expectUnspecifiedError |
|---|
| 3128 | +> (test (do openFile "3g9djs" ReadMode; return ())), |
|---|
| 3129 | + |
|---|
| 3130 | + "error" ~: |
|---|
| 3131 | + expectError "error" (TestCase (error "error")), |
|---|
| 3132 | + |
|---|
| 3133 | + "tail []" ~: |
|---|
| 3134 | + expectUnspecifiedError (TestCase (tail [] `seq` return ())), |
|---|
| 3135 | + |
|---|
| 3136 | + -- GHC doesn't currently catch arithmetic exceptions. |
|---|
| 3137 | + "div by 0" ~: |
|---|
| 3138 | + expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), |
|---|
| 3139 | + |
|---|
| 3140 | +> "assertFailure" ~: |
|---|
| 3141 | +> let msg = "simple assertFailure" |
|---|
| 3142 | +> in expectFailure msg (test (assertFailure msg)), |
|---|
| 3143 | + |
|---|
| 3144 | +> "assertString null" ~: expectSuccess (TestCase (assertString "")), |
|---|
| 3145 | + |
|---|
| 3146 | +> "assertString nonnull" ~: |
|---|
| 3147 | +> let msg = "assertString nonnull" |
|---|
| 3148 | +> in expectFailure msg (TestCase (assertString msg)), |
|---|
| 3149 | + |
|---|
| 3150 | +> let exp v non = |
|---|
| 3151 | +> show v ++ " with " ++ non ++ "null message" ~: |
|---|
| 3152 | +> expect (if v then Succ else Fail non) $ test $ assertBool non v |
|---|
| 3153 | +> in "assertBool" ~: [ exp v non | v <- [True, False], non <- ["non", ""] ], |
|---|
| 3154 | + |
|---|
| 3155 | +> let msg = "assertBool True" |
|---|
| 3156 | +> in msg ~: expectSuccess (test (assertBool msg True)), |
|---|
| 3157 | + |
|---|
| 3158 | +> let msg = "assertBool False" |
|---|
| 3159 | +> in msg ~: expectFailure msg (test (assertBool msg False)), |
|---|
| 3160 | + |
|---|
| 3161 | +> "assertEqual equal" ~: |
|---|
| 3162 | +> expectSuccess (test (assertEqual "" 3 3)), |
|---|
| 3163 | + |
|---|
| 3164 | +> "assertEqual unequal no msg" ~: |
|---|
| 3165 | +> expectFailure "expected: 3\n but got: 4" |
|---|
| 3166 | +> (test (assertEqual "" 3 4)), |
|---|
| 3167 | + |
|---|
| 3168 | +> "assertEqual unequal with msg" ~: |
|---|
| 3169 | +> expectFailure "for x,\nexpected: 3\n but got: 4" |
|---|
| 3170 | +> (test (assertEqual "for x," 3 4)) |
|---|
| 3171 | + |
|---|
| 3172 | +> ] |
|---|
| 3173 | + |
|---|
| 3174 | + |
|---|
| 3175 | +> emptyTest0 = TestList [] |
|---|
| 3176 | +> emptyTest1 = TestLabel "empty" emptyTest0 |
|---|
| 3177 | +> emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ] |
|---|
| 3178 | +> emptyTests = [emptyTest0, emptyTest1, emptyTest2] |
|---|
| 3179 | + |
|---|
| 3180 | +> testCountEmpty test = TestCase (assertEqual "" 0 (testCaseCount test)) |
|---|
| 3181 | + |
|---|
| 3182 | +> suite0 = (0, ok) |
|---|
| 3183 | +> suite1 = (1, TestList []) |
|---|
| 3184 | +> suite2 = (2, TestLabel "3" ok) |
|---|
| 3185 | +> suite3 = (3, suite) |
|---|
| 3186 | + |
|---|
| 3187 | +> suite = |
|---|
| 3188 | +> TestLabel "0" |
|---|
| 3189 | +> (TestList [ TestLabel "1" (bad "1"), |
|---|
| 3190 | +> TestLabel "2" (TestList [ TestLabel "2.1" ok, |
|---|
| 3191 | +> ok, |
|---|
| 3192 | +> TestLabel "2.3" (bad "2") ]), |
|---|
| 3193 | +> TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))), |
|---|
| 3194 | +> TestList [ TestList [ TestLabel "6" (bad "4") ] ] ]) |
|---|
| 3195 | + |
|---|
| 3196 | +> suiteCount = (6 :: Int) |
|---|
| 3197 | + |
|---|
| 3198 | +> suitePaths = [ |
|---|
| 3199 | +> [Label "0", ListItem 0, Label "1"], |
|---|
| 3200 | +> [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"], |
|---|
| 3201 | +> [Label "0", ListItem 1, Label "2", ListItem 1], |
|---|
| 3202 | +> [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"], |
|---|
| 3203 | +> [Label "0", ListItem 2, Label "3", Label "4", Label "5"], |
|---|
| 3204 | +> [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]] |
|---|
| 3205 | + |
|---|
| 3206 | +> suiteReports = [ Start (State (p 0) (Counts 6 0 0 0)), |
|---|
| 3207 | +> Failure "1" (State (p 0) (Counts 6 1 0 1)), |
|---|
| 3208 | +> Start (State (p 1) (Counts 6 1 0 1)), |
|---|
| 3209 | +> Start (State (p 2) (Counts 6 2 0 1)), |
|---|
| 3210 | +> Start (State (p 3) (Counts 6 3 0 1)), |
|---|
| 3211 | +> Failure "2" (State (p 3) (Counts 6 4 0 2)), |
|---|
| 3212 | +> Start (State (p 4) (Counts 6 4 0 2)), |
|---|
| 3213 | +> Failure "3" (State (p 4) (Counts 6 5 0 3)), |
|---|
| 3214 | +> Start (State (p 5) (Counts 6 5 0 3)), |
|---|
| 3215 | +> Failure "4" (State (p 5) (Counts 6 6 0 4))] |
|---|
| 3216 | +> where p n = reverse (suitePaths !! n) |
|---|
| 3217 | + |
|---|
| 3218 | +> suiteCounts = Counts 6 6 0 4 |
|---|
| 3219 | + |
|---|
| 3220 | +> suiteOutput = concat [ |
|---|
| 3221 | +> "### Failure in: 0:0:1\n", |
|---|
| 3222 | +> "1\n", |
|---|
| 3223 | +> "### Failure in: 0:1:2:2:2.3\n", |
|---|
| 3224 | +> "2\n", |
|---|
| 3225 | +> "### Failure in: 0:2:3:4:5\n", |
|---|
| 3226 | +> "3\n", |
|---|
| 3227 | +> "### Failure in: 0:3:0:0:6\n", |
|---|
| 3228 | +> "4\n", |
|---|
| 3229 | +> "Cases: 6 Tried: 6 Errors: 0 Failures: 4\n"] |
|---|
| 3230 | + |
|---|
| 3231 | + |
|---|
| 3232 | +> suites = [suite0, suite1, suite2, suite3] |
|---|
| 3233 | + |
|---|
| 3234 | + |
|---|
| 3235 | +> testCount (num, test) count = |
|---|
| 3236 | +> "testCaseCount suite" ++ show num ~: |
|---|
| 3237 | +> TestCase $ assertEqual "for test count," count (testCaseCount test) |
|---|
| 3238 | + |
|---|
| 3239 | +> testCaseCountTests = TestList [ |
|---|
| 3240 | + |
|---|
| 3241 | +> "testCaseCount empty" ~: test (map testCountEmpty emptyTests), |
|---|
| 3242 | + |
|---|
| 3243 | +> testCount suite0 1, |
|---|
| 3244 | +> testCount suite1 0, |
|---|
| 3245 | +> testCount suite2 1, |
|---|
| 3246 | +> testCount suite3 suiteCount |
|---|
| 3247 | + |
|---|
| 3248 | +> ] |
|---|
| 3249 | + |
|---|
| 3250 | + |
|---|
| 3251 | +> testPaths (num, test) paths = |
|---|
| 3252 | +> "testCasePaths suite" ++ show num ~: |
|---|
| 3253 | +> TestCase $ assertEqual "for test paths," |
|---|
| 3254 | +> (map reverse paths) (testCasePaths test) |
|---|
| 3255 | + |
|---|
| 3256 | +> testPathsEmpty test = TestCase $ assertEqual "" [] (testCasePaths test) |
|---|
| 3257 | + |
|---|
| 3258 | +> testCasePathsTests = TestList [ |
|---|
| 3259 | + |
|---|
| 3260 | +> "testCasePaths empty" ~: test (map testPathsEmpty emptyTests), |
|---|
| 3261 | + |
|---|
| 3262 | +> testPaths suite0 [[]], |
|---|
| 3263 | +> testPaths suite1 [], |
|---|
| 3264 | +> testPaths suite2 [[Label "3"]], |
|---|
| 3265 | +> testPaths suite3 suitePaths |
|---|
| 3266 | + |
|---|
| 3267 | +> ] |
|---|
| 3268 | + |
|---|
| 3269 | + |
|---|
| 3270 | +> reportTests = "reports" ~: expectReports suiteReports suiteCounts suite |
|---|
| 3271 | + |
|---|
| 3272 | + |
|---|
| 3273 | +> expectText counts text test = TestCase $ do |
|---|
| 3274 | +> (counts', text') <- runTestText putTextToShowS test |
|---|
| 3275 | +> assertEqual "for the final counts," counts counts' |
|---|
| 3276 | +> assertEqual "for the failure text output," text (text' "") |
|---|
| 3277 | + |
|---|
| 3278 | + |
|---|
| 3279 | +> textTests = test [ |
|---|
| 3280 | + |
|---|
| 3281 | +> "lone error" ~: |
|---|
| 3282 | +> expectText (Counts 1 1 1 0) |
|---|
| 3283 | +#if defined(__GLASGOW_HASKELL__) |
|---|
| 3284 | +> "### Error:\nuser error (xyz)\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" |
|---|
| 3285 | +#else |
|---|
| 3286 | +> "### Error:\nxyz\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" |
|---|
| 3287 | +#endif |
|---|
| 3288 | +> (test (do ioError (userError "xyz"); return ())), |
|---|
| 3289 | + |
|---|
| 3290 | +> "lone failure" ~: |
|---|
| 3291 | +> expectText (Counts 1 1 0 1) |
|---|
| 3292 | +> "### Failure:\nxyz\nCases: 1 Tried: 1 Errors: 0 Failures: 1\n" |
|---|
| 3293 | +> (test (assert "xyz")), |
|---|
| 3294 | + |
|---|
| 3295 | +> "putTextToShowS" ~: |
|---|
| 3296 | +> expectText suiteCounts suiteOutput suite, |
|---|
| 3297 | + |
|---|
| 3298 | +> "putTextToHandle (file)" ~: |
|---|
| 3299 | +> let filename = "HUnitTest.tmp" |
|---|
| 3300 | +> trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines |
|---|
| 3301 | +> in map test |
|---|
| 3302 | +> [ "show progress = " ++ show flag ~: do |
|---|
| 3303 | +> handle <- openFile filename WriteMode |
|---|
| 3304 | +> (counts, _) <- runTestText (putTextToHandle handle flag) suite |
|---|
| 3305 | +> hClose handle |
|---|
| 3306 | +> assertEqual "for the final counts," suiteCounts counts |
|---|
| 3307 | +> text <- readFile filename |
|---|
| 3308 | +> let text' = if flag then trim (terminalAppearance text) else text |
|---|
| 3309 | +> assertEqual "for the failure text output," suiteOutput text' |
|---|
| 3310 | +> | flag <- [False, True] ] |
|---|
| 3311 | + |
|---|
| 3312 | +> ] |
|---|
| 3313 | + |
|---|
| 3314 | + |
|---|
| 3315 | +> showPathTests = "showPath" ~: [ |
|---|
| 3316 | + |
|---|
| 3317 | +> "empty" ~: showPath [] ~?= "", |
|---|
| 3318 | +> ":" ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"", |
|---|
| 3319 | +> "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"", |
|---|
| 3320 | +> "misc" ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?= |
|---|
| 3321 | +> "foo:3:2:b" |
|---|
| 3322 | + |
|---|
| 3323 | +> ] |
|---|
| 3324 | + |
|---|
| 3325 | + |
|---|
| 3326 | +> showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?= |
|---|
| 3327 | +> "Cases: 4 Tried: 3 Errors: 2 Failures: 1" |
|---|
| 3328 | + |
|---|
| 3329 | + |
|---|
| 3330 | + |
|---|
| 3331 | +> lift :: a -> IO a |
|---|
| 3332 | +> lift a = return a |
|---|
| 3333 | + |
|---|
| 3334 | + |
|---|
| 3335 | +> assertableTests = |
|---|
| 3336 | +> let assertables x = [ |
|---|
| 3337 | +> ( "", assert x , test (lift x)) , |
|---|
| 3338 | +> ( "IO ", assert (lift x) , test (lift (lift x))) , |
|---|
| 3339 | +> ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))] |
|---|
| 3340 | +> assertabled l e x = |
|---|
| 3341 | +> test [ test [ "assert" ~: pre ++ l ~: expect e $ test $ a, |
|---|
| 3342 | +> "test" ~: pre ++ "IO " ++ l ~: expect e $ t ] |
|---|
| 3343 | +> | (pre, a, t) <- assertables x ] |
|---|
| 3344 | +> in "assertable" ~: [ |
|---|
| 3345 | +> assertabled "()" Succ (), |
|---|
| 3346 | +> assertabled "True" Succ True, |
|---|
| 3347 | +> assertabled "False" (Fail "") False, |
|---|
| 3348 | +> assertabled "\"\"" Succ "", |
|---|
| 3349 | +> assertabled "\"x\"" (Fail "x") "x" |
|---|
| 3350 | +> ] |
|---|
| 3351 | + |
|---|
| 3352 | + |
|---|
| 3353 | +> predicableTests = |
|---|
| 3354 | +> let predicables x m = [ |
|---|
| 3355 | +> ( "", assertionPredicate x , x @? m, x ~? m ), |
|---|
| 3356 | +> ( "IO ", assertionPredicate (l x) , l x @? m, l x ~? m ), |
|---|
| 3357 | +> ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )] |
|---|
| 3358 | +> l x = lift x |
|---|
| 3359 | +> predicabled l e m x = |
|---|
| 3360 | +> test [ test [ "pred" ~: pre ++ l ~: m ~: expect e $ test $ tst p, |
|---|
| 3361 | +> "(@?)" ~: pre ++ l ~: m ~: expect e $ test $ a, |
|---|
| 3362 | +> "(~?)" ~: pre ++ l ~: m ~: expect e $ t ] |
|---|
| 3363 | +> | (pre, p, a, t) <- predicables x m ] |
|---|
| 3364 | +> where tst p = p >>= assertBool m |
|---|
| 3365 | +> in "predicable" ~: [ |
|---|
| 3366 | +> predicabled "True" Succ "error" True, |
|---|
| 3367 | +> predicabled "False" (Fail "error") "error" False, |
|---|
| 3368 | +> predicabled "True" Succ "" True, |
|---|
| 3369 | +> predicabled "False" (Fail "" ) "" False |
|---|
| 3370 | +> ] |
|---|
| 3371 | + |
|---|
| 3372 | + |
|---|
| 3373 | +> compareTests = test [ |
|---|
| 3374 | + |
|---|
| 3375 | +> let succ = const Succ |
|---|
| 3376 | +> compare f exp act = test [ "(@=?)" ~: expect e $ test (exp @=? act), |
|---|
| 3377 | +> "(@?=)" ~: expect e $ test (act @?= exp), |
|---|
| 3378 | +> "(~=?)" ~: expect e $ exp ~=? act, |
|---|
| 3379 | +> "(~?=)" ~: expect e $ act ~?= exp ] |
|---|
| 3380 | +> where e = f $ "expected: " ++ show exp ++ "\n but got: " ++ show act |
|---|
| 3381 | +> in test [ |
|---|
| 3382 | +> compare succ 1 1, |
|---|
| 3383 | +> compare Fail 1 2, |
|---|
| 3384 | +> compare succ (1,'b',3.0) (1,'b',3.0), |
|---|
| 3385 | +> compare Fail (1,'b',3.0) (1,'b',3.1) |
|---|
| 3386 | +> ] |
|---|
| 3387 | + |
|---|
| 3388 | +> ] |
|---|
| 3389 | + |
|---|
| 3390 | + |
|---|
| 3391 | +> expectList1 :: Int -> Test -> Test |
|---|
| 3392 | +> expectList1 c = |
|---|
| 3393 | +> expectReports |
|---|
| 3394 | +> [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ] |
|---|
| 3395 | +> (Counts c c 0 0) |
|---|
| 3396 | + |
|---|
| 3397 | +> expectList2 :: [Int] -> Test -> Test |
|---|
| 3398 | +> expectList2 cs test = |
|---|
| 3399 | +> expectReports |
|---|
| 3400 | +> [ Start (State [ListItem j, ListItem i] (Counts c n 0 0)) |
|---|
| 3401 | +> | ((i,j),n) <- zip coords [0..] ] |
|---|
| 3402 | +> (Counts c c 0 0) |
|---|
| 3403 | +> test |
|---|
| 3404 | +> where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ] |
|---|
| 3405 | +> c = testCaseCount test |
|---|
| 3406 | + |
|---|
| 3407 | + |
|---|
| 3408 | +> extendedTestTests = test [ |
|---|
| 3409 | + |
|---|
| 3410 | +> "test idempotent" ~: expect Succ $ test $ test $ test $ ok, |
|---|
| 3411 | + |
|---|
| 3412 | +> "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True], |
|---|
| 3413 | + |
|---|
| 3414 | +> "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]] |
|---|
| 3415 | + |
|---|
| 3416 | +> ] |
|---|
| 3417 | addfile ./tests/HUnitTestExtended.lhs |
|---|
| 3418 | hunk ./tests/HUnitTestExtended.lhs 1 |
|---|
| 3419 | +HUnitTestExc.lhs -- test for HUnit, using Haskell language system "Exc" |
|---|
| 3420 | + |
|---|
| 3421 | +> module Main (main) where |
|---|
| 3422 | + |
|---|
| 3423 | +> import Test.HUnit |
|---|
| 3424 | +> import HUnitTestBase |
|---|
| 3425 | + |
|---|
| 3426 | + import qualified Control.Exception (assert) |
|---|
| 3427 | + |
|---|
| 3428 | + assertionMessage = "HUnitTestExc.lhs:13: Assertion failed\n" |
|---|
| 3429 | + assertion = Control.Exception.assert False (return ()) |
|---|
| 3430 | + |
|---|
| 3431 | + |
|---|
| 3432 | +> main :: IO Counts |
|---|
| 3433 | +> main = runTestTT (test [baseTests, excTests]) |
|---|
| 3434 | + |
|---|
| 3435 | +> excTests :: Test |
|---|
| 3436 | +> excTests = test [ |
|---|
| 3437 | + |
|---|
| 3438 | + -- Hugs doesn't currently catch arithmetic exceptions. |
|---|
| 3439 | + |
|---|
| 3440 | +> "div by 0" ~: |
|---|
| 3441 | +> expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), |
|---|
| 3442 | + |
|---|
| 3443 | +> "list ref out of bounds" ~: |
|---|
| 3444 | +> expectUnspecifiedError (TestCase ([1 .. 4] !! 10 `seq` return ())), |
|---|
| 3445 | + |
|---|
| 3446 | +> "error" ~: |
|---|
| 3447 | +> expectError "error" (TestCase (error "error")), |
|---|
| 3448 | + |
|---|
| 3449 | +> "tail []" ~: |
|---|
| 3450 | +> expectUnspecifiedError (TestCase (tail [] `seq` return ())) |
|---|
| 3451 | + |
|---|
| 3452 | + -- Hugs doesn't provide `assert` and GHC's type system doesn't allow this |
|---|
| 3453 | + -- to compile. |
|---|
| 3454 | + "assert" ~: |
|---|
| 3455 | + expectError assertionMessage (TestCase assertion) |
|---|
| 3456 | + |
|---|
| 3457 | +> ] |
|---|
| 3458 | addfile ./tests/HUnitTests.cabal |
|---|
| 3459 | hunk ./tests/HUnitTests.cabal 1 |
|---|
| 3460 | - |
|---|
| 3461 | +Name: HUnitTests |
|---|
| 3462 | +Version: 1.2.2.0 |
|---|
| 3463 | +License: BSD3 |
|---|
| 3464 | +License-File: LICENSE |
|---|
| 3465 | +Author: Dean Herington |
|---|
| 3466 | +Homepage: http://hunit.sourceforge.net/ |
|---|
| 3467 | +Category: Testing |
|---|
| 3468 | +Synopsis: A set of unit tests for HUnit |
|---|
| 3469 | +-- Build-Type: Simple |
|---|
| 3470 | + |
|---|
| 3471 | +Executable: basic-tests |
|---|
| 3472 | +Main-Is: HUnitTest98.lhs |
|---|
| 3473 | +HS-Source-Dirs: . .. |
|---|
| 3474 | +-- Build-Depends: base |
|---|
| 3475 | +Extensions: CPP |
|---|
| 3476 | + |
|---|
| 3477 | +Executable: extended-tests |
|---|
| 3478 | +Main-Is: HUnitTestExtended.lhs |
|---|
| 3479 | +HS-Source-Dirs: . .. |
|---|
| 3480 | +-- Build-Depends: base |
|---|
| 3481 | +Extensions: CPP |
|---|
| 3482 | + |
|---|
| 3483 | +Executable: terminal-tests |
|---|
| 3484 | +Main-Is: TerminalTest.lhs |
|---|
| 3485 | +HS-Source-Dirs: . .. |
|---|
| 3486 | +-- Build-Depends: base |
|---|
| 3487 | +Extensions: CPP |
|---|
| 3488 | + |
|---|
| 3489 | addfile ./tests/Setup.hs |
|---|
| 3490 | hunk ./tests/Setup.hs 1 |
|---|
| 3491 | +#!/usr/bin/env runghc |
|---|
| 3492 | +module Main (main) where |
|---|
| 3493 | + |
|---|
| 3494 | +import Distribution.Simple |
|---|
| 3495 | + |
|---|
| 3496 | +main :: IO () |
|---|
| 3497 | +main = defaultMain |
|---|
| 3498 | addfile ./tests/TerminalTest.lhs |
|---|
| 3499 | hunk ./tests/TerminalTest.lhs 1 |
|---|
| 3500 | +TerminalTest.lhs |
|---|
| 3501 | + |
|---|
| 3502 | +> import Test.HUnit.Terminal |
|---|
| 3503 | +> import Test.HUnit |
|---|
| 3504 | + |
|---|
| 3505 | +> main :: IO Counts |
|---|
| 3506 | +> main = runTestTT tests |
|---|
| 3507 | + |
|---|
| 3508 | +> try :: String -> String -> String -> Test |
|---|
| 3509 | +> try lab inp exp' = lab ~: terminalAppearance inp ~?= exp' |
|---|
| 3510 | + |
|---|
| 3511 | +> tests :: Test |
|---|
| 3512 | +> tests = test [ |
|---|
| 3513 | +> try "empty" "" "", |
|---|
| 3514 | +> try "end in \\n" "abc\ndef\n" "abc\ndef\n", |
|---|
| 3515 | +> try "not end in \\n" "abc\ndef" "abc\ndef", |
|---|
| 3516 | +> try "return 1" "abc\ndefgh\rxyz" "abc\nxyzgh", |
|---|
| 3517 | +> try "return 2" "\nabcdefgh\rijklm\rxy\n" "\nxyklmfgh\n", |
|---|
| 3518 | +> try "return 3" "\r\rabc\r\rdef\r\r\r\nghi\r\r\n" "def\nghi\n", |
|---|
| 3519 | +> try "back 1" "abc\bdef\b\bgh\b" "abdgh", |
|---|
| 3520 | +> try "back 2" "abc\b\b\bdef\b\bxy\b\b\n" "dxy\n" |
|---|
| 3521 | +> -- \b at beginning of line |
|---|
| 3522 | +> -- nonprinting char |
|---|
| 3523 | +> ] |
|---|
| 3524 | } |
|---|
| 3525 | |
|---|
| 3526 | Context: |
|---|
| 3527 | |
|---|
| 3528 | [TAG 1.2.0.3 |
|---|
| 3529 | Duncan Coutts <duncan@haskell.org>**20081022051443] |
|---|
| 3530 | [Bump version to 1.2.0.3 |
|---|
| 3531 | Duncan Coutts <duncan@haskell.org>**20081022051258] |
|---|
| 3532 | [Make it build with base 3 or 4 |
|---|
| 3533 | Duncan Coutts <duncan@haskell.org>**20081022051110 |
|---|
| 3534 | But make sure it always uses base 4 with ghc-6.10 |
|---|
| 3535 | It now compiles with ghc-6.8 and 6.10 |
|---|
| 3536 | ] |
|---|
| 3537 | [TAG 2008-10-13 |
|---|
| 3538 | Ian Lynagh <igloo@earth.li>**20081013232038] |
|---|
| 3539 | Patch bundle hash: |
|---|
| 3540 | a457437dec38ec2424eba63383ffe584c8d61515 |
|---|