Thu Jan 15 01:26:38 MST 2009 richardg@richardg.name * FIX #1632 (Test.HUnit documentation) Added documentation and integrated tests Converted the literate files to non-literate files. Added Haddock documentation. Added summary to Test.HUnit module. Made it so that tests are built when the rest of the package is. Integrated tests so that Cabal will run them. Cabal will not install the testing executables. New patches: [FIX #1632 (Test.HUnit documentation) richardg@richardg.name**20090115082638 Added documentation and integrated tests Converted the literate files to non-literate files. Added Haddock documentation. Added summary to Test.HUnit module. Made it so that tests are built when the rest of the package is. Integrated tests so that Cabal will run them. Cabal will not install the testing executables. ] { addfile ./Test/HUnit.hs hunk ./Test/HUnit.lhs 1 -HUnit.lhs -- interface module for HUnit - -> module Test.HUnit -> ( -> module Test.HUnit.Base, -> module Test.HUnit.Text -> ) -> where - -> import Test.HUnit.Base -> import Test.HUnit.Text rmfile ./Test/HUnit.lhs addfile ./Test/HUnit/Base.hs hunk ./Test/HUnit/Base.lhs 1 -HUnitBase.lhs -- basic definitions - -> module Test.HUnit.Base -> ( -> {- from Test.HUnit.Lang: -} Assertion, assertFailure, -> assertString, assertBool, assertEqual, -> Assertable(..), ListAssertable(..), -> AssertionPredicate, AssertionPredicable(..), -> (@?), (@=?), (@?=), -> Test(..), Node(..), Path, -> testCaseCount, -> Testable(..), -> (~?), (~=?), (~?=), (~:), -> Counts(..), State(..), -> ReportStart, ReportProblem, -> testCasePaths, -> performTest -> ) -> where - -> import Control.Monad (unless, foldM) - - -Assertion Definition -==================== - -> import Test.HUnit.Lang - - -Conditional Assertion Functions -------------------------------- - -> assertBool :: String -> Bool -> Assertion -> assertBool msg b = unless b (assertFailure msg) - -> assertString :: String -> Assertion -> assertString s = unless (null s) (assertFailure s) - -> assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion -> assertEqual preface expected actual = -> unless (actual == expected) (assertFailure msg) -> where msg = (if null preface then "" else preface ++ "\n") ++ -> "expected: " ++ show expected ++ "\n but got: " ++ show actual - - -Overloaded `assert` Function ----------------------------- - -> class Assertable t -> where assert :: t -> Assertion - -> instance Assertable () -> where assert = return - -> instance Assertable Bool -> where assert = assertBool "" - -> instance (ListAssertable t) => Assertable [t] -> where assert = listAssert - -> instance (Assertable t) => Assertable (IO t) -> where assert = (>>= assert) - -We define the assertability of `[Char]` (that is, `String`) and leave -other types of list to possible user extension. - -> class ListAssertable t -> where listAssert :: [t] -> Assertion - -> instance ListAssertable Char -> where listAssert = assertString - - -Overloaded `assertionPredicate` Function ----------------------------------------- - -> type AssertionPredicate = IO Bool - -> class AssertionPredicable t -> where assertionPredicate :: t -> AssertionPredicate - -> instance AssertionPredicable Bool -> where assertionPredicate = return - -> instance (AssertionPredicable t) => AssertionPredicable (IO t) -> where assertionPredicate = (>>= assertionPredicate) - - -Assertion Construction Operators --------------------------------- - -> infix 1 @?, @=?, @?= - -> (@?) :: (AssertionPredicable t) => t -> String -> Assertion -> pred @? msg = assertionPredicate pred >>= assertBool msg - -> (@=?) :: (Eq a, Show a) => a -> a -> Assertion -> expected @=? actual = assertEqual "" expected actual - -> (@?=) :: (Eq a, Show a) => a -> a -> Assertion -> actual @?= expected = assertEqual "" expected actual - - - -Test Definition -=============== - -> data Test = TestCase Assertion -> | TestList [Test] -> | TestLabel String Test - -> instance Show Test where -> showsPrec p (TestCase _) = showString "TestCase _" -> showsPrec p (TestList ts) = showString "TestList " . showList ts -> showsPrec p (TestLabel l t) = showString "TestLabel " . showString l -> . showChar ' ' . showsPrec p t - -> testCaseCount :: Test -> Int -> testCaseCount (TestCase _) = 1 -> testCaseCount (TestList ts) = sum (map testCaseCount ts) -> testCaseCount (TestLabel _ t) = testCaseCount t - - -> data Node = ListItem Int | Label String -> deriving (Eq, Show, Read) - -> type Path = [Node] -- Node order is from test case to root. - - -> testCasePaths :: Test -> [Path] -> testCasePaths t = tcp t [] -> where tcp (TestCase _) p = [p] -> tcp (TestList ts) p = -> concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ] -> tcp (TestLabel l t) p = tcp t (Label l : p) - - -Overloaded `test` Function --------------------------- - -> class Testable t -> where test :: t -> Test - -> instance Testable Test -> where test = id - -> instance (Assertable t) => Testable (IO t) -> where test = TestCase . assert - -> instance (Testable t) => Testable [t] -> where test = TestList . map test - - -Test Construction Operators ---------------------------- - -> infix 1 ~?, ~=?, ~?= -> infixr 0 ~: - -> (~?) :: (AssertionPredicable t) => t -> String -> Test -> pred ~? msg = TestCase (pred @? msg) - -> (~=?) :: (Eq a, Show a) => a -> a -> Test -> expected ~=? actual = TestCase (expected @=? actual) - -> (~?=) :: (Eq a, Show a) => a -> a -> Test -> actual ~?= expected = TestCase (actual @?= expected) - -> (~:) :: (Testable t) => String -> t -> Test -> label ~: t = TestLabel label (test t) - - - -Test Execution -============== - -> data Counts = Counts { cases, tried, errors, failures :: Int } -> deriving (Eq, Show, Read) - -> data State = State { path :: Path, counts :: Counts } -> deriving (Eq, Show, Read) - -> type ReportStart us = State -> us -> IO us - -> type ReportProblem us = String -> State -> us -> IO us - - -Note that the counts in a start report do not include the test case -being started, whereas the counts in a problem report do include the -test case just finished. The principle is that the counts are sampled -only between test case executions. As a result, the number of test -case successes always equals the difference of test cases tried and -the sum of test case errors and failures. - - -> performTest :: ReportStart us -> ReportProblem us -> ReportProblem us -> -> us -> Test -> IO (Counts, us) -> performTest reportStart reportError reportFailure us t = do -> (ss', us') <- pt initState us t -> unless (null (path ss')) $ error "performTest: Final path is nonnull" -> return (counts ss', us') -> where -> initState = State{ path = [], counts = initCounts } -> initCounts = Counts{ cases = testCaseCount t, tried = 0, -> errors = 0, failures = 0} - -> pt ss us (TestCase a) = do -> us' <- reportStart ss us -> r <- performTestCase a -> case r of Nothing -> do return (ss', us') -> Just (True, m) -> do usF <- reportFailure m ssF us' -> return (ssF, usF) -> Just (False, m) -> do usE <- reportError m ssE us' -> return (ssE, usE) -> where c@Counts{ tried = t } = counts ss -> ss' = ss{ counts = c{ tried = t + 1 } } -> ssF = ss{ counts = c{ tried = t + 1, failures = failures c + 1 } } -> ssE = ss{ counts = c{ tried = t + 1, errors = errors c + 1 } } - -> pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..]) -> where f (ss, us) (t, n) = withNode (ListItem n) ss us t - -> pt ss us (TestLabel label t) = withNode (Label label) ss us t - -> withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t -> return (ss2{ path = path0 }, us1) -> where path0 = path ss0 -> ss1 = ss0{ path = node : path0 } rmfile ./Test/HUnit/Base.lhs addfile ./Test/HUnit/Lang.hs hunk ./Test/HUnit/Lang.lhs 1 -Test/HUnit/Lang.lhs -- HUnit language support. - -> module Test.HUnit.Lang -> ( -> Assertion, -> assertFailure, -> performTestCase -> ) -> where - - -When adapting this module for other Haskell language systems, change -the imports and the implementations but not the interfaces. - - - -Imports -------- - -> import Data.List (isPrefixOf) -#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -> import Data.Dynamic -> import Control.Exception as E -#else -> import System.IO.Error (ioeGetErrorString, try) -#endif - - - -Interfaces ----------- - -An assertion is an `IO` computation with trivial result. - -> type Assertion = IO () - -`assertFailure` signals an assertion failure with a given message. - -> assertFailure :: String -> Assertion - -`performTestCase` performs a single test case. The meaning of the -result is as follows: - Nothing test case success - Just (True, msg) test case failure with the given message - Just (False, msg) test case error with the given message - -> performTestCase :: Assertion -> IO (Maybe (Bool, String)) - - -Implementations ---------------- - -#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -> data HUnitFailure = HUnitFailure String -> deriving Show -> -> hunitFailureTc :: TyCon -> hunitFailureTc = mkTyCon "HUnitFailure" -> {-# NOINLINE hunitFailureTc #-} -> -> instance Typeable HUnitFailure where -> typeOf _ = mkTyConApp hunitFailureTc [] -#ifdef BASE4 -> instance Exception HUnitFailure - -> assertFailure msg = E.throw (HUnitFailure msg) - -> performTestCase action = -> do action -> return Nothing -> `E.catches` -> [E.Handler (\(HUnitFailure msg) -> return $ Just (True, msg)), -> E.Handler (\e -> return $ Just (False, show (e :: E.SomeException)))] -#else -> assertFailure msg = E.throwDyn (HUnitFailure msg) - -> performTestCase action = -> do r <- E.try action -> case r of -> Right () -> return Nothing -> Left e@(E.DynException dyn) -> -> case fromDynamic dyn of -> Just (HUnitFailure msg) -> return $ Just (True, msg) -> Nothing -> return $ Just (False, show e) -> Left e -> return $ Just (False, show e) -#endif -#else -> hunitPrefix = "HUnit:" - -> nhc98Prefix = "I/O error (user-defined), call to function `userError':\n " - -> assertFailure msg = ioError (userError (hunitPrefix ++ msg)) - -> performTestCase action = do r <- try action -> case r of Right () -> return Nothing -> Left e -> return (Just (decode e)) -> where -> decode e = let s0 = ioeGetErrorString e -> (_, s1) = dropPrefix nhc98Prefix s0 -> in dropPrefix hunitPrefix s1 -> dropPrefix pref str = if pref `isPrefixOf` str -> then (True, drop (length pref) str) -> else (False, str) -#endif rmfile ./Test/HUnit/Lang.lhs addfile ./Test/HUnit/Terminal.hs hunk ./Test/HUnit/Terminal.lhs 1 -> module Test.HUnit.Terminal -> ( -> terminalAppearance -> ) -> where - -> import Data.Char (isPrint) - - -Simplifies the input string by interpreting '\r' and '\b' characters -specially so that the result string has the same final (or "terminal", -pun intended) appearance as would the input string when written to a -terminal that overwrites character positions following carriage -returns and backspaces. - -The helper function `ta` takes an accumulating `ShowS`-style function -that holds "committed" lines of text, a (reversed) list of characters -on the current line *before* the cursor, a (normal) list of characters -on the current line *after* the cursor, and the remaining input. - -> terminalAppearance :: String -> String -> terminalAppearance str = ta id "" "" str -> where -> ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs -> ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs -> ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs -> ta f "" as ('\b':cs) = error "'\\b' at beginning of line" -> ta f bs as (c:cs) | not (isPrint c) = error "invalid nonprinting character" -> | null as = ta f (c:bs) "" cs -> | otherwise = ta f (c:bs) (tail as) cs -> ta f bs as "" = f (reverse bs ++ as) rmfile ./Test/HUnit/Terminal.lhs addfile ./Test/HUnit/Text.hs hunk ./Test/HUnit/Text.lhs 1 -HUnitText.lhs -- text-based test controller - -> module Test.HUnit.Text -> ( -> PutText(..), -> putTextToHandle, putTextToShowS, -> runTestText, -> showPath, showCounts, -> runTestTT -> ) -> where - -> import Test.HUnit.Base - -> import Control.Monad (when) -> import System.IO (Handle, stderr, hPutStr, hPutStrLn) - - -As the general text-based test controller (`runTestText`) executes a -test, it reports each test case start, error, and failure by -constructing a string and passing it to the function embodied in a -`PutText`. A report string is known as a "line", although it includes -no line terminator; the function in a `PutText` is responsible for -terminating lines appropriately. Besides the line, the function -receives a flag indicating the intended "persistence" of the line: -`True` indicates that the line should be part of the final overall -report; `False` indicates that the line merely indicates progress of -the test execution. Each progress line shows the current values of -the cumulative test execution counts; a final, persistent line shows -the final count values. - -The `PutText` function is also passed, and returns, an arbitrary state -value (called `st` here). The initial state value is given in the -`PutText`; the final value is returned by `runTestText`. - -> data PutText st = PutText (String -> Bool -> st -> IO st) st - - -Two reporting schemes are defined here. `putTextToHandle` writes -report lines to a given handle. `putTextToShowS` accumulates -persistent lines for return as a whole by `runTestText`. - - -`putTextToHandle` writes persistent lines to the given handle, -following each by a newline character. In addition, if the given flag -is `True`, it writes progress lines to the handle as well. A progress -line is written with no line termination, so that it can be -overwritten by the next report line. As overwriting involves writing -carriage return and blank characters, its proper effect is usually -only obtained on terminal devices. - -> putTextToHandle :: Handle -> Bool -> PutText Int -> putTextToHandle handle showProgress = PutText put initCnt -> where -> initCnt = if showProgress then 0 else -1 -> put line pers (-1) = do when pers (hPutStrLn handle line); return (-1) -> put line True cnt = do hPutStrLn handle (erase cnt ++ line); return 0 -> put line False cnt = do hPutStr handle ('\r' : line); return (length line) -> -- The "erasing" strategy with a single '\r' relies on the fact that the -> -- lengths of successive summary lines are monotonically nondecreasing. -> erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" - - -`putTextToShowS` accumulates persistent lines (dropping progess lines) -for return by `runTestText`. The accumulated lines are represented by -a `ShowS` (`String -> String`) function whose first argument is the -string to be appended to the accumulated report lines. - -> putTextToShowS :: PutText ShowS -> putTextToShowS = PutText put id -> where put line pers f = return (if pers then acc f line else f) -> acc f line tail = f (line ++ '\n' : tail) - - -`runTestText` executes a test, processing each report line according -to the given reporting scheme. The reporting scheme's state is -threaded through calls to the reporting scheme's function and finally -returned, along with final count values. - -> runTestText :: PutText st -> Test -> IO (Counts, st) -> runTestText (PutText put us) t = do -> (counts, us') <- performTest reportStart reportError reportFailure us t -> us'' <- put (showCounts counts) True us' -> return (counts, us'') -> where -> reportStart ss us = put (showCounts (counts ss)) False us -> reportError = reportProblem "Error:" "Error in: " -> reportFailure = reportProblem "Failure:" "Failure in: " -> reportProblem p0 p1 msg ss us = put line True us -> where line = "### " ++ kind ++ path' ++ '\n' : msg -> kind = if null path' then p0 else p1 -> path' = showPath (path ss) - - -`showCounts` converts test execution counts to a string. - -> showCounts :: Counts -> String -> showCounts Counts{ cases = cases, tried = tried, -> errors = errors, failures = failures } = -> "Cases: " ++ show cases ++ " Tried: " ++ show tried ++ -> " Errors: " ++ show errors ++ " Failures: " ++ show failures - - -`showPath` converts a test case path to a string, separating adjacent -elements by ':'. An element of the path is quoted (as with `show`) -when there is potential ambiguity. - -> showPath :: Path -> String -> showPath [] = "" -> showPath nodes = foldl1 f (map showNode nodes) -> where f b a = a ++ ":" ++ b -> showNode (ListItem n) = show n -> showNode (Label label) = safe label (show label) -> safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s - - -`runTestTT` provides the "standard" text-based test controller. -Reporting is made to standard error, and progress reports are -included. For possible programmatic use, the final counts are -returned. The "TT" in the name suggests "Text-based reporting to the -Terminal". - -> runTestTT :: Test -> IO Counts -> runTestTT t = do (counts, 0) <- runTestText (putTextToHandle stderr True) t -> return counts rmfile ./Test/HUnit/Text.lhs hunk ./examples/Makefile 1 -# ----------------------------------------------------------------------------- - -TOP = ../.. -include $(TOP)/mk/boilerplate.mk - -# ----------------------------------------------------------------------------- - -ifeq "$(way)" "" -SUBDIRS = test - -EXAMPLES := $(wildcard *.hs) -BINS := $(addsuffix $(exeext),$(EXAMPLES:.hs=)) -CLEAN_FILES += $(BINS) - -HC = $(GHC_INPLACE) -MKDEPENDHS = $(GHC_INPLACE) -SRC_HC_OPTS += -Wall -package HUnit - -all:: $(BINS) - -$(BINS): %$(exeext): %.o - $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $< -endif - -# ----------------------------------------------------------------------------- - -include $(TOP)/mk/target.mk rmfile ./examples/Makefile hunk ./examples/test/HUnitTest98.lhs 1 -HUnitTest98.lhs -- test for HUnit, using Haskell language system "98" - -> module Main (main) where - -> import Test.HUnit -> import HUnitTestBase - -> main :: IO Counts -> main = runTestTT (test [baseTests]) rmfile ./examples/test/HUnitTest98.lhs hunk ./examples/test/HUnitTestBase.lhs 1 -HUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant) - -> module HUnitTestBase where - -> import Test.HUnit -> import Test.HUnit.Terminal (terminalAppearance) -> import System.IO (IOMode(..), openFile, hClose) - - -> data Report = Start State -> | Error String State -> | UnspecifiedError State -> | Failure String State -> deriving (Show, Read) - -> instance Eq Report where -> Start s1 == Start s2 = s1 == s2 -> Error m1 s1 == Error m2 s2 = m1 == m2 && s1 == s2 -> Error m1 s1 == UnspecifiedError s2 = s1 == s2 -> UnspecifiedError s1 == Error m2 s2 = s1 == s2 -> UnspecifiedError s1 == UnspecifiedError s2 = s1 == s2 -> Failure m1 s1 == Failure m2 s2 = m1 == m2 && s1 == s2 -> _ == _ = False - - -> expectReports :: [Report] -> Counts -> Test -> Test -> expectReports reports counts test = TestCase $ do -> (counts', reports') <- performTest (\ ss us -> return (Start ss : us)) -> (\m ss us -> return (Error m ss : us)) -> (\m ss us -> return (Failure m ss : us)) -> [] test -> assertEqual "for the reports from a test," reports (reverse reports') -> assertEqual "for the counts from a test," counts counts' - - -> simpleStart = Start (State [] (Counts 1 0 0 0)) - -> expectSuccess :: Test -> Test -> expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0) - -> expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test -> expectProblem kind err msg = -> expectReports [simpleStart, kind msg (State [] counts)] counts -> where counts = Counts 1 1 err (1-err) - -> expectError, expectFailure :: String -> Test -> Test -> expectError = expectProblem Error 1 -> expectFailure = expectProblem Failure 0 - -> expectUnspecifiedError :: Test -> Test -> expectUnspecifiedError = expectProblem (\ msg st -> UnspecifiedError st) 1 undefined - - -> data Expect = Succ | Err String | UErr | Fail String - -> expect :: Expect -> Test -> Test -> expect Succ test = expectSuccess test -> expect (Err m) test = expectError m test -> expect UErr test = expectUnspecifiedError test -> expect (Fail m) test = expectFailure m test - - - -> baseTests = test [ assertTests, -> testCaseCountTests, -> testCasePathsTests, -> reportTests, -> textTests, -> showPathTests, -> showCountsTests, -> assertableTests, -> predicableTests, -> compareTests, -> extendedTestTests ] - - -> ok = test (assert ()) -> bad m = test (assertFailure m) - - -> assertTests = test [ - -> "null" ~: expectSuccess ok, - -> "userError" ~: -> expectError "error" (TestCase (ioError (userError "error"))), - -> "IO error (file missing)" ~: -> expectUnspecifiedError -> (test (do openFile "3g9djs" ReadMode; return ())), - - "error" ~: - expectError "error" (TestCase (error "error")), - - "tail []" ~: - expectUnspecifiedError (TestCase (tail [] `seq` return ())), - - -- GHC doesn't currently catch arithmetic exceptions. - "div by 0" ~: - expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), - -> "assertFailure" ~: -> let msg = "simple assertFailure" -> in expectFailure msg (test (assertFailure msg)), - -> "assertString null" ~: expectSuccess (TestCase (assertString "")), - -> "assertString nonnull" ~: -> let msg = "assertString nonnull" -> in expectFailure msg (TestCase (assertString msg)), - -> let exp v non = -> show v ++ " with " ++ non ++ "null message" ~: -> expect (if v then Succ else Fail non) $ test $ assertBool non v -> in "assertBool" ~: [ exp v non | v <- [True, False], non <- ["non", ""] ], - -> let msg = "assertBool True" -> in msg ~: expectSuccess (test (assertBool msg True)), - -> let msg = "assertBool False" -> in msg ~: expectFailure msg (test (assertBool msg False)), - -> "assertEqual equal" ~: -> expectSuccess (test (assertEqual "" 3 3)), - -> "assertEqual unequal no msg" ~: -> expectFailure "expected: 3\n but got: 4" -> (test (assertEqual "" 3 4)), - -> "assertEqual unequal with msg" ~: -> expectFailure "for x,\nexpected: 3\n but got: 4" -> (test (assertEqual "for x," 3 4)) - -> ] - - -> emptyTest0 = TestList [] -> emptyTest1 = TestLabel "empty" emptyTest0 -> emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ] -> emptyTests = [emptyTest0, emptyTest1, emptyTest2] - -> testCountEmpty test = TestCase (assertEqual "" 0 (testCaseCount test)) - -> suite0 = (0, ok) -> suite1 = (1, TestList []) -> suite2 = (2, TestLabel "3" ok) -> suite3 = (3, suite) - -> suite = -> TestLabel "0" -> (TestList [ TestLabel "1" (bad "1"), -> TestLabel "2" (TestList [ TestLabel "2.1" ok, -> ok, -> TestLabel "2.3" (bad "2") ]), -> TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))), -> TestList [ TestList [ TestLabel "6" (bad "4") ] ] ]) - -> suiteCount = (6 :: Int) - -> suitePaths = [ -> [Label "0", ListItem 0, Label "1"], -> [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"], -> [Label "0", ListItem 1, Label "2", ListItem 1], -> [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"], -> [Label "0", ListItem 2, Label "3", Label "4", Label "5"], -> [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]] - -> suiteReports = [ Start (State (p 0) (Counts 6 0 0 0)), -> Failure "1" (State (p 0) (Counts 6 1 0 1)), -> Start (State (p 1) (Counts 6 1 0 1)), -> Start (State (p 2) (Counts 6 2 0 1)), -> Start (State (p 3) (Counts 6 3 0 1)), -> Failure "2" (State (p 3) (Counts 6 4 0 2)), -> Start (State (p 4) (Counts 6 4 0 2)), -> Failure "3" (State (p 4) (Counts 6 5 0 3)), -> Start (State (p 5) (Counts 6 5 0 3)), -> Failure "4" (State (p 5) (Counts 6 6 0 4))] -> where p n = reverse (suitePaths !! n) - -> suiteCounts = Counts 6 6 0 4 - -> suiteOutput = "### Failure in: 0:0:1\n\ -> \1\n\ -> \### Failure in: 0:1:2:2:2.3\n\ -> \2\n\ -> \### Failure in: 0:2:3:4:5\n\ -> \3\n\ -> \### Failure in: 0:3:0:0:6\n\ -> \4\n\ -> \Cases: 6 Tried: 6 Errors: 0 Failures: 4\n" - - -> suites = [suite0, suite1, suite2, suite3] - - -> testCount (num, test) count = -> "testCaseCount suite" ++ show num ~: -> TestCase $ assertEqual "for test count," count (testCaseCount test) - -> testCaseCountTests = TestList [ - -> "testCaseCount empty" ~: test (map testCountEmpty emptyTests), - -> testCount suite0 1, -> testCount suite1 0, -> testCount suite2 1, -> testCount suite3 suiteCount - -> ] - - -> testPaths (num, test) paths = -> "testCasePaths suite" ++ show num ~: -> TestCase $ assertEqual "for test paths," -> (map reverse paths) (testCasePaths test) - -> testPathsEmpty test = TestCase $ assertEqual "" [] (testCasePaths test) - -> testCasePathsTests = TestList [ - -> "testCasePaths empty" ~: test (map testPathsEmpty emptyTests), - -> testPaths suite0 [[]], -> testPaths suite1 [], -> testPaths suite2 [[Label "3"]], -> testPaths suite3 suitePaths - -> ] - - -> reportTests = "reports" ~: expectReports suiteReports suiteCounts suite - - -> expectText counts text test = TestCase $ do -> (counts', text') <- runTestText putTextToShowS test -> assertEqual "for the final counts," counts counts' -> assertEqual "for the failure text output," text (text' "") - - -> textTests = test [ - -> "lone error" ~: -> expectText (Counts 1 1 1 0) -> "### Error:\nxyz\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" -> (test (do ioError (userError "xyz"); return ())), - -> "lone failure" ~: -> expectText (Counts 1 1 0 1) -> "### Failure:\nxyz\nCases: 1 Tried: 1 Errors: 0 Failures: 1\n" -> (test (assert "xyz")), - -> "putTextToShowS" ~: -> expectText suiteCounts suiteOutput suite, - -> "putTextToHandle (file)" ~: -> let filename = "HUnitTest.tmp" -> trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines -> in map test -> [ "show progress = " ++ show flag ~: do -> handle <- openFile filename WriteMode -> (counts, _) <- runTestText (putTextToHandle handle flag) suite -> hClose handle -> assertEqual "for the final counts," suiteCounts counts -> text <- readFile filename -> let text' = if flag then trim (terminalAppearance text) else text -> assertEqual "for the failure text output," suiteOutput text' -> | flag <- [False, True] ] - -> ] - - -> showPathTests = "showPath" ~: [ - -> "empty" ~: showPath [] ~?= "", -> ":" ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"", -> "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"", -> "misc" ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?= -> "foo:3:2:b" - -> ] - - -> showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?= -> "Cases: 4 Tried: 3 Errors: 2 Failures: 1" - - - -> lift :: a -> IO a -> lift a = return a - - -> assertableTests = -> let assertables x = [ -> ( "", assert x , test (lift x)) , -> ( "IO ", assert (lift x) , test (lift (lift x))) , -> ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))] -> assertabled l e x = -> test [ test [ "assert" ~: pre ++ l ~: expect e $ test $ a, -> "test" ~: pre ++ "IO " ++ l ~: expect e $ t ] -> | (pre, a, t) <- assertables x ] -> in "assertable" ~: [ -> assertabled "()" Succ (), -> assertabled "True" Succ True, -> assertabled "False" (Fail "") False, -> assertabled "\"\"" Succ "", -> assertabled "\"x\"" (Fail "x") "x" -> ] - - -> predicableTests = -> let predicables x m = [ -> ( "", assertionPredicate x , x @? m, x ~? m ), -> ( "IO ", assertionPredicate (l x) , l x @? m, l x ~? m ), -> ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )] -> l x = lift x -> predicabled l e m x = -> test [ test [ "pred" ~: pre ++ l ~: m ~: expect e $ test $ tst p, -> "(@?)" ~: pre ++ l ~: m ~: expect e $ test $ a, -> "(~?)" ~: pre ++ l ~: m ~: expect e $ t ] -> | (pre, p, a, t) <- predicables x m ] -> where tst p = p >>= assertBool m -> in "predicable" ~: [ -> predicabled "True" Succ "error" True, -> predicabled "False" (Fail "error") "error" False, -> predicabled "True" Succ "" True, -> predicabled "False" (Fail "" ) "" False -> ] - - -> compareTests = test [ - -> let succ = const Succ -> compare f exp act = test [ "(@=?)" ~: expect e $ test (exp @=? act), -> "(@?=)" ~: expect e $ test (act @?= exp), -> "(~=?)" ~: expect e $ exp ~=? act, -> "(~?=)" ~: expect e $ act ~?= exp ] -> where e = f $ "expected: " ++ show exp ++ "\n but got: " ++ show act -> in test [ -> compare succ 1 1, -> compare Fail 1 2, -> compare succ (1,'b',3.0) (1,'b',3.0), -> compare Fail (1,'b',3.0) (1,'b',3.1) -> ] - -> ] - - -> expectList1 :: Int -> Test -> Test -> expectList1 c = -> expectReports -> [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ] -> (Counts c c 0 0) - -> expectList2 :: [Int] -> Test -> Test -> expectList2 cs test = -> expectReports -> [ Start (State [ListItem j, ListItem i] (Counts c n 0 0)) -> | ((i,j),n) <- zip coords [0..] ] -> (Counts c c 0 0) -> test -> where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ] -> c = testCaseCount test - - -> extendedTestTests = test [ - -> "test idempotent" ~: expect Succ $ test $ test $ test $ ok, - -> "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True], - -> "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]] - -> ] rmfile ./examples/test/HUnitTestBase.lhs hunk ./examples/test/HUnitTestExtended.lhs 1 -HUnitTestExc.lhs -- test for HUnit, using Haskell language system "Exc" - -> module Main (main) where - -> import Test.HUnit -> import HUnitTestBase - - import qualified Control.Exception (assert) - - assertionMessage = "HUnitTestExc.lhs:13: Assertion failed\n" - assertion = Control.Exception.assert False (return ()) - - -> main :: IO Counts -> main = runTestTT (test [baseTests, excTests]) - -> excTests :: Test -> excTests = test [ - - -- Hugs and GHC don't currently catch arithmetic exceptions. - "div by 0" ~: - expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), - - -- GHC doesn't currently catch array-related exceptions. - "array ref out of bounds" ~: - expectUnspecifiedError (TestCase (... `seq` return ())), - -> "error" ~: -> expectError "error" (TestCase (error "error")), - -> "tail []" ~: -> expectUnspecifiedError (TestCase (tail [] `seq` return ())) - - -- Hugs doesn't provide `assert`. - "assert" ~: - expectError assertionMessage (TestCase assertion) - -> ] rmfile ./examples/test/HUnitTestExtended.lhs hunk ./examples/test/Makefile 1 -# ----------------------------------------------------------------------------- - -TOP = ../../.. -include $(TOP)/mk/boilerplate.mk - -# ----------------------------------------------------------------------------- - -EXAMPLES := $(filter-out HUnitTestBase.lhs,$(wildcard *.lhs)) -BINS := $(addsuffix $(exeext),$(EXAMPLES:.lhs=)) -CLEAN_FILES += $(BINS) - -HC = $(GHC_INPLACE) -MKDEPENDHS = $(GHC_INPLACE) -SRC_HC_OPTS += -Wall -package HUnit - -all:: $(BINS) - -USES_HUNITTESTBASE := $(EXAMPLES:.lhs=) - -.PRECIOUS: HUnitTestBase.o -$(addsuffix .o,$(USES_HUNITTESTBASE)): HUnitTestBase.hi -$(addsuffix $(exeext),$(USES_HUNITTESTBASE)): HUnitTestBase.o - -$(BINS): %$(exeext): %.o - $(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $< $(patsubst %,HUnitTestBase.o,$(filter $(<:.o=),$(USES_HUNITTESTBASE))) - -# ----------------------------------------------------------------------------- - -include $(TOP)/mk/target.mk rmfile ./examples/test/Makefile hunk ./examples/test/TerminalTest.lhs 1 -TerminalTest.lhs - -> import Test.HUnit.Terminal -> import Test.HUnit - -> main :: IO Counts -> main = runTestTT tests - -> try :: String -> String -> String -> Test -> try lab inp exp' = lab ~: terminalAppearance inp ~?= exp' - -> tests :: Test -> tests = test [ -> try "empty" "" "", -> try "end in \\n" "abc\ndef\n" "abc\ndef\n", -> try "not end in \\n" "abc\ndef" "abc\ndef", -> try "return 1" "abc\ndefgh\rxyz" "abc\nxyzgh", -> try "return 2" "\nabcdefgh\rijklm\rxy\n" "\nxyklmfgh\n", -> try "return 3" "\r\rabc\r\rdef\r\r\r\nghi\r\r\n" "def\nghi\n", -> try "back 1" "abc\bdef\b\bgh\b" "abdgh", -> try "back 2" "abc\b\b\bdef\b\bxy\b\b\n" "dxy\n" -> -- \b at beginning of line -> -- nonprinting char -> ] rmfile ./examples/test/TerminalTest.lhs rmdir ./examples/test adddir ./tests hunk ./HUnit.cabal 1 -name: HUnit -version: 1.2.0.3 -license: BSD3 -license-file: LICENSE -author: Dean Herington -homepage: http://hunit.sourceforge.net/ -category: Testing -synopsis: A unit testing framework for Haskell -maintainer: libraries@haskell.org -cabal-version: >= 1.2 -description: - HUnit is a unit testing framework for Haskell, inspired by the - JUnit tool for Java, see: . -build-type: Simple +Name: HUnit +Version: 1.2.0.4 +Cabal-Version: >= 1.2 +License: BSD3 +License-File: LICENSE +Author: Dean Herington +Maintainer: libraries@haskell.org +Stability: stable +Homepage: http://hunit.sourceforge.net/ +Category: Testing +Synopsis: A unit testing framework for Haskell +Description: + HUnit is a unit testing framework for Haskell, inspired by the + JUnit tool for Java, see: . +Tested-With: + GHC == 6.10.1 +Build-Type: Custom +Extra-Source-Files: + tests/HUnitTest98.lhs + tests/HUnitTestBase.lhs + tests/HUnitTestExtended.lhs + tests/HUnitTests.cabal + tests/Setup.hs + tests/TerminalTest.lhs +Data-Files: + doc/Guide.html + examples/Example.hs + prologue.txt + README flag base4 hunk ./HUnit.cabal 33 -library - build-depends: base <5 +Library + Build-Depends: base <5 if flag(base4) hunk ./HUnit.cabal 36 - build-depends: base >=4 - cpp-options: -DBASE4 + Build-Depends: base >=4 + CPP-Options: -DBASE4 else hunk ./HUnit.cabal 39 - build-depends: base <4 + Build-Depends: base <4 if impl(ghc >= 6.10) hunk ./HUnit.cabal 41 - build-depends: base >=4 - exposed-modules: - Test.HUnit.Base, - Test.HUnit.Lang, - Test.HUnit.Terminal, - Test.HUnit.Text, - Test.HUnit - extensions: CPP + Build-Depends: base >=4 + Exposed-Modules: + Test.HUnit.Base, + Test.HUnit.Lang, + Test.HUnit.Terminal, + Test.HUnit.Text, + Test.HUnit + Extensions: CPP hunk ./HUnit.cabal 50 +Executable basic-tests + Main-Is: HUnitTest98.lhs + HS-Source-Dirs: . tests + Build-Depends: base<5 + if flag(base4) + Build-Depends: base >=4 + CPP-Options: -DBASE4 + else + Build-Depends: base <4 + if impl(ghc >= 6.10) + Build-Depends: base >=4 + Extensions: CPP + +Executable extended-tests + Main-Is: HUnitTestExtended.lhs + HS-Source-Dirs: . tests + Build-Depends: base<5 + if flag(base4) + Build-Depends: base >=4 + CPP-Options: -DBASE4 + else + Build-Depends: base <4 + if impl(ghc >= 6.10) + Build-Depends: base >=4 + Extensions: CPP + +Executable terminal-tests + Main-Is: TerminalTest.lhs + HS-Source-Dirs: . tests + Build-Depends: base<5 + if flag(base4) + Build-Depends: base >=4 + CPP-Options: -DBASE4 + else + Build-Depends: base <4 + if impl(ghc >= 6.10) + Build-Depends: base >=4 + Extensions: CPP hunk ./Setup.hs 1 +#!/usr/bin/env runhaskell module Main (main) where hunk ./Setup.hs 4 +import Data.List (isSuffixOf) +import Distribution.PackageDescription import Distribution.Simple hunk ./Setup.hs 7 +import System.Process main :: IO () hunk ./Setup.hs 10 -main = defaultMain - +main = defaultMainWithHooks (simpleUserHooks {runTests = _runTests, instHook = _instHook}) + where + -- Run all executables with names that end in -tests + _runTests _ _ pd _ = do + let exeNames = ["dist/build/" ++ fp ++ "/" ++ fp | fp <- map exeName (executables pd)] + sequence [_runTest e | e <- exeNames, isSuffixOf "-tests" e] + return () + _runTest fp = do + ph <- runCommand fp + waitForProcess ph + + -- Only install executables that don't end in -tests + _instHook pd lbi uhs ifs = do + let execs = filter (\e -> not $ isSuffixOf "-tests" (exeName e)) (executables pd) + (instHook simpleUserHooks) (pd {executables = execs}) lbi uhs ifs + hunk ./Test/HUnit.hs 1 +-- | HUnit is a unit testing framework for Haskell, inspired by the JUnit tool +-- for Java. This guide describes how to use HUnit, assuming you are familiar +-- with Haskell, though not necessarily with JUnit. +-- +-- In the Haskell module where your tests will reside, import module +-- @Test.HUnit@: +-- +-- @ +-- import Test.HUnit +-- @ +-- +-- Define test cases as appropriate: +-- +-- @ +-- test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3)) +-- test2 = TestCase (do (x,y) <- partA 3 +-- assertEqual "for the first result of partA," 5 x +-- b <- partB y +-- assertBool ("(partB " ++ show y ++ ") failed") b) +-- @ +-- +-- Name the test cases and group them together: +-- +-- @ +-- tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2] +-- @ +-- +-- Run the tests as a group. At a Haskell interpreter prompt, apply the function +-- @runTestTT@ to the collected tests. (The /TT/ suggests /T/ext orientation +-- with output to the /T/erminal.) +-- +-- @ +-- \> runTestTT tests +-- Cases: 2 Tried: 2 Errors: 0 Failures: 0 +-- \> +-- @ +-- +-- If the tests are proving their worth, you might see: +-- +-- @ +-- \> runTestTT tests +-- ### Failure in: 0:test1 +-- for (foo 3), +-- expected: (1,2) +-- but got: (1,3) +-- Cases: 2 Tried: 2 Errors: 0 Failures: 1 +-- \> +-- @ +-- +-- You can specify tests even more succinctly using operators and overloaded +-- functions that HUnit provides: +-- +-- @ +-- tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3), +-- "test2" ~: do (x, y) <- partA 3 +-- assertEqual "for the first result of partA," 5 x +-- partB y \@? "(partB " ++ show y ++ ") failed" ] +-- @ +-- +-- Assuming the same test failures as before, you would see: +-- +-- @ +-- \> runTestTT tests +-- ### Failure in: 0:test1:(foo 3) +-- expected: (1,2) +-- but got: (1,3) +-- Cases: 2 Tried: 2 Errors: 0 Failures: 1 +-- \> +-- @ + +module Test.HUnit +( + module Test.HUnit.Base, + module Test.HUnit.Text +) +where + +import Test.HUnit.Base +import Test.HUnit.Text + hunk ./Test/HUnit/Base.hs 1 +-- | Basic definitions for the HUnit library. +-- +-- This module contains what you need to create assertions and test cases and +-- combine them into test suites. +-- +-- This module also provides infrastructure for +-- implementing test controllers (which are used to execute tests). +-- See "Test.HUnit.Text" for a great example of how to implement a test +-- controller. + +module Test.HUnit.Base +( + -- ** Declaring tests + Test(..), + (~=?), (~?=), (~:), (~?), + + -- ** Making assertions + assertFailure, {- from Test.HUnit.Lang: -} + assertBool, assertEqual, assertString, + Assertion, {- from Test.HUnit.Lang: -} + (@=?), (@?=), (@?), + + -- ** Extending the assertion functionality + Assertable(..), ListAssertable(..), + AssertionPredicate, AssertionPredicable(..), + Testable(..), + + -- ** Test execution + -- $testExecutionNote + State(..), Counts(..), + Path, Node(..), + testCasePaths, + testCaseCount, + ReportStart, ReportProblem, + performTest +) +where + +import Control.Monad (unless, foldM) + + +-- Assertion Definition +-- ==================== + +import Test.HUnit.Lang + + +-- Conditional Assertion Functions +-- ------------------------------- + +-- | Asserts that the specified condition holds. +assertBool :: String -- ^ The message that is displayed if the assertion fails + -> Bool -- ^ The condition + -> Assertion +assertBool msg b = unless b (assertFailure msg) + +-- | Signals an assertion failure if a non-empty message (i.e., a message +-- other than @\"\"@) is passed. +assertString :: String -- ^ The message that is displayed with the assertion failure + -> Assertion +assertString s = unless (null s) (assertFailure s) + +-- | Asserts that the specified actual value is equal to the expected value. +-- The output message will contain the prefix, the expected value, and the +-- actual value. +-- +-- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted +-- and only the expected and actual values are output. +assertEqual :: (Eq a, Show a) => String -- ^ The message prefix + -> a -- ^ The expected value + -> a -- ^ The actual value + -> Assertion +assertEqual preface expected actual = + unless (actual == expected) (assertFailure msg) + where msg = (if null preface then "" else preface ++ "\n") ++ + "expected: " ++ show expected ++ "\n but got: " ++ show actual + + +-- Overloaded `assert` Function +-- ---------------------------- + +-- | Allows the extension of the assertion mechanism. +-- +-- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions, +-- there is a fair amount of flexibility of what can be achieved. As a rule, +-- the resulting @Assertion@ should be the body of a 'TestCase' or part of +-- a @TestCase@; it should not be used to assert multiple, independent +-- conditions. +-- +-- If more complex arrangements of assertions are needed, 'Test's and +-- 'Testable' should be used. +class Assertable t + where assert :: t -> Assertion + +instance Assertable () + where assert = return + +instance Assertable Bool + where assert = assertBool "" + +instance (ListAssertable t) => Assertable [t] + where assert = listAssert + +instance (Assertable t) => Assertable (IO t) + where assert = (>>= assert) + +-- | A specialized form of 'Assertable' to handle lists. +class ListAssertable t + where listAssert :: [t] -> Assertion + +instance ListAssertable Char + where listAssert = assertString + + +-- Overloaded `assertionPredicate` Function +-- ---------------------------------------- + +-- | The result of an assertion that hasn't been evaluated yet. +-- +-- Most test cases follow the following steps: +-- +-- 1. Do some processing or an action. +-- +-- 2. Assert certain conditions. +-- +-- However, this flow is not always suitable. @AssertionPredicate@ allows for +-- additional steps to be inserted without the initial action to be affected +-- by side effects. Additionally, clean-up can be done before the test case +-- has a chance to end. A potential work flow is: +-- +-- 1. Write data to a file. +-- +-- 2. Read data from a file, evaluate conditions. +-- +-- 3. Clean up the file. +-- +-- 4. Assert that the side effects of the read operation meet certain conditions. +-- +-- 5. Assert that the conditions evaluated in step 2 are met. +type AssertionPredicate = IO Bool + +-- | Used to signify that a data type can be converted to an assertion +-- predicate. +class AssertionPredicable t + where assertionPredicate :: t -> AssertionPredicate + +instance AssertionPredicable Bool + where assertionPredicate = return + +instance (AssertionPredicable t) => AssertionPredicable (IO t) + where assertionPredicate = (>>= assertionPredicate) + + +-- Assertion Construction Operators +-- -------------------------------- + +infix 1 @?, @=?, @?= + +-- | Asserts that the condition obtained from the specified +-- 'AssertionPredicable' holds. +(@?) :: (AssertionPredicable t) => t -- ^ A value of which the asserted condition is predicated + -> String -- ^ A message that is displayed if the assertion fails + -> Assertion +pred @? msg = assertionPredicate pred >>= assertBool msg + +-- | Asserts that the specified actual value is equal to the expected value +-- (with the expected value on the left-hand side). +(@=?) :: (Eq a, Show a) => a -- ^ The expected value + -> a -- ^ The actual value + -> Assertion +expected @=? actual = assertEqual "" expected actual + +-- | Asserts that the specified actual value is equal to the expected value +-- (with the actual value on the left-hand side). +(@?=) :: (Eq a, Show a) => a -- ^ The actual value + -> a -- ^ The expected value + -> Assertion +actual @?= expected = assertEqual "" expected actual + + + +-- Test Definition +-- =============== + +-- | The basic structure used to create an annotated tree of test cases. +data Test + -- | A single, independent test case composed. + = TestCase Assertion + -- | A set of @Test@s sharing the same level in the hierarchy. + | TestList [Test] + -- | A name or description for a subtree of the @Test@s. + | TestLabel String Test + +instance Show Test where + showsPrec p (TestCase _) = showString "TestCase _" + showsPrec p (TestList ts) = showString "TestList " . showList ts + showsPrec p (TestLabel l t) = showString "TestLabel " . showString l + . showChar ' ' . showsPrec p t + +-- Overloaded `test` Function +-- -------------------------- + +-- | Provides a way to convert data into a @Test@ or set of @Test@. +class Testable t + where test :: t -> Test + +instance Testable Test + where test = id + +instance (Assertable t) => Testable (IO t) + where test = TestCase . assert + +instance (Testable t) => Testable [t] + where test = TestList . map test + + +-- Test Construction Operators +-- --------------------------- + +infix 1 ~?, ~=?, ~?= +infixr 0 ~: + +-- | Creates a test case resulting from asserting the condition obtained +-- from the specified 'AssertionPredicable'. +(~?) :: (AssertionPredicable t) => t -- ^ A value of which the asserted condition is predicated + -> String -- ^ A message that is displayed on test failure + -> Test +pred ~? msg = TestCase (pred @? msg) + +-- | Shorthand for a test case that asserts equality (with the expected +-- value on the left-hand side, and the actual value on the right-hand +-- side). +(~=?) :: (Eq a, Show a) => a -- ^ The expected value + -> a -- ^ The actual value + -> Test +expected ~=? actual = TestCase (expected @=? actual) + +-- | Shorthand for a test case that asserts equality (with the actual +-- value on the left-hand side, and the expected value on the right-hand +-- side). +(~?=) :: (Eq a, Show a) => a -- ^ The actual value + -> a -- ^ The expected value + -> Test +actual ~?= expected = TestCase (actual @?= expected) + +-- | Creates a test from the specified 'Testable', with the specified +-- label attached to it. +-- +-- Since 'Test' is @Testable@, this can be used as a shorthand way of attaching +-- a 'TestLabel' to one or more tests. +(~:) :: (Testable t) => String -> t -> Test +label ~: t = TestLabel label (test t) + + + +-- Test Execution +-- ============== + +-- $testExecutionNote +-- Note: the rest of the functionality in this module is intended for +-- implementors of test controllers. If you just want to run your tests cases, +-- simply use a test controller, such as the text-based controller in +-- "Test.HUnit.Text". + +-- | A data structure that hold the results of tests that have been performed +-- up until this point. +data Counts = Counts { cases, tried, errors, failures :: Int } + deriving (Eq, Show, Read) + +-- | Keeps track of the remaining tests and the results of the performed tests. +-- As each test is performed, the path is removed and the counts are +-- updated as appropriate. +data State = State { path :: Path, counts :: Counts } + deriving (Eq, Show, Read) + +-- | Report generator for reporting the start of a test run. +type ReportStart us = State -> us -> IO us + +-- | Report generator for reporting problems that have occurred during +-- a test run. Problems may be errors or assertion failures. +type ReportProblem us = String -> State -> us -> IO us + +-- | Uniquely describes the location of a test within a test hierarchy. +-- Node order is from test case to root. +type Path = [Node] + +-- | Composed into 'Path's. +data Node = ListItem Int | Label String + deriving (Eq, Show, Read) + +-- | Determines the paths for all 'TestCase's in a tree of @Test@s. +testCasePaths :: Test -> [Path] +testCasePaths t = tcp t [] + where tcp (TestCase _) p = [p] + tcp (TestList ts) p = + concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ] + tcp (TestLabel l t) p = tcp t (Label l : p) + +-- | Counts the number of 'TestCase's in a tree of @Test@s. +testCaseCount :: Test -> Int +testCaseCount (TestCase _) = 1 +testCaseCount (TestList ts) = sum (map testCaseCount ts) +testCaseCount (TestLabel _ t) = testCaseCount t + +-- | Performs a test run with the specified report generators. +-- +-- This handles the actual running of the tests. Most developers will want +-- to use @HUnit.Text.runTestTT@ instead. A developer could use this function +-- to execute tests via another IO system, such as a GUI, or to output the +-- results in a different manner (e.g., upload XML-formatted results to a +-- webservice). +-- +-- Note that the counts in a start report do not include the test case +-- being started, whereas the counts in a problem report do include the +-- test case just finished. The principle is that the counts are sampled +-- only between test case executions. As a result, the number of test +-- case successes always equals the difference of test cases tried and +-- the sum of test case errors and failures. +performTest :: ReportStart us -- ^ report generator for the test run start + -> ReportProblem us -- ^ report generator for errors during the test run + -> ReportProblem us -- ^ report generator for assertion failures during the test run + -> us + -> Test -- ^ the test to be executed + -> IO (Counts, us) +performTest reportStart reportError reportFailure us t = do + (ss', us') <- pt initState us t + unless (null (path ss')) $ error "performTest: Final path is nonnull" + return (counts ss', us') + where + initState = State{ path = [], counts = initCounts } + initCounts = Counts{ cases = testCaseCount t, tried = 0, + errors = 0, failures = 0} + + pt ss us (TestCase a) = do + us' <- reportStart ss us + r <- performTestCase a + case r of Nothing -> do return (ss', us') + Just (True, m) -> do usF <- reportFailure m ssF us' + return (ssF, usF) + Just (False, m) -> do usE <- reportError m ssE us' + return (ssE, usE) + where c@Counts{ tried = t } = counts ss + ss' = ss{ counts = c{ tried = t + 1 } } + ssF = ss{ counts = c{ tried = t + 1, failures = failures c + 1 } } + ssE = ss{ counts = c{ tried = t + 1, errors = errors c + 1 } } + + pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..]) + where f (ss, us) (t, n) = withNode (ListItem n) ss us t + + pt ss us (TestLabel label t) = withNode (Label label) ss us t + + withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t + return (ss2{ path = path0 }, us1) + where path0 = path ss0 + ss1 = ss0{ path = node : path0 } hunk ./Test/HUnit/Lang.hs 1 +-- | This module abstracts the differences between implementations of +-- Haskell (e.g., GHC, Hugs, and NHC). + +module Test.HUnit.Lang +( + Assertion, + assertFailure, + performTestCase +) +where + + +-- When adapting this module for other Haskell language systems, change +-- the imports and the implementations but not the interfaces. + + + +-- Imports +-- ------- + +import Data.List (isPrefixOf) +#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +import Data.Dynamic +import Control.Exception as E +#else +import System.IO.Error (ioeGetErrorString, try) +#endif + + + +-- Interfaces +-- ---------- + +-- | When an assertion is evaluated, it will output a message if and only if the +-- assertion fails. +-- +-- Test cases are composed of a sequence of one or more assertions. + +type Assertion = IO () + +-- | Unconditionally signals that a failure has occured. All +-- other assertions can be expressed with the form: +-- +-- @ +-- if conditionIsMet +-- then IO () +-- else assertFailure msg +-- @ + +assertFailure :: String -- ^ A message that is displayed with the assertion failure + -> Assertion + +-- | Performs a single test case. The meaning of the result is as follows: +-- +-- [@Nothing@] test case success +-- +-- [@Just (True, msg)@] test case failure with the given message +-- +-- [@Just (False, msg)@] test case error with the given message + +performTestCase :: Assertion -- ^ an assertion to be made during the test case run + -> IO (Maybe (Bool, String)) + + +-- Implementations +-- --------------- + +#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +data HUnitFailure = HUnitFailure String + deriving Show + +hunitFailureTc :: TyCon +hunitFailureTc = mkTyCon "HUnitFailure" +{-# NOINLINE hunitFailureTc #-} + +instance Typeable HUnitFailure where + typeOf _ = mkTyConApp hunitFailureTc [] +#ifdef BASE4 +instance Exception HUnitFailure + +assertFailure msg = E.throw (HUnitFailure msg) + +performTestCase action = + do action + return Nothing + `E.catches` + [E.Handler (\(HUnitFailure msg) -> return $ Just (True, msg)), + E.Handler (\e -> return $ Just (False, show (e :: E.SomeException)))] +#else +assertFailure msg = E.throwDyn (HUnitFailure msg) + +performTestCase action = + do r <- E.try action + case r of + Right () -> return Nothing + Left e@(E.DynException dyn) -> + case fromDynamic dyn of + Just (HUnitFailure msg) -> return $ Just (True, msg) + Nothing -> return $ Just (False, show e) + Left e -> return $ Just (False, show e) +#endif +#else +hunitPrefix = "HUnit:" + +nhc98Prefix = "I/O error (user-defined), call to function `userError':\n " + +assertFailure msg = ioError (userError (hunitPrefix ++ msg)) + +performTestCase action = do r <- try action + case r of Right () -> return Nothing + Left e -> return (Just (decode e)) + where + decode e = let s0 = ioeGetErrorString e + (_, s1) = dropPrefix nhc98Prefix s0 + in dropPrefix hunitPrefix s1 + dropPrefix pref str = if pref `isPrefixOf` str + then (True, drop (length pref) str) + else (False, str) +#endif hunk ./Test/HUnit/Terminal.hs 1 +-- | This module handles the complexities of writing information to the +-- terminal, including modifying text in place. + +module Test.HUnit.Terminal ( + terminalAppearance + ) where + +import Data.Char (isPrint) + + +-- | Simplifies the input string by interpreting @\\r@ and @\\b@ characters +-- specially so that the result string has the same final (or /terminal/, +-- pun intended) appearance as would the input string when written to a +-- terminal that overwrites character positions following carriage +-- returns and backspaces. + +terminalAppearance :: String -> String +terminalAppearance str = ta id "" "" str + +-- | The helper function @ta@ takes an accumulating @ShowS@-style function +-- that holds /committed/ lines of text, a (reversed) list of characters +-- on the current line /before/ the cursor, a (normal) list of characters +-- on the current line /after/ the cursor, and the remaining input. + +ta + :: ([Char] -> t) -- ^ An accumulating @ShowS@-style function + -- that holds /committed/ lines of text + -> [Char] -- ^ A (reversed) list of characters + -- on the current line /before/ the cursor + -> [Char] -- ^ A (normal) list of characters + -- on the current line /after/ the cursor + -> [Char] -- ^ The remaining input + -> t +ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs +ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs +ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs +ta _ "" _ ('\b': _) = error "'\\b' at beginning of line" +ta f bs as (c:cs) + | not (isPrint c) = error "invalid nonprinting character" + | null as = ta f (c:bs) "" cs + | otherwise = ta f (c:bs) (tail as) cs +ta f bs as "" = f (reverse bs ++ as) hunk ./Test/HUnit/Text.hs 1 +-- | Text-based test controller for running HUnit tests and reporting +-- results as text, usually to a terminal. + +module Test.HUnit.Text +( + PutText(..), + putTextToHandle, putTextToShowS, + runTestText, + showPath, showCounts, + runTestTT +) +where + +import Test.HUnit.Base + +import Control.Monad (when) +import System.IO (Handle, stderr, hPutStr, hPutStrLn) + + +-- | As the general text-based test controller ('runTestText') executes a +-- test, it reports each test case start, error, and failure by +-- constructing a string and passing it to the function embodied in a +-- 'PutText'. A report string is known as a \"line\", although it includes +-- no line terminator; the function in a 'PutText' is responsible for +-- terminating lines appropriately. Besides the line, the function +-- receives a flag indicating the intended \"persistence\" of the line: +-- 'True' indicates that the line should be part of the final overall +-- report; 'False' indicates that the line merely indicates progress of +-- the test execution. Each progress line shows the current values of +-- the cumulative test execution counts; a final, persistent line shows +-- the final count values. +-- +-- The 'PutText' function is also passed, and returns, an arbitrary state +-- value (called 'st' here). The initial state value is given in the +-- 'PutText'; the final value is returned by 'runTestText'. + +data PutText st = PutText (String -> Bool -> st -> IO st) st + + +-- | Two reporting schemes are defined here. @putTextToHandle@ writes +-- report lines to a given handle. 'putTextToShowS' accumulates +-- persistent lines for return as a whole by 'runTestText'. +-- +-- @putTextToHandle@ writes persistent lines to the given handle, +-- following each by a newline character. In addition, if the given flag +-- is @True@, it writes progress lines to the handle as well. A progress +-- line is written with no line termination, so that it can be +-- overwritten by the next report line. As overwriting involves writing +-- carriage return and blank characters, its proper effect is usually +-- only obtained on terminal devices. + +putTextToHandle + :: Handle + -> Bool -- ^ Write progress lines to handle? + -> PutText Int +putTextToHandle handle showProgress = PutText put initCnt + where + initCnt = if showProgress then 0 else -1 + put line pers (-1) = do when pers (hPutStrLn handle line); return (-1) + put line True cnt = do hPutStrLn handle (erase cnt ++ line); return 0 + put line False cnt = do hPutStr handle ('\r' : line); return (length line) + -- The "erasing" strategy with a single '\r' relies on the fact that the + -- lengths of successive summary lines are monotonically nondecreasing. + erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" + + +-- | Accumulates persistent lines (dropping progess lines) for return by +-- 'runTestText'. The accumulated lines are represented by a +-- @'ShowS' ('String' -> 'String')@ function whose first argument is the +-- string to be appended to the accumulated report lines. + +putTextToShowS :: PutText ShowS +putTextToShowS = PutText put id + where put line pers f = return (if pers then acc f line else f) + acc f line tail = f (line ++ '\n' : tail) + + +-- | Executes a test, processing each report line according to the given +-- reporting scheme. The reporting scheme's state is threaded through calls +-- to the reporting scheme's function and finally returned, along with final +-- count values. + +runTestText :: PutText st -> Test -> IO (Counts, st) +runTestText (PutText put us) t = do + (counts, us') <- performTest reportStart reportError reportFailure us t + us'' <- put (showCounts counts) True us' + return (counts, us'') + where + reportStart ss us = put (showCounts (counts ss)) False us + reportError = reportProblem "Error:" "Error in: " + reportFailure = reportProblem "Failure:" "Failure in: " + reportProblem p0 p1 msg ss us = put line True us + where line = "### " ++ kind ++ path' ++ '\n' : msg + kind = if null path' then p0 else p1 + path' = showPath (path ss) + + +-- | Converts test execution counts to a string. + +showCounts :: Counts -> String +showCounts Counts{ cases = cases, tried = tried, + errors = errors, failures = failures } = + "Cases: " ++ show cases ++ " Tried: " ++ show tried ++ + " Errors: " ++ show errors ++ " Failures: " ++ show failures + + +-- | Converts a test case path to a string, separating adjacent elements by +-- the colon (\':\'). An element of the path is quoted (as with 'show') when +-- there is potential ambiguity. + +showPath :: Path -> String +showPath [] = "" +showPath nodes = foldl1 f (map showNode nodes) + where f b a = a ++ ":" ++ b + showNode (ListItem n) = show n + showNode (Label label) = safe label (show label) + safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s + + +-- | Provides the \"standard\" text-based test controller. Reporting is made to +-- standard error, and progress reports are included. For possible +-- programmatic use, the final counts are returned. +-- +-- The \"TT\" in the name suggests \"Text-based reporting to the Terminal\". + +runTestTT :: Test -> IO Counts +runTestTT t = do (counts, 0) <- runTestText (putTextToHandle stderr True) t + return counts hunk ./doc/Guide.html 1 - - - - - - - - HUnit 1.0 User's Guide - - + + + + + + + HUnit 1.0 User's Guide + + hunk ./doc/Guide.html 13 -

