1HUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant) 2 3> {-# LANGUAGE CPP #-} 4> module HUnitTestBase where 5 6> import Data.List 7> import Test.HUnit 8> import Test.HUnit.Terminal (terminalAppearance) 9> import System.IO (IOMode(..), openFile, hClose) 10 11 12> data Report = Start State 13> | Error String State 14> | UnspecifiedError State 15> | Failure String State 16> deriving (Show, Read) 17 18> instance Eq Report where 19> Start s1 == Start s2 = s1 == s2 20> Error m1 s1 == Error m2 s2 = m1 == m2 && s1 == s2 21> Error _ s1 == UnspecifiedError s2 = s1 == s2 22> UnspecifiedError s1 == Error _ s2 = s1 == s2 23> UnspecifiedError s1 == UnspecifiedError s2 = s1 == s2 24> Failure m1 s1 == Failure m2 s2 = m1 == m2 && s1 == s2 25> _ == _ = False 26 27 28> expectReports :: [Report] -> Counts -> Test -> Test 29> expectReports reports1 counts1 t = TestCase $ do 30> (counts2, reports2) <- performTest (\ ss us -> return (Start ss : us)) 31> (\_loc m ss us -> return (Error m ss : us)) 32> (\_loc m ss us -> return (Failure m ss : us)) 33> [] t 34> assertEqual "for the reports from a test," reports1 (reverse reports2) 35> assertEqual "for the counts from a test," counts1 counts2 36 37 38> simpleStart :: Report 39> simpleStart = Start (State [] (Counts 1 0 0 0)) 40 41> expectSuccess :: Test -> Test 42> expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0) 43 44> expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test 45> expectProblem kind err msg = 46> expectReports [simpleStart, kind msg (State [] counts')] counts' 47> where counts' = Counts 1 1 err (1-err) 48 49> expectError, expectFailure :: String -> Test -> Test 50> expectError = expectProblem Error 1 51> expectFailure = expectProblem Failure 0 52 53> expectUnspecifiedError :: Test -> Test 54> expectUnspecifiedError = expectProblem (\ _msg st -> UnspecifiedError st) 1 undefined 55 56 57> data Expect = Succ | Err String | UErr | Fail String 58 59> expect :: Expect -> Test -> Test 60> expect Succ t = expectSuccess t 61> expect (Err m) t = expectError m t 62> expect UErr t = expectUnspecifiedError t 63> expect (Fail m) t = expectFailure m t 64 65 66 67> baseTests :: Test 68> baseTests = test [ assertTests, 69> testCaseCountTests, 70> testCasePathsTests, 71> reportTests, 72> textTests, 73> showPathTests, 74> showCountsTests, 75> assertableTests, 76> predicableTests, 77> compareTests, 78> extendedTestTests ] 79 80 81> ok :: Test 82> ok = test (assert ()) 83> bad :: String -> Test 84> bad m = test (assertFailure m :: Assertion) 85 86 87> assertTests :: Test 88> assertTests = test [ 89 90> "null" ~: expectSuccess ok, 91 92> "userError" ~: 93> expectError "user error (error)" (TestCase (ioError (userError "error"))), 94 95> "IO error (file missing)" ~: 96> expectUnspecifiedError 97> (test (do _ <- openFile "3g9djs" ReadMode; return ())), 98 99 "error" ~: 100 expectError "error" (TestCase (error "error")), 101 102 "tail []" ~: 103 expectUnspecifiedError (TestCase (tail [] `seq` return ())), 104 105 -- GHC doesn't currently catch arithmetic exceptions. 106 "div by 0" ~: 107 expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), 108 109> "assertFailure" ~: 110> let msg = "simple assertFailure" 111> in expectFailure msg (test (assertFailure msg :: Assertion)), 112 113> "assertString null" ~: expectSuccess (TestCase (assertString "")), 114 115> "assertString nonnull" ~: 116> let msg = "assertString nonnull" 117> in expectFailure msg (TestCase (assertString msg)), 118 119> let f v non = 120> show v ++ " with " ++ non ++ "null message" ~: 121> expect (if v then Succ else Fail non) $ test $ assertBool non v 122> in "assertBool" ~: [ f v non | v <- [True, False], non <- ["non", ""] ], 123 124> let msg = "assertBool True" 125> in msg ~: expectSuccess (test (assertBool msg True)), 126 127> let msg = "assertBool False" 128> in msg ~: expectFailure msg (test (assertBool msg False)), 129 130> "assertEqual equal" ~: 131> expectSuccess (test (assertEqual "" (3 :: Integer) (3 :: Integer))), 132 133> "assertEqual unequal no msg" ~: 134> expectFailure "expected: 3\n but got: 4" 135> (test (assertEqual "" (3 :: Integer) (4 :: Integer))), 136 137> "assertEqual unequal with msg" ~: 138> expectFailure "for x,\nexpected: 3\n but got: 4" 139> (test (assertEqual "for x," (3 :: Integer) (4 :: Integer))) 140 141> ] 142 143 144> emptyTest0, emptyTest1, emptyTest2 :: Test 145> emptyTest0 = TestList [] 146> emptyTest1 = TestLabel "empty" emptyTest0 147> emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ] 148> emptyTests :: [Test] 149> emptyTests = [emptyTest0, emptyTest1, emptyTest2] 150 151> testCountEmpty :: Test -> Test 152> testCountEmpty t = TestCase (assertEqual "" 0 (testCaseCount t)) 153 154> suite0, suite1, suite2, suite3 :: (Integer, Test) 155> suite0 = (0, ok) 156> suite1 = (1, TestList []) 157> suite2 = (2, TestLabel "3" ok) 158> suite3 = (3, suite) 159 160> suite :: Test 161> suite = 162> TestLabel "0" 163> (TestList [ TestLabel "1" (bad "1"), 164> TestLabel "2" (TestList [ TestLabel "2.1" ok, 165> ok, 166> TestLabel "2.3" (bad "2") ]), 167> TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))), 168> TestList [ TestList [ TestLabel "6" (bad "4") ] ] ]) 169 170> suiteCount :: Int 171> suiteCount = 6 172 173> suitePaths :: [[Node]] 174> suitePaths = [ 175> [Label "0", ListItem 0, Label "1"], 176> [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"], 177> [Label "0", ListItem 1, Label "2", ListItem 1], 178> [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"], 179> [Label "0", ListItem 2, Label "3", Label "4", Label "5"], 180> [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]] 181 182> suiteReports :: [Report] 183> suiteReports = [ Start (State (p 0) (Counts 6 0 0 0)), 184> Failure "1" (State (p 0) (Counts 6 1 0 1)), 185> Start (State (p 1) (Counts 6 1 0 1)), 186> Start (State (p 2) (Counts 6 2 0 1)), 187> Start (State (p 3) (Counts 6 3 0 1)), 188> Failure "2" (State (p 3) (Counts 6 4 0 2)), 189> Start (State (p 4) (Counts 6 4 0 2)), 190> Failure "3" (State (p 4) (Counts 6 5 0 3)), 191> Start (State (p 5) (Counts 6 5 0 3)), 192> Failure "4" (State (p 5) (Counts 6 6 0 4))] 193> where p n = reverse (suitePaths !! n) 194 195> suiteCounts :: Counts 196> suiteCounts = Counts 6 6 0 4 197 198> suiteOutput :: String 199> suiteOutput = concat [ 200> "### Failure in: 0:0:1\n", 201> "1\n", 202> "### Failure in: 0:1:2:2:2.3\n", 203> "2\n", 204> "### Failure in: 0:2:3:4:5\n", 205> "3\n", 206> "### Failure in: 0:3:0:0:6\n", 207> "4\n", 208> "Cases: 6 Tried: 6 Errors: 0 Failures: 4\n"] 209 210 211> suites :: [(Integer, Test)] 212> suites = [suite0, suite1, suite2, suite3] 213 214 215> testCount :: Show n => (n, Test) -> Int -> Test 216> testCount (num, t) count = 217> "testCaseCount suite" ++ show num ~: 218> TestCase $ assertEqual "for test count," count (testCaseCount t) 219 220> testCaseCountTests :: Test 221> testCaseCountTests = TestList [ 222 223> "testCaseCount empty" ~: test (map testCountEmpty emptyTests), 224 225> testCount suite0 1, 226> testCount suite1 0, 227> testCount suite2 1, 228> testCount suite3 suiteCount 229 230> ] 231 232 233> testPaths :: Show n => (n, Test) -> [[Node]] -> Test 234> testPaths (num, t) paths = 235> "testCasePaths suite" ++ show num ~: 236> TestCase $ assertEqual "for test paths," 237> (map reverse paths) (testCasePaths t) 238 239> testPathsEmpty :: Test -> Test 240> testPathsEmpty t = TestCase $ assertEqual "" [] (testCasePaths t) 241 242> testCasePathsTests :: Test 243> testCasePathsTests = TestList [ 244 245> "testCasePaths empty" ~: test (map testPathsEmpty emptyTests), 246 247> testPaths suite0 [[]], 248> testPaths suite1 [], 249> testPaths suite2 [[Label "3"]], 250> testPaths suite3 suitePaths 251 252> ] 253 254 255> reportTests :: Test 256> reportTests = "reports" ~: expectReports suiteReports suiteCounts suite 257 258> removeLocation :: String -> String 259> removeLocation = unlines . filter (not . isInfixOf __FILE__) . lines 260 261> expectText :: Counts -> String -> Test -> Test 262> expectText counts1 text1 t = TestCase $ do 263> (counts2, text2) <- runTestText putTextToShowS t 264> assertEqual "for the final counts," counts1 counts2 265> assertEqual "for the failure text output," text1 (removeLocation $ text2 "") 266 267 268> textTests :: Test 269> textTests = test [ 270 271> "lone error" ~: 272> expectText (Counts 1 1 1 0) 273> "### Error:\nuser error (xyz)\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" 274> (test (do _ <- ioError (userError "xyz"); return ())), 275 276> "lone failure" ~: 277> expectText (Counts 1 1 0 1) 278> "### Failure:\nxyz\nCases: 1 Tried: 1 Errors: 0 Failures: 1\n" 279> (test (assert "xyz")), 280 281> "putTextToShowS" ~: 282> expectText suiteCounts suiteOutput suite, 283 284> "putTextToHandle (file)" ~: 285> let filename = "HUnitTest.tmp" 286> trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines 287> in map test 288> [ "show progress = " ++ show flag ~: do 289> handle <- openFile filename WriteMode 290> (counts', _) <- runTestText (putTextToHandle handle flag) suite 291> hClose handle 292> assertEqual "for the final counts," suiteCounts counts' 293> text <- readFile filename 294> let text' = removeLocation $ if flag then trim (terminalAppearance text) else text 295> assertEqual "for the failure text output," suiteOutput text' 296> | flag <- [False, True] ] 297 298> ] 299 300 301> showPathTests :: Test 302> showPathTests = "showPath" ~: [ 303 304> "empty" ~: showPath [] ~?= "", 305> ":" ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"", 306> "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"", 307> "misc" ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?= 308> "foo:3:2:b" 309 310> ] 311 312 313> showCountsTests :: Test 314> showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?= 315> "Cases: 4 Tried: 3 Errors: 2 Failures: 1" 316 317 318 319> lift :: a -> IO a 320> lift a = return a 321 322 323> assertableTests :: Test 324> assertableTests = 325> let assertables x = [ 326> ( "", assert x , test (lift x)) , 327> ( "IO ", assert (lift x) , test (lift (lift x))) , 328> ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))] 329> assertabled l e x = 330> test [ test [ "assert" ~: pre ++ l ~: expect e $ test $ a, 331> "test" ~: pre ++ "IO " ++ l ~: expect e $ t ] 332> | (pre, a, t) <- assertables x ] 333> in "assertable" ~: [ 334> assertabled "()" Succ (), 335> assertabled "True" Succ True, 336> assertabled "False" (Fail "") False, 337> assertabled "\"\"" Succ "", 338> assertabled "\"x\"" (Fail "x") "x" 339> ] 340 341 342> predicableTests :: Test 343> predicableTests = 344> let predicables x m = [ 345> ( "", assertionPredicate x , x @? m, x ~? m ), 346> ( "IO ", assertionPredicate (l x) , l x @? m, l x ~? m ), 347> ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )] 348> l x = lift x 349> predicabled lab e m x = 350> test [ test [ "pred" ~: pre ++ lab ~: m ~: expect e $ test $ tst p, 351> "(@?)" ~: pre ++ lab ~: m ~: expect e $ test $ a, 352> "(~?)" ~: pre ++ lab ~: m ~: expect e $ t ] 353> | (pre, p, a, t) <- predicables x m ] 354> where tst p = p >>= assertBool m 355> in "predicable" ~: [ 356> predicabled "True" Succ "error" True, 357> predicabled "False" (Fail "error") "error" False, 358> predicabled "True" Succ "" True, 359> predicabled "False" (Fail "" ) "" False 360> ] 361 362 363> compareTests :: Test 364> compareTests = test [ 365 366> let succ' = const Succ 367> compare1 :: (String -> Expect) -> Integer -> Integer -> Test 368> compare1 = compare' 369> compare2 :: (String -> Expect) 370> -> (Integer, Char, Double) 371> -> (Integer, Char, Double) 372> -> Test 373> compare2 = compare' 374> compare' f expected actual 375> = test [ "(@=?)" ~: expect e $ test (expected @=? actual), 376> "(@?=)" ~: expect e $ test (actual @?= expected), 377> "(~=?)" ~: expect e $ expected ~=? actual, 378> "(~?=)" ~: expect e $ actual ~?= expected ] 379> where e = f $ "expected: " ++ show expected ++ 380> "\n but got: " ++ show actual 381> in test [ 382> compare1 succ' 1 1, 383> compare1 Fail 1 2, 384> compare2 succ' (1,'b',3.0) (1,'b',3.0), 385> compare2 Fail (1,'b',3.0) (1,'b',3.1) 386> ] 387 388> ] 389 390 391> expectList1 :: Int -> Test -> Test 392> expectList1 c = 393> expectReports 394> [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ] 395> (Counts c c 0 0) 396 397> expectList2 :: [Int] -> Test -> Test 398> expectList2 cs t = 399> expectReports 400> [ Start (State [ListItem j, ListItem i] (Counts c n 0 0)) 401> | ((i,j),n) <- zip coords [0..] ] 402> (Counts c c 0 0) 403> t 404> where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ] 405> c = testCaseCount t 406 407 408> extendedTestTests :: Test 409> extendedTestTests = test [ 410 411> "test idempotent" ~: expect Succ $ test $ test $ test $ ok, 412 413> "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True], 414 415> "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]] 416 417> ] 418