diff --git a/HUnit.cabal b/HUnit.cabal --- a/HUnit.cabal +++ b/HUnit.cabal @@ -1,6 +1,6 @@ Name: HUnit -Version: 1.2.2.1 -Cabal-Version: >= 1.2 +Version: 1.2.2.3 +Cabal-Version: >= 1.6 License: BSD3 License-File: LICENSE Author: Dean Herington @@ -28,6 +28,10 @@ prologue.txt README +source-repository head + type: darcs + location: http://code.haskell.org/HUnit/ + flag base4 Library @@ -35,6 +39,7 @@ if flag(base4) Build-Depends: base >=4 CPP-Options: -DBASE4 + GHC-Options: -Wall else Build-Depends: base <4 if impl(ghc >= 6.10) @@ -54,6 +59,7 @@ if flag(base4) Build-Depends: base >=4 CPP-Options: -DBASE4 + GHC-Options: -Wall else Build-Depends: base <4 if impl(ghc >= 6.10) @@ -67,6 +73,7 @@ if flag(base4) Build-Depends: base >=4 CPP-Options: -DBASE4 + GHC-Options: -Wall else Build-Depends: base <4 if impl(ghc >= 6.10) diff --git a/Test/HUnit/Base.hs b/Test/HUnit/Base.hs --- a/Test/HUnit/Base.hs +++ b/Test/HUnit/Base.hs @@ -7,9 +7,9 @@ -- 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 -( + +module Test.HUnit.Base +( -- ** Declaring tests Test(..), (~=?), (~?=), (~:), (~?), @@ -21,45 +21,45 @@ (@=?), (@?=), (@?), -- ** Extending the assertion functionality - Assertable(..), ListAssertable(..), - AssertionPredicate, AssertionPredicable(..), + Assertable(..), ListAssertable(..), + AssertionPredicate, AssertionPredicable(..), Testable(..), -- ** Test execution - -- $testExecutionNote - State(..), Counts(..), + -- $testExecutionNote + State(..), Counts(..), Path, Node(..), - testCasePaths, + testCasePaths, testCaseCount, ReportStart, ReportProblem, - performTest -) -where - -import Control.Monad (unless, foldM) - - --- Assertion Definition --- ==================== - -import Test.HUnit.Lang - - --- Conditional Assertion Functions --- ------------------------------- - + 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) - +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) - +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. @@ -70,15 +70,15 @@ -> 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 --- ---------------------------- +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, @@ -89,32 +89,32 @@ -- -- 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) - +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 --- ---------------------------------------- - +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: @@ -137,52 +137,52 @@ -- 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 - +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 +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 +predi @? msg = assertionPredicate predi >>= assertBool msg + -- | Asserts that the specified actual value is equal to the expected value --- (with the expected value on the left-hand side). +-- (with the expected value on the left-hand side). (@=?) :: (Eq a, Show a) => a -- ^ The expected value - -> a -- ^ The actual value - -> Assertion + -> 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 --- =============== + -> Assertion +actual @?= expected = assertEqual "" expected actual --- | The basic structure used to create an annotated tree of test cases. + + +-- Test Definition +-- =============== + +-- | The basic structure used to create an annotated tree of test cases. data Test -- | A single, independent test case composed. = TestCase Assertion @@ -190,72 +190,72 @@ | 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 --- -------------------------- - + +instance Show Test where + showsPrec _ (TestCase _) = showString "TestCase _" + showsPrec _ (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). +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 +predi ~? msg = TestCase (predi @? 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). + -> 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 + -> 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 --- ============== +-- 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, @@ -263,22 +263,22 @@ -- "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) +-- 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) +-- 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 +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 +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. @@ -290,12 +290,12 @@ -- | Determines the paths for all 'TestCase's in a tree of @Test@s. testCasePaths :: Test -> [Path] -testCasePaths t = tcp t [] +testCasePaths t0 = tcp t0 [] 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 @@ -309,47 +309,47 @@ -- 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 +-- +-- 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 + -> 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 } + -> IO (Counts, us) +performTest reportStart reportError reportFailure initialUs initialT = do + (ss', us') <- pt initState initialUs initialT + unless (null (path ss')) $ error "performTest: Final path is nonnull" + return (counts ss', us') + where + initState = State{ path = [], counts = initCounts } + initCounts = Counts{ cases = testCaseCount initialT, 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 = n } = counts ss + ss' = ss{ counts = c{ tried = n + 1 } } + ssF = ss{ counts = c{ tried = n + 1, failures = failures c + 1 } } + ssE = ss{ counts = c{ tried = n + 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 } diff --git a/Test/HUnit/Lang.hs b/Test/HUnit/Lang.hs --- a/Test/HUnit/Lang.hs +++ b/Test/HUnit/Lang.hs @@ -18,11 +18,11 @@ -- Imports -- ------- -import Data.List (isPrefixOf) #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) import Data.Dynamic import Control.Exception as E #else +import Data.List (isPrefixOf) import System.IO.Error (ioeGetErrorString, try) #endif diff --git a/Test/HUnit/Text.hs b/Test/HUnit/Text.hs --- a/Test/HUnit/Text.hs +++ b/Test/HUnit/Text.hs @@ -58,7 +58,7 @@ 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) + put line False _ = 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" @@ -72,7 +72,7 @@ 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) + acc f line rest = f (line ++ '\n' : rest) -- | Executes a test, processing each report line according to the given @@ -81,10 +81,10 @@ -- 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'') +runTestText (PutText put us0) t = do + (counts', us1) <- performTest reportStart reportError reportFailure us0 t + us2 <- put (showCounts counts') True us1 + return (counts', us2) where reportStart ss us = put (showCounts (counts ss)) False us reportError = reportProblem "Error:" "Error in: " @@ -98,10 +98,10 @@ -- | 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 +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 @@ -124,5 +124,5 @@ -- 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 +runTestTT t = do (counts', 0) <- runTestText (putTextToHandle stderr True) t + return counts' diff --git a/tests/HUnitTestBase.lhs b/tests/HUnitTestBase.lhs --- a/tests/HUnitTestBase.lhs +++ b/tests/HUnitTestBase.lhs @@ -16,23 +16,24 @@ > 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 +> Error _ s1 == UnspecifiedError s2 = s1 == s2 +> UnspecifiedError s1 == Error _ 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)) +> expectReports reports1 counts1 t = TestCase $ do +> (counts2, reports2) <- 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' +> [] t +> assertEqual "for the reports from a test," reports1 (reverse reports2) +> assertEqual "for the counts from a test," counts1 counts2 +> simpleStart :: Report > simpleStart = Start (State [] (Counts 1 0 0 0)) > expectSuccess :: Test -> Test @@ -40,27 +41,28 @@ > 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) +> 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 +> 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 +> expect Succ t = expectSuccess t +> expect (Err m) t = expectError m t +> expect UErr t = expectUnspecifiedError t +> expect (Fail m) t = expectFailure m t +> baseTests :: Test > baseTests = test [ assertTests, > testCaseCountTests, > testCasePathsTests, @@ -74,10 +76,13 @@ > extendedTestTests ] +> ok :: Test > ok = test (assert ()) +> bad :: String -> Test > bad m = test (assertFailure m) +> assertTests :: Test > assertTests = test [ > "null" ~: expectSuccess ok, @@ -91,7 +96,7 @@ > "IO error (file missing)" ~: > expectUnspecifiedError -> (test (do openFile "3g9djs" ReadMode; return ())), +> (test (do _ <- openFile "3g9djs" ReadMode; return ())), "error" ~: expectError "error" (TestCase (error "error")), @@ -113,10 +118,10 @@ > let msg = "assertString nonnull" > in expectFailure msg (TestCase (assertString msg)), -> let exp v non = +> let f 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", ""] ], +> in "assertBool" ~: [ f v non | v <- [True, False], non <- ["non", ""] ], > let msg = "assertBool True" > in msg ~: expectSuccess (test (assertBool msg True)), @@ -125,31 +130,36 @@ > in msg ~: expectFailure msg (test (assertBool msg False)), > "assertEqual equal" ~: -> expectSuccess (test (assertEqual "" 3 3)), +> expectSuccess (test (assertEqual "" (3 :: Integer) (3 :: Integer))), > "assertEqual unequal no msg" ~: > expectFailure "expected: 3\n but got: 4" -> (test (assertEqual "" 3 4)), +> (test (assertEqual "" (3 :: Integer) (4 :: Integer))), > "assertEqual unequal with msg" ~: > expectFailure "for x,\nexpected: 3\n but got: 4" -> (test (assertEqual "for x," 3 4)) +> (test (assertEqual "for x," (3 :: Integer) (4 :: Integer))) > ] +> emptyTest0, emptyTest1, emptyTest2 :: Test > emptyTest0 = TestList [] > emptyTest1 = TestLabel "empty" emptyTest0 > emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ] +> emptyTests :: [Test] > emptyTests = [emptyTest0, emptyTest1, emptyTest2] -> testCountEmpty test = TestCase (assertEqual "" 0 (testCaseCount test)) +> testCountEmpty :: Test -> Test +> testCountEmpty t = TestCase (assertEqual "" 0 (testCaseCount t)) +> suite0, suite1, suite2, suite3 :: (Integer, Test) > suite0 = (0, ok) > suite1 = (1, TestList []) > suite2 = (2, TestLabel "3" ok) > suite3 = (3, suite) +> suite :: Test > suite = > TestLabel "0" > (TestList [ TestLabel "1" (bad "1"), @@ -159,8 +169,10 @@ > TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))), > TestList [ TestList [ TestLabel "6" (bad "4") ] ] ]) -> suiteCount = (6 :: Int) +> suiteCount :: Int +> suiteCount = 6 +> suitePaths :: [[Node]] > suitePaths = [ > [Label "0", ListItem 0, Label "1"], > [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"], @@ -169,6 +181,7 @@ > [Label "0", ListItem 2, Label "3", Label "4", Label "5"], > [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]] +> suiteReports :: [Report] > 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)), @@ -181,8 +194,10 @@ > Failure "4" (State (p 5) (Counts 6 6 0 4))] > where p n = reverse (suitePaths !! n) +> suiteCounts :: Counts > suiteCounts = Counts 6 6 0 4 +> suiteOutput :: String > suiteOutput = concat [ > "### Failure in: 0:0:1\n", > "1\n", @@ -195,13 +210,16 @@ > "Cases: 6 Tried: 6 Errors: 0 Failures: 4\n"] +> suites :: [(Integer, Test)] > suites = [suite0, suite1, suite2, suite3] -> testCount (num, test) count = +> testCount :: Show n => (n, Test) -> Int -> Test +> testCount (num, t) count = > "testCaseCount suite" ++ show num ~: -> TestCase $ assertEqual "for test count," count (testCaseCount test) +> TestCase $ assertEqual "for test count," count (testCaseCount t) +> testCaseCountTests :: Test > testCaseCountTests = TestList [ > "testCaseCount empty" ~: test (map testCountEmpty emptyTests), @@ -214,13 +232,16 @@ > ] -> testPaths (num, test) paths = +> testPaths :: Show n => (n, Test) -> [[Node]] -> Test +> testPaths (num, t) paths = > "testCasePaths suite" ++ show num ~: > TestCase $ assertEqual "for test paths," -> (map reverse paths) (testCasePaths test) +> (map reverse paths) (testCasePaths t) -> testPathsEmpty test = TestCase $ assertEqual "" [] (testCasePaths test) +> testPathsEmpty :: Test -> Test +> testPathsEmpty t = TestCase $ assertEqual "" [] (testCasePaths t) +> testCasePathsTests :: Test > testCasePathsTests = TestList [ > "testCasePaths empty" ~: test (map testPathsEmpty emptyTests), @@ -233,15 +254,18 @@ > ] +> reportTests :: Test > 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' "") +> expectText :: Counts -> String -> Test -> Test +> expectText counts1 text1 t = TestCase $ do +> (counts2, text2) <- runTestText putTextToShowS t +> assertEqual "for the final counts," counts1 counts2 +> assertEqual "for the failure text output," text1 (text2 "") +> textTests :: Test > textTests = test [ > "lone error" ~: @@ -251,7 +275,7 @@ #else > "### Error:\nxyz\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" #endif -> (test (do ioError (userError "xyz"); return ())), +> (test (do _ <- ioError (userError "xyz"); return ())), > "lone failure" ~: > expectText (Counts 1 1 0 1) @@ -267,9 +291,9 @@ > in map test > [ "show progress = " ++ show flag ~: do > handle <- openFile filename WriteMode -> (counts, _) <- runTestText (putTextToHandle handle flag) suite +> (counts', _) <- runTestText (putTextToHandle handle flag) suite > hClose handle -> assertEqual "for the final counts," suiteCounts counts +> 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' @@ -278,6 +302,7 @@ > ] +> showPathTests :: Test > showPathTests = "showPath" ~: [ > "empty" ~: showPath [] ~?= "", @@ -289,6 +314,7 @@ > ] +> showCountsTests :: Test > showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?= > "Cases: 4 Tried: 3 Errors: 2 Failures: 1" @@ -298,6 +324,7 @@ > lift a = return a +> assertableTests :: Test > assertableTests = > let assertables x = [ > ( "", assert x , test (lift x)) , @@ -316,16 +343,17 @@ > ] +> predicableTests :: Test > 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 ] +> predicabled lab e m x = +> test [ test [ "pred" ~: pre ++ lab ~: m ~: expect e $ test $ tst p, +> "(@?)" ~: pre ++ lab ~: m ~: expect e $ test $ a, +> "(~?)" ~: pre ++ lab ~: m ~: expect e $ t ] > | (pre, p, a, t) <- predicables x m ] > where tst p = p >>= assertBool m > in "predicable" ~: [ @@ -336,19 +364,29 @@ > ] +> compareTests :: Test > 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 +> let succ' = const Succ +> compare1 :: (String -> Expect) -> Integer -> Integer -> Test +> compare1 = compare' +> compare2 :: (String -> Expect) +> -> (Integer, Char, Double) +> -> (Integer, Char, Double) +> -> Test +> compare2 = compare' +> compare' f expected actual +> = test [ "(@=?)" ~: expect e $ test (expected @=? actual), +> "(@?=)" ~: expect e $ test (actual @?= expected), +> "(~=?)" ~: expect e $ expected ~=? actual, +> "(~?=)" ~: expect e $ actual ~?= expected ] +> where e = f $ "expected: " ++ show expected ++ +> "\n but got: " ++ show actual > 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) +> compare1 succ' 1 1, +> compare1 Fail 1 2, +> compare2 succ' (1,'b',3.0) (1,'b',3.0), +> compare2 Fail (1,'b',3.0) (1,'b',3.1) > ] > ] @@ -361,16 +399,17 @@ > (Counts c c 0 0) > expectList2 :: [Int] -> Test -> Test -> expectList2 cs test = +> expectList2 cs t = > expectReports > [ Start (State [ListItem j, ListItem i] (Counts c n 0 0)) > | ((i,j),n) <- zip coords [0..] ] > (Counts c c 0 0) -> test +> t > where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ] -> c = testCaseCount test +> c = testCaseCount t +> extendedTestTests :: Test > extendedTestTests = test [ > "test idempotent" ~: expect Succ $ test $ test $ test $ ok, diff --git a/tests/HUnitTestExtended.lhs b/tests/HUnitTestExtended.lhs --- a/tests/HUnitTestExtended.lhs +++ b/tests/HUnitTestExtended.lhs @@ -20,10 +20,10 @@ -- Hugs doesn't currently catch arithmetic exceptions. > "div by 0" ~: -> expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), +> expectUnspecifiedError (TestCase ((3 `div` 0 :: Integer) `seq` return ())), > "list ref out of bounds" ~: -> expectUnspecifiedError (TestCase ([1 .. 4] !! 10 `seq` return ())), +> expectUnspecifiedError (TestCase ([1 .. 4 :: Integer] !! 10 `seq` return ())), > "error" ~: > expectError "error" (TestCase (error "error")),