HUnit 1.0 User's Guide

+

HUnit 1.2 User's Guide

hunk ./doc/Guide.html 15 -HUnit is a unit testing framework for Haskell, inspired by the JUnit -tool for Java. This guide describes how to use HUnit, assuming -you are familiar with Haskell, though not necessarily with -JUnit. You can obtain HUnit, including this guide, at -http://hunit.sourceforge.net. +

HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java. This + guide describes how to use HUnit, assuming you are familiar with Haskell, though not + necessarily with JUnit. You can obtain HUnit, including this guide, at http://code.haskell.org/HUnit.

hunk ./doc/Guide.html 20 -

Introduction

+

Introduction

hunk ./doc/Guide.html 22 -A test-centered methodology for software development is most effective -when tests are easy to create, change, and execute. The JUnit tool pioneered support for -test-first development in Java. -HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely -functional programming language. (To learn more about Haskell, -see http://www.haskell.org.) -

-With HUnit, as with JUnit, you can easily create tests, name them, -group them into suites, and execute them, with the framework checking -the results automatically. Test specification in HUnit is even -more concise and flexible than in JUnit, thanks to the nature of the -Haskell language. HUnit currently includes only a text-based -test controller, but the framework is designed for easy -extension. (Would anyone care to write a graphical test -controller for HUnit?) -

-The next section helps you get started using HUnit in simple -ways. Subsequent sections give details on writing tests and running tests. The document concludes -with a section describing HUnit's constituent files and a section giving -references to further information. +

A test-centered methodology for software development is most effective when tests are + easy to create, change, and execute. The JUnit tool + pioneered support for test-first development in Java. + HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely functional + programming language. (To learn more about Haskell, see http://www.haskell.org.)

hunk ./doc/Guide.html 29 -

Getting Started

+

With HUnit, as with JUnit, you can easily create tests, name them, group them into + suites, and execute them, with the framework checking the results automatically. Test + specification in HUnit is even more concise and flexible than in JUnit, thanks to the + nature of the Haskell language. HUnit currently includes only a text-based test + controller, but the framework is designed for easy extension. (Would anyone care to + write a graphical test controller for HUnit?)

hunk ./doc/Guide.html 36 -In the Haskell module where your tests will reside, import module -Test.HUnit: -
+        
The next section helps you get started using HUnit in simple ways. Subsequent sections
+            give details on writing tests and running tests. The document concludes with a section describing HUnit's constituent files and a section giving references to further information.

+
+        
Getting Started

+
+        
In the Haskell module where your tests will reside, import module Test.HUnit:

+        
     import Test.HUnit
 

hunk ./doc/Guide.html 48
-Define test cases as appropriate:
-
+        
Define test cases as appropriate:

+        
     test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3))
     test2 = TestCase (do (x,y) <- partA 3
                          assertEqual "for the first result of partA," 5 x
hunk ./doc/Guide.html 56
                          b <- partB y
                          assertBool ("(partB " ++ show y ++ ") failed") b)
 

