HUnit 1.2.2.1 → 1.2.2.3

raw patch · 6 files changed

+315/−269 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• HUnit.cabal +9/−2
• Test/HUnit/Base.hs +201/−201
• Test/HUnit/Lang.hs +1/−1
• Test/HUnit/Text.hs +12/−12
• tests/HUnitTestBase.lhs +90/−51
• tests/HUnitTestExtended.lhs +2/−2

@@ -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)

@@ -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 }

@@ -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
 

@@ -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'

@@ -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,

@@ -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")),