-Name the test cases and group them together:
-
+        
Name the test cases and group them together:

+        
     tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]
 

hunk ./doc/Guide.html 60
-Run the tests as a group. At a Haskell interpreter prompt, apply
-the function runTestTT to the collected tests. (The
-"TT" suggests text orientation with output to
-the terminal.)
-
+        
Run the tests as a group. At a Haskell interpreter prompt, apply the function
+                runTestTT to the collected tests. (The "TT" suggests
+            Text orientation with output to the Terminal.)

+        
     > runTestTT tests
     Cases: 2  Tried: 2  Errors: 0  Failures: 0
     >
hunk ./doc/Guide.html 68
 

-If the tests are proving their worth, you might see:
-
+        
If the tests are proving their worth, you might see:

+        
     > runTestTT tests
     ### Failure in: 0:test1
     for (foo 3),
hunk ./doc/Guide.html 78
     Cases: 2  Tried: 2  Errors: 0  Failures: 1
     >
 

-Isn't that easy?
-

-You can specify tests even more succinctly using operators and
-overloaded functions that HUnit provides:
-
+        
Isn't that easy?

+
+        
You can specify tests even more succinctly using operators and overloaded functions that
+            HUnit provides:

+        
     tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3),
                    "test2" ~: do (x, y) <- partA 3
                                  assertEqual "for the first result of partA," 5 x
hunk ./doc/Guide.html 88
                                  partB y @? "(partB " ++ show y ++ ") failed" ]
 

-Assuming the same test failures as before, you would see:
-
+        
Assuming the same test failures as before, you would see:

+        
     > runTestTT tests
     ### Failure in: 0:test1:(foo 3)
     expected: (1,2)
hunk ./doc/Guide.html 98
     >
 

 
-
Writing Tests

+        
Writing Tests

 
hunk ./doc/Guide.html 100
-Tests are specified compositionally. Assertions are combined to make a test case, and test cases are combined into tests. HUnit also provides advanced features for more convenient
-test specification.
+        
Tests are specified compositionally. Assertions are combined to
+            make a test case, and test cases are combined into tests. HUnit also provides advanced
+                features for more convenient test specification.

 
hunk ./doc/Guide.html 105
-
Assertions

+        
Assertions

 
hunk ./doc/Guide.html 107
-The basic building block of a test is an assertion.
-
+        
The basic building block of a test is an assertion.

+        
     type Assertion = IO ()
 

hunk ./doc/Guide.html 111
-An assertion is an IO computation that always produces a void
-result. Why is an assertion an IO computation?  So that
-programs with real-world side effects can be tested. How does an
-assertion assert anything if it produces no useful result?  The answer
-is that an assertion can signal failure by calling
-assertFailure.
-
+        
An assertion is an IO computation that always produces a void result. Why is an
+            assertion an IO computation? So that programs with real-world side effects can
+            be tested. How does an assertion assert anything if it produces no useful result? The
+            answer is that an assertion can signal failure by calling assertFailure.

+        
     assertFailure :: String -> Assertion
     assertFailure msg = ioError (userError ("HUnit:" ++ msg))
 

hunk ./doc/Guide.html 119
-(assertFailure msg) raises an exception. The string
-argument identifies the failure. The failure message is prefixed
-by "HUnit:" to mark it as an HUnit assertion failure
-message. The HUnit test framework interprets such an exception
-as indicating failure of the test whose execution raised the
-exception. (Note: The details concerning the implementation of
-assertFailure are subject to change and should not be relied
-upon.)
-

-assertFailure can be used directly, but it is much more
-common to use it indirectly through other assertion functions that
-conditionally assert failure.
-
+        
(assertFailure msg) raises an exception. The string argument identifies the
+            failure. The failure message is prefixed by "HUnit:" to mark it as an HUnit
+            assertion failure message. The HUnit test framework interprets such an exception as
+            indicating failure of the test whose execution raised the exception. (Note: The details
+            concerning the implementation of assertFailure are subject to change and should
+            not be relied upon.)

+
+        
assertFailure can be used directly, but it is much more common to use it
+            indirectly through other assertion functions that conditionally assert failure.

+        
     assertBool :: String -> Bool -> Assertion
     assertBool msg b = unless b (assertFailure msg)
 
hunk ./doc/Guide.html 141
      where msg = (if null preface then "" else preface ++ "\n") ++
                  "expected: " ++ show expected ++ "\n but got: " ++ show actual
 

-With assertBool you give the assertion condition and failure
-message separately. With assertString the two are
-combined. With assertEqual you provide a "preface", an
-expected value, and an actual value; the failure message shows the two
-unequal values and is prefixed by the preface. Additional ways
-to create assertions are described later under Advanced Features.
-

-Since assertions are IO computations, they may be
-combined--along with other IO computations--using
-(>>=), (>>), and the do notation. As
-long as its result is of type (IO ()), such a combination
-constitutes a single, collective assertion, incorporating any number
-of constituent assertions. The important features of such a
-collective assertion are that it fails if any of its constituent
-assertions is executed and fails, and that the first constituent
-assertion to fail terminates execution of the collective
-assertion. Such behavior is essential to specifying a test case.
+        
With assertBool you give the assertion condition and failure message separately.
+            With assertString the two are combined. With assertEqual you provide a
+            "preface", an expected value, and an actual value; the failure message shows the two
+            unequal values and is prefixed by the preface. Additional ways to create assertions are
+            described later under Advanced Features.

+
+        
Since assertions are IO computations, they may be combined--along with other
+                IO computations--using (>>=), (>>), and the do
+            notation. As long as its result is of type (IO ()), such a combination
+            constitutes a single, collective assertion, incorporating any number of constituent
+            assertions. The important features of such a collective assertion are that it fails if
+            any of its constituent assertions is executed and fails, and that the first constituent
+            assertion to fail terminates execution of the collective assertion. Such behavior is
+            essential to specifying a test case.

+
+        
Test Case

+
+        
A test case is the unit of test execution. That is, distinct test cases are
+            executed independently. The failure of one is independent of the failure of any other.

 
hunk ./doc/Guide.html 161
-
Test Case

+        
A test case consists of a single, possibly collective, assertion. The possibly multiple
+            constituent assertions in a test case's collective assertion are not independent.
+            Their interdependence may be crucial to specifying correct operation for a test. A test
+            case may involve a series of steps, each concluding in an assertion, where each step
+            must succeed in order for the test case to continue. As another example, a test may
+            require some "set up" to be performed that must be undone ("torn down" in JUnit
+            parlance) once the test is complete. In this case, you could use Haskell's
+                IO.bracket function to achieve the desired effect.

 
hunk ./doc/Guide.html 170
-A test case is the unit of test execution. That is,
-distinct test cases are executed independently. The failure of
-one is independent of the failure of any other.
-

-A test case consists of a single, possibly collective,
-assertion. The possibly multiple constituent assertions in a
-test case's collective assertion are not independent.
-Their interdependence may be crucial to specifying correct operation
-for a test. A test case may involve a series of steps, each
-concluding in an assertion, where each step must succeed in order for
-the test case to continue. As another example, a test may
-require some "set up" to be performed that must be undone ("torn down"
-in JUnit parlance) once the test is complete. In this case, you
-could use Haskell's IO.bracket function to achieve the
-desired effect.
-

-You can make a test case from an assertion by applying the
-TestCase constructor. For example,
-(TestCase (return ())) is a test case that never
-fails, and
-(TestCase (assertEqual "for x," 3 x))
-is a test case that checks that the value of x is 3. 
-Additional ways to create test cases are described later under
-Advanced Features.
+        
You can make a test case from an assertion by applying the TestCase constructor.
+            For example, (TestCase (return ())) is a test case that never
+            fails, and
+                (TestCase (assertEqual "for x," 3 x))
+            is a test case that checks that the value of x is 3.  Additional ways
+            to create test cases are described later under Advanced
+                Features.

 
hunk ./doc/Guide.html 178
-
Tests

+        
Tests

 
hunk ./doc/Guide.html 180
-As soon as you have more than one test, you'll want to name them to
-tell them apart. As soon as you have more than several tests,
-you'll want to group them to process them more easily. So,
-naming and grouping are the two keys to managing collections of tests.
-

-In tune with the "composite" design pattern [1], a test is defined as a package
-of test cases. Concretely, a test is either a single test case,
-a group of tests, or either of the first two identified by a label.
-
+        
As soon as you have more than one test, you'll want to name them to tell them apart. As
+            soon as you have more than several tests, you'll want to group them to process them more
+            easily. So, naming and grouping are the two keys to managing collections of tests.

+
+        
In tune with the "composite" design pattern [1], a
+            test is defined as a package of test cases. Concretely, a test is either a single
+            test case, a group of tests, or either of the first two identified by a label.

+        
     data Test = TestCase Assertion
               | TestList [Test]
               | TestLabel String Test
hunk ./doc/Guide.html 192
 

-There are three important features of this definition to note:
-
    
-
  • 
-A TestList consists of a list of tests rather than a list of
-test cases. This means that the structure of a Test is
-actually a tree. Using a hierarchy helps organize tests just as
-it helps organize files in a file system.
-
    • 
-
  • 
-A TestLabel is attached to a test rather than to a test
-case. This means that all nodes in the test tree, not just test
-case (leaf) nodes, can be labeled. Hierarchical naming helps
-organize tests just as it helps organize files in a file system.
-
    • 
-
  • 
-A TestLabel is separate from both TestCase and
-TestList. This means that labeling is optional
-everywhere in the tree. Why is this a good thing?  Because of
-the hierarchical structure of a test, each constituent test case is
-uniquely identified by its path in the tree, ignoring all
-labels. Sometimes a test case's path (or perhaps its subpath
-below a certain node) is a perfectly adequate "name" for the test case
-(perhaps relative to a certain node). In this case, creating a
-label for the test case is both unnecessary and inconvenient.
-
    • 
-

-

-The number of test cases that a test comprises can be computed with
-testCaseCount.
-
+        
There are three important features of this definition to note:

+        
    
+            
  • A TestList consists of a list of tests rather than a list of test cases.
+                This means that the structure of a Test is actually a tree. Using a
+                hierarchy helps organize tests just as it helps organize files in a file system.
    • 
+            
  • A TestLabel is attached to a test rather than to a test case. This means
+                that all nodes in the test tree, not just test case (leaf) nodes, can be labeled.
+                Hierarchical naming helps organize tests just as it helps organize files in a file
+                system.
    • 
+            
  • A TestLabel is separate from both TestCase and TestList.
+                This means that labeling is optional everywhere in the tree. Why is this a good
+                thing? Because of the hierarchical structure of a test, each constituent test case
+                is uniquely identified by its path in the tree, ignoring all labels. Sometimes a
+                test case's path (or perhaps its subpath below a certain node) is a perfectly
+                adequate "name" for the test case (perhaps relative to a certain node). In this
+                case, creating a label for the test case is both unnecessary and inconvenient.
    • 
+        

+        
The number of test cases that a test comprises can be computed with
+            testCaseCount.

+        
     testCaseCount :: Test -> Int
 

hunk ./doc/Guide.html 214
-

-As mentioned above, a test is identified by its path in the
-test hierarchy.
-
+        
As mentioned above, a test is identified by its path in the test hierarchy.

+        
     data Node  = ListItem Int | Label String
       deriving (Eq, Show, Read)
 
hunk ./doc/Guide.html 221
     type Path = [Node]    -- Node order is from test case to root.
 

-Each occurrence of TestList gives rise to a ListItem
-and each occurrence of TestLabel gives rise to a
-Label. The ListItems by themselves ensure
-uniqueness among test case paths, while the Labels allow you
-to add mnemonic names for individual test cases and collections of
-them.
-

-Note that the order of nodes in a path is reversed from what you might
-expect: The first node in the list is the one deepest in the
-tree. This order is a concession to efficiency: It allows common
-path prefixes to be shared.
-

-The paths of the test cases that a test comprises can be computed with
-testCasePaths. The paths are listed in the order in
-which the corresponding test cases would be executed.
-
+        
Each occurrence of TestList gives rise to a ListItem and each
+            occurrence of TestLabel gives rise to a Label. The ListItems
+            by themselves ensure uniqueness among test case paths, while the Labels allow
+            you to add mnemonic names for individual test cases and collections of them.

+
+        
Note that the order of nodes in a path is reversed from what you might expect: The first
+            node in the list is the one deepest in the tree. This order is a concession to
+            efficiency: It allows common path prefixes to be shared.

+
+        
The paths of the test cases that a test comprises can be computed with
+            testCasePaths. The paths are listed in the order in which the corresponding
+            test cases would be executed.

+        
     testCasePaths :: Test -> [Path]
 

hunk ./doc/Guide.html 236
-

-The three variants of Test can be constructed simply by
-applying TestCase, TestList, and TestLabel
-to appropriate arguments. Additional ways to create tests are
-described later under Advanced
-Features.
-

-The design of the type Test provides great conciseness,
-flexibility, and convenience in specifying tests. Moreover, the
-nature of Haskell significantly augments these qualities:
-
    
-
  • 
-Combining assertions and other code to construct test cases is easy
-with the IO monad.
-
    • 
-
  • 
-Using overloaded functions and special operators (see below),
-specification of assertions and tests is extremely compact.
-
    • 
-
  • 
-Structuring a test tree by value, rather than by name as in JUnit,
-provides for more convenient, flexible, and robust test suite
-specification. In particular, a test suite can more easily be
-computed "on the fly" than in other test frameworks.
-
    • 
-
  • 
-Haskell's powerful abstraction facilities provide unmatched support
-for test refactoring.
-
    • 
-

 
hunk ./doc/Guide.html 237
-
Advanced Features

+        
The three variants of Test can be constructed simply by applying
+            TestCase, TestList, and TestLabel to appropriate arguments.
+            Additional ways to create tests are described later under Advanced Features.

+
+        
The design of the type Test provides great conciseness, flexibility, and
+            convenience in specifying tests. Moreover, the nature of Haskell significantly augments
+            these qualities:

+        
    
+            
  • Combining assertions and other code to construct test cases is easy with the
+                IO monad.
    • 
+            
  • Using overloaded functions and special operators (see below), specification of
+                assertions and tests is extremely compact.
    • 
+            
  • Structuring a test tree by value, rather than by name as in JUnit, provides for more
+                convenient, flexible, and robust test suite specification. In particular, a test
+                suite can more easily be computed "on the fly" than in other test frameworks.
    • 
+            
  • Haskell's powerful abstraction facilities provide unmatched support for test
+                refactoring.
    • 
+        

+
+        
Advanced Features

+
+        
HUnit provides additional features for specifying assertions and tests more conveniently
+            and concisely. These facilities make use of Haskell type classes.

 
hunk ./doc/Guide.html 262
-HUnit provides additional features for specifying assertions and tests
-more conveniently and concisely. These facilities make use of
-Haskell type classes.
-

-The following operators can be used to construct assertions.
-
+        
The following operators can be used to construct assertions.

+        
     infix 1 @?, @=?, @?=
 
     (@?) :: (AssertionPredicable t) => t -> String -> Assertion
hunk ./doc/Guide.html 275
     (@?=) :: (Eq a, Show a) => a -> a -> Assertion
     actual @?= expected = assertEqual "" expected actual
 

-You provide a boolean condition and failure message separately to
-(@?), as for assertBool, but in a different
-order. The (@=?) and (@?=) operators provide
-shorthands for assertEqual when no preface is required.
-They differ only in the order in which the expected and actual values
-are provided. (The actual value--the uncertain one--goes on the
-"?" side of the operator.)
-

-The (@?) operator's first argument is something from which an
-assertion predicate can be made, that is, its type must be
-AssertionPredicable.
-
+        
You provide a boolean condition and failure message separately to (@?), as for
+                assertBool, but in a different order. The (@=?) and (@?=)
+            operators provide shorthands for assertEqual when no preface is required. They
+            differ only in the order in which the expected and actual values are provided. (The
+            actual value--the uncertain one--goes on the "?" side of the operator.)

+
+        
The (@?) operator's first argument is something from which an assertion
+            predicate can be made, that is, its type must be AssertionPredicable.

+        
     type AssertionPredicate = IO Bool
 
     class AssertionPredicable t
hunk ./doc/Guide.html 295
     instance (AssertionPredicable t) => AssertionPredicable (IO t)
      where assertionPredicate = (>>= assertionPredicate)
 

-The overloaded assert function in the Assertable
-type class constructs an assertion.
-
+        
The overloaded assert function in the Assertable type class constructs
+            an assertion.

+        
     class Assertable t
      where assert :: t -> Assertion
 
hunk ./doc/Guide.html 313
     instance (Assertable t) => Assertable (IO t)
      where assert = (>>= assert)
 

-The ListAssertable class allows assert to be applied
-to [Char] (that is, String).
-
+        
The ListAssertable class allows assert to be applied to [Char]
+            (that is, String).

+        
     class ListAssertable t
      where listAssert :: [t] -> Assertion
 
hunk ./doc/Guide.html 322
     instance ListAssertable Char
      where listAssert = assertString
 

-With the above declarations, (assert ()),
-(assert True), and (assert "") (as well as
-IO forms of these values, such as (return ()))
-are all assertions that never fail, while (assert False)
-and (assert "some failure message") (and their
-IO forms) are assertions that always fail. You may
-define additional instances for the type classes Assertable,
-ListAssertable, and AssertionPredicable if that
-should be useful in your application.
-

-The overloaded test function in the Testable type
-class constructs a test.
-
+        
With the above declarations, (assert ()),
+            (assert True), and (assert "") (as well as
+            IO forms of these values, such as (return ())) are all
+            assertions that never fail, while (assert False) and
+                (assert "some failure message") (and their
+                IO forms) are assertions that always fail. You may define additional
+            instances for the type classes Assertable, ListAssertable, and
+                AssertionPredicable if that should be useful in your application.

+
+        
The overloaded test function in the Testable type class constructs a
+            test.

+        
     class Testable t
      where test :: t -> Test
 
hunk ./doc/Guide.html 346
     instance (Testable t) => Testable [t]
      where test = TestList . map test
 

-The test function makes a test from either an
-Assertion (using TestCase), a list of
-Testable items (using TestList), or a Test
-(making no change).
-

-The following operators can be used to construct tests.
-
+        
The test function makes a test from either an Assertion (using
+                TestCase), a list of Testable items (using TestList), or
+            a Test (making no change).

+
+        
The following operators can be used to construct tests.

+        
     infix  1 ~?, ~=?, ~?=
     infixr 0 ~:
 
hunk ./doc/Guide.html 367
     (~:) :: (Testable t) => String -> t -> Test
     label ~: t = TestLabel label (test t)
 

-(~?), (~=?), and (~?=) each make an
-assertion, as for (@?), (@=?), and (@?=),
-respectively, and then a test case from that assertion.
-(~:) attaches a label to something that is
-Testable. You may define additional instances for the
-type class Testable should that be useful.
+        
(~?), (~=?), and (~?=) each make an assertion, as for
+            (@?), (@=?), and (@?=), respectively, and then a test case
+            from that assertion. (~:) attaches a label to something that is
+            Testable. You may define additional instances for the type class
+            Testable should that be useful.

+
+        
Running Tests

 
hunk ./doc/Guide.html 375
-
Running Tests

+        
HUnit is structured to support multiple test controllers. The first subsection below
+            describes the test execution characteristics common to all
+            test controllers. The second subsection describes the text-based controller that is included with HUnit.

 
hunk ./doc/Guide.html 380
-HUnit is structured to support multiple test controllers. The
-first subsection below describes the test
-execution characteristics common to all test controllers.
-The second subsection describes the
-text-based controller that is
-included with HUnit.
+        
Test Execution

 
hunk ./doc/Guide.html 382
-
Test Execution

+        
All test controllers share a common test execution model. They differ only in how the
+            results of test execution are shown.

 
hunk ./doc/Guide.html 385
-All test controllers share a common test execution model. They
-differ only in how the results of test execution are shown.
-

-The execution of a test (a value of type Test) involves the
-serial execution (in the IO monad) of its constituent test
-cases. The test cases are executed in a depth-first,
-left-to-right order. During test execution, four counts of test
-cases are maintained:
-
+        
The execution of a test (a value of type Test) involves the serial execution (in
+            the IO monad) of its constituent test cases. The test cases are executed in a
+            depth-first, left-to-right order. During test execution, four counts of test cases are
+            maintained:

+        
     data Counts = Counts { cases, tried, errors, failures :: Int }
       deriving (Eq, Show, Read)
 

hunk ./doc/Guide.html 393
-
    
-
  • 
-cases is the number of test cases included in the test.
-This number is a static property of a test and remains unchanged
-during test execution.
-
    • 
-
  • 
-tried is the number of test cases that have been executed so
-far during the test execution.
-
    • 
-
  • 
-errors is the number of test cases whose execution ended with
-an unexpected exception being raised. Errors indicate problems
-with test cases, as opposed to the code under test.
-
    • 
-
  • 
-failures is the number of test cases whose execution asserted
-failure. Failures indicate problems with the code under test.
-
    • 
-

-Why is there no count for test case successes?  The technical reason
-is that the counts are maintained such that the number of test case
-successes is always equal to
-(tried - (errors + failures)). The
-psychosocial reason is that, with test-centered development and the
-expectation that test failures will be few and short-lived, attention
-should be focused on the failures rather than the successes.
-

-As test execution proceeds, three kinds of reporting event are
-communicated to the test controller. (What the controller does
-in response to the reporting events depends on the controller.)
-
    
-
  • 
-start --
-Just prior to initiation of a test case, the path of the test case and
-the current counts (excluding the current test case) are reported.
-
    • 
-
  • 
-error --
-When a test case terminates with an error, the error message is
-reported, along with the test case path and current counts (including
-the current test case).
-
    • 
-
  • 
-failure --
-When a test case terminates with a failure, the failure message is
-reported, along with the test case path and current counts (including
-the current test case).
-
    • 
-

-Typically, a test controller shows error and failure
-reports immediately but uses the start report merely to update
-an indication of overall test execution progress.
+        
    
+            
  • cases is the number of test cases included in the test. This number is a
+                static property of a test and remains unchanged during test execution.
    • 
+            
  • tried is the number of test cases that have been executed so far during the
+                test execution.
    • 
+            
  • errors is the number of test cases whose execution ended with an unexpected
+                exception being raised. Errors indicate problems with test cases, as opposed to the
+                code under test.
    • 
+            
  • failures is the number of test cases whose execution asserted failure.
+                Failures indicate problems with the code under test.
    • 
+        

+        
Why is there no count for test case successes? The technical reason is that the counts
+            are maintained such that the number of test case successes is always equal to
+                (tried - (errors + failures)). The
+            psychosocial reason is that, with test-centered development and the expectation that
+            test failures will be few and short-lived, attention should be focused on the failures
+            rather than the successes.

 
hunk ./doc/Guide.html 411
-
Text-Based Controller

+        
As test execution proceeds, three kinds of reporting event are communicated to the test
+            controller. (What the controller does in response to the reporting events depends on the
+            controller.)

+        
    
+            
  • start -- Just prior to initiation of a test case, the path of the test case
+                and the current counts (excluding the current test case) are reported.
    • 
+            
  • error -- When a test case terminates with an error, the error message is
+                reported, along with the test case path and current counts (including the current
+                test case).
    • 
+            
  • failure -- When a test case terminates with a failure, the failure message is
+                reported, along with the test case path and current counts (including the current
+                test case).
    • 
+        

+        
Typically, a test controller shows error and failure reports immediately
+            but uses the start report merely to update an indication of overall test
+            execution progress.

 
hunk ./doc/Guide.html 428
-A text-based test controller is included with HUnit.
-
+        
Text-Based Controller

+
+        
A text-based test controller is included with HUnit.

+        
     runTestText :: PutText st -> Test -> IO (Counts, st)
 

hunk ./doc/Guide.html 434
-runTestText is generalized on a reporting scheme given
-as its first argument. During execution of the test given as its
-second argument, the controller creates a string for each reporting
-event and processes it according to the reporting scheme. When
-test execution is complete, the controller returns the final counts
-along with the final state for the reporting scheme.
-

-The strings for the three kinds of reporting event are as follows.
-
    
-
  • 
-A start report is the result of the function
-showCounts applied to the counts current immediately prior to
-initiation of the test case being started.
-
    • 
-
  • 
-An error report is of the form
-"Error in:   path\nmessage",
-where path is the path of the test case in error, as shown by
-showPath, and message is a message describing the
-error. If the path is empty, the report has the form
-"Error:\nmessage".
-
    • 
-
  • 
-A failure report is of the form
-"Failure in: path\nmessage", where
-path is the path of the test case in error, as shown by
-showPath, and message is the failure message. If
-the path is empty, the report has the form
-"Failure:\nmessage".
-
    • 
-

-

-The function showCounts shows a set of counts.
-
+        
runTestText is generalized on a reporting scheme given as its first
+            argument. During execution of the test given as its second argument, the controller
+            creates a string for each reporting event and processes it according to the reporting
+            scheme. When test execution is complete, the controller returns the final counts along
+            with the final state for the reporting scheme.

+
+        
The strings for the three kinds of reporting event are as follows.

+        
    
+            
  • A start report is the result of the function showCounts applied to
+                the counts current immediately prior to initiation of the test case being started.
    • 
+            
  • An error report is of the form
+                        "Error in:   path\nmessage",
+                where path is the path of the test case in error, as shown by
+                showPath, and message is a message describing the error. If the path
+                is empty, the report has the form "Error:\nmessage".
    • 
+            
  • A failure report is of the form
+                        "Failure in: path\nmessage", where
+                    path is the path of the test case in error, as shown by
+                showPath, and message is the failure message. If the path is empty,
+                the report has the form "Failure:\nmessage".
    • 
+        

+
+        
The function showCounts shows a set of counts.

+        
     showCounts :: Counts -> String
 

hunk ./doc/Guide.html 460
-The form of its result is
-"Cases: cases  Tried: tried  Errors: errors  Failures: failures"
-where cases, tried, errors, and failures
-are the count values.
-

-The function showPath shows a test case path.
-
+        
The form of its result is
+                    "Cases: cases  Tried: tried  Errors: errors  Failures: failures"
+            where cases, tried, errors, and failures are the count
+            values.

+
+        
The function showPath shows a test case path.

+        
     showPath :: Path -> String
 

hunk ./doc/Guide.html 469
-The nodes in the path are reversed (so that the path reads from the
-root down to the test case), and the representations for the nodes are
-joined by ':' separators. The representation for
-(ListItem n) is (show n). The
-representation for (Label label) is normally
-label. However, if label contains a colon or if
-(show label) is different from label surrounded
-by quotation marks--that is, if any ambiguity could exist--then
-(Label label) is represented as (show
-label).
-

-HUnit includes two reporting schemes for the text-based test
-controller. You may define others if you wish.
-
+        
The nodes in the path are reversed (so that the path reads from the root down to the test
+            case), and the representations for the nodes are joined by ':' separators. The
+            representation for (ListItem n) is (show n). The representation
+            for (Label label) is normally label. However, if label
+            contains a colon or if (show label) is different from label
+            surrounded by quotation marks--that is, if any ambiguity could exist--then (Label
+                    label) is represented as (show label).

+
+        
HUnit includes two reporting schemes for the text-based test controller. You may define
+            others if you wish.

+        
     putTextToHandle :: Handle -> Bool -> PutText Int
 

hunk ./doc/Guide.html 482
-putTextToHandle writes error and failure reports, plus a
-report of the final counts, to the given handle. Each of these
-reports is terminated by a newline. In addition, if the given
-flag is True, it writes start reports to the handle as
-well. A start report, however, is not terminated by a
-newline. Before the next report is written, the start report is
-"erased" with an appropriate sequence of carriage return and space
-characters. Such overwriting realizes its intended effect on
-terminal devices.
-
+        
putTextToHandle writes error and failure reports, plus a report of the final
+            counts, to the given handle. Each of these reports is terminated by a newline. In
+            addition, if the given flag is True, it writes start reports to the handle as
+            well. A start report, however, is not terminated by a newline. Before the next report is
+            written, the start report is "erased" with an appropriate sequence of carriage return
+            and space characters. Such overwriting realizes its intended effect on terminal devices.

+        
     putTextToShowS :: PutText ShowS
 

hunk ./doc/Guide.html 491
-putTextToShowS ignores start reports and simply accumulates
-error and failure reports, terminating them with newlines. The
-accumulated reports are returned (as the second element of the pair
-returned by runTestText) as a ShowS function (that
-is, one with type (String -> String)) whose first
-argument is a string to be appended to the accumulated report lines.
-

-HUnit provides a shorthand for the most common use of the text-based
-test controller.
-
+        
putTextToShowS ignores start reports and simply accumulates error and failure
+            reports, terminating them with newlines. The accumulated reports are returned (as the
+            second element of the pair returned by runTestText) as a ShowS
+            function (that is, one with type (String -> String)) whose
+            first argument is a string to be appended to the accumulated report lines.

+
+        
HUnit provides a shorthand for the most common use of the text-based test controller.

+        
     runTestTT :: Test -> IO Counts
 

hunk ./doc/Guide.html 501
-runTestTT invokes runTestText, specifying
-(putTextToHandle stderr True) for the reporting scheme, and
-returns the final counts from the test execution.
-
-
Constituent Files

-
-HUnit 1.0 consists of the following files.
-

-
-
 doc/Guide.html
-

-This document.
-
 examples/Example.hs
-

-Haskell module that includes the examples given in the Getting Started section. Run this
-program to make sure you understand how to use HUnit.
-
 Test/HUnit.lhs
-

-Haskell module that you import to use HUnit.
-
 Test/HUnit/Base.lhs
-

-Haskell module that defines HUnit's basic facilities.
-
 Test/HUnit/Lang.lhs
-

-Haskell module that defines how assertion failure is signaled and
-caught. By default, it is a copy of
-Test/HUnit/Lang98.lhs. Replace it by a copy of
-Test/HUnit/LangExtended.lhs for more robust exception behavior.
-
 Test/HUnit/Lang98.lhs
-

-Haskell module that defines generic assertion failure handling. 
-It is compliant to Haskell 98 but catches only IO errors.
-
 Test/HUnit/LangExtended.lhs
-

-Haskell module that defines more robust assertion failure
-handling. It catches more (though unfortunately not all) kinds
-of exceptions. However, it works only with Hugs (Dec. 2001 or
-later) and GHC (5.00 and later).
-
 examples/test/HUnitTest98.lhs
-

-Haskell module that tests HUnit, assuming the generic assertion
-failure handling of HUnitLang98.lhs.
-
 examples/test/HUnitTestBase.lhs
-

-Haskell module that defines testing support and basic (Haskell 98
-compliant) tests of HUnit (using HUnit, of course!). Contains
-more extensive and advanced examples of testing with HUnit.
-
 examples/test/HUnitTestExtended.lhs
-

-Haskell module that tests HUnit, assuming the extended assertion
-failure handling of HUnitLangExc.lhs.
-
 Test/HUnit/Text.lhs
-

-Haskell module that defines HUnit's text-based test controller.
-
 LICENSE
-

-The license for use of HUnit.
-
 Test/HUnit/Terminal.lhs
-

-Haskell module that assists in checking the output of HUnit tests
-performed by the text-based test controller.
-
 examples/test/TerminalTest.lhs
-

-Haskell module that tests Test/HUnit/Terminal.lhs (using HUnit, of
-course!).
-

+        
runTestTT invokes runTestText, specifying (putTextToHandle stderr
+                True) for the reporting scheme, and returns the final counts from the test
+            execution.

 
hunk ./doc/Guide.html 505
-
References

 
hunk ./doc/Guide.html 506
-

+        
References

 
hunk ./doc/Guide.html 508
-

-[1] Gamma, E., et al. Design Patterns:
-Elements of Reusable Object-Oriented Software, Addison-Wesley,
-Reading, MA, 1995.
-

-The classic book describing design patterns in an object-oriented
-context.
+        

 
hunk ./doc/Guide.html 510
-

-http://www.junit.org
-

-Web page for JUnit, the tool after which HUnit is modeled.
+            
[1] Gamma, E., et al. Design Patterns: Elements of Reusable
+                Object-Oriented Software, Addison-Wesley, Reading, MA, 1995.

+            
The classic book describing design patterns in an object-oriented context.

 
hunk ./doc/Guide.html 514
-

-
-http://junit.sourceforge.net/doc/testinfected/testing.htm
-

-A good introduction to test-first development and the use of JUnit.
+            

+                http://www.junit.org
+            

+            
Web page for JUnit, the tool after which HUnit is modeled.

 
hunk ./doc/Guide.html 519
-

-
-http://junit.sourceforge.net/doc/cookstour/cookstour.htm
-

-A description of the internal structure of JUnit. Makes for an
-interesting comparison between JUnit and HUnit.
+            

+                
+                    http://junit.sourceforge.net/doc/testinfected/testing.htm
+            

+            
A good introduction to test-first development and the use of JUnit.

 
hunk ./doc/Guide.html 525
-

+            

+                
+                    http://junit.sourceforge.net/doc/cookstour/cookstour.htm
+            

+            
A description of the internal structure of JUnit. Makes for an interesting
+                comparison between JUnit and HUnit.

 
hunk ./doc/Guide.html 532
-

-

+        

 
hunk ./doc/Guide.html 534
-The HUnit software and this guide were written by Dean Herington
-(heringto@cs.unc.edu).
+        

 
hunk ./doc/Guide.html 536
-

-HUnit development is supported by
-
-SourceForge.net Logo
-
-
+        
The HUnit software and this guide were written by Dean Herington (heringto@cs.unc.edu).

+    
 
hunk ./examples/Example.hs 2
 -- Example.hs  --  Examples from HUnit user's guide
+--
+-- For more examples, check out the tests directory.  It contains unit tests
+-- for HUnit. 
 
 module Main where
 
addfile ./tests/HUnitTest98.lhs
hunk ./tests/HUnitTest98.lhs 1
+HUnitTest98.lhs  --  test for HUnit, using Haskell language system "98"
+
+> module Main (main) where
+
+> import Test.HUnit
+> import HUnitTestBase
+
+> main :: IO Counts
+> main = runTestTT (test [baseTests])
addfile ./tests/HUnitTestBase.lhs
hunk ./tests/HUnitTestBase.lhs 1
+HUnitTestBase.lhs  --  test support and basic tests (Haskell 98 compliant)
+
+> module HUnitTestBase where
+
+> import Test.HUnit
+> import Test.HUnit.Terminal (terminalAppearance)
+> import System.IO (IOMode(..), openFile, hClose)
+
+
+> data Report = Start State
+>             | Error String State
+>             | UnspecifiedError State
+>             | Failure String State
+>   deriving (Show, Read)
+
+> instance Eq Report where
+>   Start s1            == Start s2             =  s1 == s2
+>   Error m1 s1         == Error m2 s2          =  m1 == m2 && s1 == s2
+>   Error m1 s1         == UnspecifiedError s2  =  s1 == s2
+>   UnspecifiedError s1 == Error m2 s2          =  s1 == s2
+>   UnspecifiedError s1 == UnspecifiedError s2  =  s1 == s2
+>   Failure m1 s1       == Failure m2 s2        =  m1 == m2 && s1 == s2
+>   _                   == _                    =  False
+
+
+> expectReports :: [Report] -> Counts -> Test -> Test
+> expectReports reports counts test = TestCase $ do
+>   (counts', reports') <- performTest (\  ss us -> return (Start     ss : us))
+>                                      (\m ss us -> return (Error   m ss : us))
+>                                      (\m ss us -> return (Failure m ss : us))
+>                                      [] test
+>   assertEqual "for the reports from a test," reports (reverse reports')
+>   assertEqual "for the counts from a test," counts counts'
+
+
+> simpleStart = Start (State [] (Counts 1 0 0 0))
+
+> expectSuccess :: Test -> Test
+> expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0)
+
+> expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test
+> expectProblem kind err msg =
+>   expectReports [simpleStart, kind msg (State [] counts)] counts
+>  where counts = Counts 1 1 err (1-err)
+
+> expectError, expectFailure :: String -> Test -> Test
+> expectError   = expectProblem Error   1
+> expectFailure = expectProblem Failure 0
+
+> expectUnspecifiedError :: Test -> Test
+> expectUnspecifiedError = expectProblem (\ msg st -> UnspecifiedError st) 1 undefined
+
+
+> data Expect = Succ | Err String | UErr | Fail String
+
+> expect :: Expect -> Test -> Test
+> expect Succ     test = expectSuccess test
+> expect (Err m)  test = expectError m test
+> expect UErr     test = expectUnspecifiedError test
+> expect (Fail m) test = expectFailure m test
+
+
+
+> baseTests = test [ assertTests,
+>                    testCaseCountTests,
+>                    testCasePathsTests,
+>                    reportTests,
+>                    textTests,
+>                    showPathTests,
+>                    showCountsTests,
+>                    assertableTests,
+>                    predicableTests,
+>                    compareTests,
+>                    extendedTestTests ]
+
+
+> ok = test (assert ())
+> bad m = test (assertFailure m)
+
+
+> assertTests = test [
+
+>   "null" ~: expectSuccess ok,
+
+>   "userError" ~:
+#if defined(__GLASGOW_HASKELL__)
+>     expectError "user error (error)" (TestCase (ioError (userError "error"))),
+#else
+>     expectError "error" (TestCase (ioError (userError "error"))),
+#endif
+
+>   "IO error (file missing)" ~:
+>     expectUnspecifiedError
+>       (test (do openFile "3g9djs" ReadMode; return ())),
+
+   "error" ~:
+     expectError "error" (TestCase (error "error")),
+
+   "tail []" ~:
+     expectUnspecifiedError (TestCase (tail [] `seq` return ())),
+
+    -- GHC doesn't currently catch arithmetic exceptions.
+   "div by 0" ~:
+     expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())),
+
+>   "assertFailure" ~:
+>     let msg = "simple assertFailure"
+>     in expectFailure msg (test (assertFailure msg)),
+
+>   "assertString null" ~: expectSuccess (TestCase (assertString "")),
+
+>   "assertString nonnull" ~:
+>     let msg = "assertString nonnull"
+>     in expectFailure msg (TestCase (assertString msg)),
+
+>   let exp v non =
+>         show v ++ " with " ++ non ++ "null message" ~:
+>           expect (if v then Succ else Fail non) $ test $ assertBool non v
+>   in "assertBool" ~: [ exp v non | v <- [True, False], non <- ["non", ""] ],
+
+>   let msg = "assertBool True"
+>   in msg ~: expectSuccess (test (assertBool msg True)),
+
+>   let msg = "assertBool False"
+>   in msg ~: expectFailure msg (test (assertBool msg False)),
+
+>   "assertEqual equal" ~:
+>     expectSuccess (test (assertEqual "" 3 3)),
+
+>   "assertEqual unequal no msg" ~:
+>     expectFailure "expected: 3\n but got: 4"
+>       (test (assertEqual "" 3 4)),
+
+>   "assertEqual unequal with msg" ~:
+>     expectFailure "for x,\nexpected: 3\n but got: 4"
+>       (test (assertEqual "for x," 3 4))
+
+>  ]
+
+
+> emptyTest0 = TestList []
+> emptyTest1 = TestLabel "empty" emptyTest0
+> emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ]
+> emptyTests = [emptyTest0, emptyTest1, emptyTest2]
+
+> testCountEmpty test = TestCase (assertEqual "" 0 (testCaseCount test))
+
+> suite0 = (0, ok)
+> suite1 = (1, TestList [])
+> suite2 = (2, TestLabel "3" ok)
+> suite3 = (3, suite)
+
+> suite =
+>   TestLabel "0"
+>     (TestList [ TestLabel "1" (bad "1"),
+>                 TestLabel "2" (TestList [ TestLabel "2.1" ok,
+>                                           ok,
+>                                           TestLabel "2.3" (bad "2") ]),
+>                 TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))),
+>                 TestList [ TestList [ TestLabel "6" (bad "4") ] ] ])
+
+> suiteCount = (6 :: Int)
+
+> suitePaths = [
+>   [Label "0", ListItem 0, Label "1"],
+>   [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"],
+>   [Label "0", ListItem 1, Label "2", ListItem 1],
+>   [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"],
+>   [Label "0", ListItem 2, Label "3", Label "4", Label "5"],
+>   [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]]
+
+> suiteReports = [ Start       (State (p 0) (Counts 6 0 0 0)),
+>                  Failure "1" (State (p 0) (Counts 6 1 0 1)),
+>                  Start       (State (p 1) (Counts 6 1 0 1)),
+>                  Start       (State (p 2) (Counts 6 2 0 1)),
+>                  Start       (State (p 3) (Counts 6 3 0 1)),
+>                  Failure "2" (State (p 3) (Counts 6 4 0 2)),
+>                  Start       (State (p 4) (Counts 6 4 0 2)),
+>                  Failure "3" (State (p 4) (Counts 6 5 0 3)),
+>                  Start       (State (p 5) (Counts 6 5 0 3)),
+>                  Failure "4" (State (p 5) (Counts 6 6 0 4))]
+>  where p n = reverse (suitePaths !! n)
+
+> suiteCounts = Counts 6 6 0 4
+
+> suiteOutput = concat [
+>    "### Failure in: 0:0:1\n",
+>    "1\n",
+>    "### Failure in: 0:1:2:2:2.3\n",
+>    "2\n",
+>    "### Failure in: 0:2:3:4:5\n",
+>    "3\n",
+>    "### Failure in: 0:3:0:0:6\n",
+>    "4\n",
+>    "Cases: 6  Tried: 6  Errors: 0  Failures: 4\n"]
+
+
+> suites = [suite0, suite1, suite2, suite3]
+
+
+> testCount (num, test) count =
+>   "testCaseCount suite" ++ show num ~:
+>     TestCase $ assertEqual "for test count," count (testCaseCount test)
+
+> testCaseCountTests = TestList [
+
+>   "testCaseCount empty" ~: test (map testCountEmpty emptyTests),
+
+>   testCount suite0 1,
+>   testCount suite1 0,
+>   testCount suite2 1,
+>   testCount suite3 suiteCount
+
+>  ]
+
+
+> testPaths (num, test) paths =
+>   "testCasePaths suite" ++ show num ~:
+>     TestCase $ assertEqual "for test paths,"
+>                             (map reverse paths) (testCasePaths test)
+
+> testPathsEmpty test = TestCase $ assertEqual "" [] (testCasePaths test)
+
+> testCasePathsTests = TestList [
+
+>   "testCasePaths empty" ~: test (map testPathsEmpty emptyTests),
+
+>   testPaths suite0 [[]],
+>   testPaths suite1 [],
+>   testPaths suite2 [[Label "3"]],
+>   testPaths suite3 suitePaths
+
+>  ]
+
+
+> reportTests = "reports" ~: expectReports suiteReports suiteCounts suite
+
+
+> expectText counts text test = TestCase $ do
+>   (counts', text') <- runTestText putTextToShowS test
+>   assertEqual "for the final counts," counts counts'
+>   assertEqual "for the failure text output," text (text' "")
+
+
+> textTests = test [
+
+>   "lone error" ~:
+>     expectText (Counts 1 1 1 0)
+#if defined(__GLASGOW_HASKELL__)
+>         "### Error:\nuser error (xyz)\nCases: 1  Tried: 1  Errors: 1  Failures: 0\n"
+#else
+>         "### Error:\nxyz\nCases: 1  Tried: 1  Errors: 1  Failures: 0\n"
+#endif
+>         (test (do ioError (userError "xyz"); return ())),
+
+>   "lone failure" ~:
+>     expectText (Counts 1 1 0 1)
+>         "### Failure:\nxyz\nCases: 1  Tried: 1  Errors: 0  Failures: 1\n"
+>         (test (assert "xyz")),
+
+>   "putTextToShowS" ~:
+>     expectText suiteCounts suiteOutput suite,
+
+>   "putTextToHandle (file)" ~:
+>     let filename = "HUnitTest.tmp"
+>         trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines
+>     in map test
+>       [ "show progress = " ++ show flag ~: do
+>           handle <- openFile filename WriteMode
+>           (counts, _) <- runTestText (putTextToHandle handle flag) suite
+>           hClose handle
+>           assertEqual "for the final counts," suiteCounts counts
+>           text <- readFile filename
+>           let text' = if flag then trim (terminalAppearance text) else text
+>           assertEqual "for the failure text output," suiteOutput text'
+>       | flag <- [False, True] ]
+
+>  ]
+
+
+> showPathTests = "showPath" ~: [
+
+>   "empty"  ~: showPath [] ~?= "",
+>   ":"      ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"",
+>   "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"",
+>   "misc"   ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?=
+>                        "foo:3:2:b"
+
+>  ]
+
+
+> showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?=
+>                             "Cases: 4  Tried: 3  Errors: 2  Failures: 1"
+
+
+
+> lift :: a -> IO a
+> lift a = return a
+
+
+> assertableTests =
+>   let assertables x = [
+>         (       "", assert             x  , test             (lift x))  ,
+>         (    "IO ", assert       (lift x) , test       (lift (lift x))) ,
+>         ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))]
+>       assertabled l e x =
+>         test [ test [ "assert" ~: pre ++ l          ~: expect e $ test $ a,
+>                       "test"   ~: pre ++ "IO " ++ l ~: expect e $ t ]
+>                | (pre, a, t) <- assertables x ]
+>   in "assertable" ~: [
+>     assertabled "()"    Succ       (),
+>     assertabled "True"  Succ       True,
+>     assertabled "False" (Fail "")  False,
+>     assertabled "\"\""  Succ       "",
+>     assertabled "\"x\"" (Fail "x") "x"
+>    ]
+
+
+> predicableTests =
+>   let predicables x m = [
+>         (       "", assertionPredicate      x  ,     x  @? m,     x  ~? m ),
+>         (    "IO ", assertionPredicate   (l x) ,   l x  @? m,   l x  ~? m ),
+>         ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )]
+>       l x = lift x
+>       predicabled l e m x =
+>         test [ test [ "pred" ~: pre ++ l ~: m ~: expect e $ test $ tst p,
+>                       "(@?)" ~: pre ++ l ~: m ~: expect e $ test $ a,
+>                       "(~?)" ~: pre ++ l ~: m ~: expect e $ t ]
+>                                    | (pre, p, a, t) <- predicables x m ]
+>        where tst p = p >>= assertBool m
+>   in "predicable" ~: [
+>     predicabled "True"  Succ           "error" True,
+>     predicabled "False" (Fail "error") "error" False,
+>     predicabled "True"  Succ           ""      True,
+>     predicabled "False" (Fail ""     ) ""      False
+>    ]
+
+
+> compareTests = test [
+
+>   let succ = const Succ
+>       compare f exp act = test [ "(@=?)" ~: expect e $ test (exp @=? act),
+>                                  "(@?=)" ~: expect e $ test (act @?= exp),
+>                                  "(~=?)" ~: expect e $       exp ~=? act,
+>                                  "(~?=)" ~: expect e $       act ~?= exp ]
+>        where e = f $ "expected: " ++ show exp ++ "\n but got: " ++ show act
+>   in test [
+>     compare succ 1 1,
+>     compare Fail 1 2,
+>     compare succ (1,'b',3.0) (1,'b',3.0),
+>     compare Fail (1,'b',3.0) (1,'b',3.1)
+>    ]
+
+>  ]
+
+
+> expectList1 :: Int -> Test -> Test
+> expectList1 c =
+>   expectReports
+>     [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ]
+>                                 (Counts c c 0 0)
+
+> expectList2 :: [Int] -> Test -> Test
+> expectList2 cs test =
+>   expectReports
+>     [ Start (State [ListItem j, ListItem i] (Counts c n 0 0))
+>         | ((i,j),n) <- zip coords [0..] ]
+>                                             (Counts c c 0 0)
+>                    test
+>  where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ]
+>        c = testCaseCount test
+
+
+> extendedTestTests = test [
+
+>   "test idempotent" ~: expect Succ $ test $ test $ test $ ok,
+
+>   "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True],
+
+>   "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]]
+
+>  ]
addfile ./tests/HUnitTestExtended.lhs
hunk ./tests/HUnitTestExtended.lhs 1
+HUnitTestExc.lhs  --  test for HUnit, using Haskell language system "Exc"
+
+> module Main (main) where
+
+> import Test.HUnit
+> import HUnitTestBase
+
+ import qualified Control.Exception (assert)
+
+ assertionMessage = "HUnitTestExc.lhs:13: Assertion failed\n"
+ assertion = Control.Exception.assert False (return ())
+
+
+> main :: IO Counts
+> main = runTestTT (test [baseTests, excTests])
+
+> excTests :: Test
+> excTests = test [
+
+    -- Hugs doesn't currently catch arithmetic exceptions.
+    
+>  "div by 0" ~:
+>    expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())),
+
+>  "list ref out of bounds" ~:
+>    expectUnspecifiedError (TestCase ([1 .. 4] !! 10 `seq` return ())),
+
+>   "error" ~:
+>     expectError "error" (TestCase (error "error")),
+
+>   "tail []" ~:
+>     expectUnspecifiedError (TestCase (tail [] `seq` return ()))
+
+   -- Hugs doesn't provide `assert` and GHC's type system doesn't allow this
+   -- to compile.
+   "assert" ~:
+     expectError assertionMessage (TestCase assertion)
+
+>  ]
addfile ./tests/HUnitTests.cabal
hunk ./tests/HUnitTests.cabal 1
-
+Name:                   HUnitTests
+Version:                1.2.2.0
+License:                BSD3
+License-File:           LICENSE
+Author:                 Dean Herington
+Homepage:               http://hunit.sourceforge.net/
+Category:               Testing
+Synopsis:               A set of unit tests for HUnit
+-- Build-Type:             Simple
+
+Executable:             basic-tests
+Main-Is:                HUnitTest98.lhs
+HS-Source-Dirs:         . ..
+-- Build-Depends:          base
+Extensions:             CPP
+
+Executable:             extended-tests
+Main-Is:                HUnitTestExtended.lhs
+HS-Source-Dirs:         . ..
+-- Build-Depends:          base
+Extensions:             CPP
+
+Executable:             terminal-tests
+Main-Is:                TerminalTest.lhs
+HS-Source-Dirs:         . ..
+-- Build-Depends:          base
+Extensions:             CPP
+    
addfile ./tests/Setup.hs
hunk ./tests/Setup.hs 1
+#!/usr/bin/env runghc
+module Main (main) where
+
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
addfile ./tests/TerminalTest.lhs
hunk ./tests/TerminalTest.lhs 1
+TerminalTest.lhs
+
+> import Test.HUnit.Terminal
+> import Test.HUnit
+
+> main :: IO Counts
+> main = runTestTT tests
+
+> try :: String -> String -> String -> Test
+> try lab inp exp' = lab ~: terminalAppearance inp ~?= exp'
+
+> tests :: Test
+> tests = test [
+>   try "empty" "" "",
+>   try "end in \\n" "abc\ndef\n" "abc\ndef\n",
+>   try "not end in \\n" "abc\ndef" "abc\ndef",
+>   try "return 1" "abc\ndefgh\rxyz" "abc\nxyzgh",
+>   try "return 2" "\nabcdefgh\rijklm\rxy\n" "\nxyklmfgh\n",
+>   try "return 3" "\r\rabc\r\rdef\r\r\r\nghi\r\r\n" "def\nghi\n",
+>   try "back 1" "abc\bdef\b\bgh\b" "abdgh",
+>   try "back 2" "abc\b\b\bdef\b\bxy\b\b\n" "dxy\n"
+>   -- \b at beginning of line
+>   -- nonprinting char
+>  ]
}

Context:

[TAG 1.2.0.3
Duncan Coutts **20081022051443] 
[Bump version to 1.2.0.3
Duncan Coutts **20081022051258] 
[Make it build with base 3 or 4
Duncan Coutts **20081022051110
 But make sure it always uses base 4 with ghc-6.10
 It now compiles with ghc-6.8 and 6.10
] 
[TAG 2008-10-13
Ian Lynagh **20081013232038] 
Patch bundle hash:
a457437dec38ec2424eba63383ffe584c8d61515