HUnit 1.2.0.3 → 1.2.2.0
raw patch · 22 files changed
+1907/−527 lines, 22 filesdep ~basebuild-type:Customsetup-changednew-component:exe:basic-testsnew-component:exe:extended-testsnew-component:exe:terminal-testsnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- HUnit.cabal +80/−27
- README +12/−0
- Setup.hs +21/−1
- Test/HUnit.hs +80/−0
- Test/HUnit.lhs +0/−11
- Test/HUnit/Base.hs +355/−0
- Test/HUnit/Base.lhs +0/−228
- Test/HUnit/Lang.hs +119/−0
- Test/HUnit/Lang.lhs +0/−104
- Test/HUnit/Terminal.hs +42/−0
- Test/HUnit/Terminal.lhs +0/−31
- Test/HUnit/Text.hs +128/−0
- Test/HUnit/Text.lhs +0/−125
- doc/Guide.html +539/−0
- examples/Example.hs +40/−0
- prologue.txt +2/−0
- tests/HUnitTest98.lhs +9/−0
- tests/HUnitTestBase.lhs +382/−0
- tests/HUnitTestExtended.lhs +39/−0
- tests/HUnitTests.cabal +28/−0
- tests/Setup.hs +7/−0
- tests/TerminalTest.lhs +24/−0
HUnit.cabal view
@@ -1,34 +1,87 @@-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: <http://www.junit.org>.-build-type: Simple+Name: HUnit+Version: 1.2.2.0+Cabal-Version: >= 1.2+License: BSD3+License-File: LICENSE+Author: Dean Herington+Maintainer: hunit@richardg.name+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: <http://www.junit.org>.+Tested-With:+ GHC == 6.10.4+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 -library- build-depends: base <5+Library+ Build-Depends: base <5 if flag(base4)- build-depends: base >=4- cpp-options: -DBASE4+ Build-Depends: base >=4+ CPP-Options: -DBASE4 else- build-depends: base <4+ Build-Depends: base <4 if impl(ghc >= 6.10)- 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 +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
+ README view
@@ -0,0 +1,12 @@+HUnit is a unit testing framework for Haskell, inspired by the JUnit+tool for Java. HUnit is free software; see its "License" file for+details. HUnit is available at <http://hunit.sourceforge.net>.++HUnit 1.1.1 consists of a number of files. Besides Haskell source files+in Test/HUnit (whose names end in ".hs" or ".lhs"), these files include:++ * README -- this file+ * doc/Guide.html -- user's guide, in HTML format+ * LICENSE -- license for use of HUnit++See the user's guide for more information.
Setup.hs view
@@ -1,6 +1,26 @@+#!/usr/bin/env runhaskell module Main (main) where +import Data.List (isSuffixOf)+import Distribution.PackageDescription import Distribution.Simple+import System.FilePath+import System.Process main :: IO ()-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 +
+ Test/HUnit.hs view
@@ -0,0 +1,80 @@+-- | 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 +
− Test/HUnit.lhs
@@ -1,11 +0,0 @@-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
+ Test/HUnit/Base.hs view
@@ -0,0 +1,355 @@+-- | 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 }
− Test/HUnit/Base.lhs
@@ -1,228 +0,0 @@-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 }
+ Test/HUnit/Lang.hs view
@@ -0,0 +1,119 @@+-- | 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
− Test/HUnit/Lang.lhs
@@ -1,104 +0,0 @@-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
+ Test/HUnit/Terminal.hs view
@@ -0,0 +1,42 @@+-- | 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)
− Test/HUnit/Terminal.lhs
@@ -1,31 +0,0 @@-> 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)
+ Test/HUnit/Text.hs view
@@ -0,0 +1,128 @@+-- | 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
− Test/HUnit/Text.lhs
@@ -1,125 +0,0 @@-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
+ doc/Guide.html view
@@ -0,0 +1,539 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">+<html xmlns="http://www.w3.org/1999/xhtml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"+ xsi:schemaLocation="http://www.w3.org/MarkUp/SCHEMA/xhtml11.xsd" xml:lang="en">+ <head>+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>+ <meta name="Author" content="Dean Herington"/>+ <meta name="KeyWords" content="HUnit, unit testing, test-first development, Haskell, JUnit"/>+ <title>HUnit 1.0 User's Guide</title>+ </head>+ <body>++ <h1>HUnit 1.2 User's Guide</h1>++ <p>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 <a+ href="http://code.haskell.org/HUnit">http://code.haskell.org/HUnit</a>.</p>++ <h2>Introduction</h2>++ <p>A test-centered methodology for software development is most effective when tests are+ easy to create, change, and execute. The <a href="http://www.junit.org">JUnit</a> tool+ pioneered support for test-first development in <a href="http://java.sun.com">Java</a>.+ HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely functional+ programming language. (To learn more about Haskell, see <a href="http://www.haskell.org"+ >http://www.haskell.org</a>.)</p>++ <p>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?)</p>++ <p>The next section helps you get started using HUnit in simple ways. Subsequent sections+ give details on <a href="#WritingTests">writing tests</a> and <a href="#RunningTests"+ >running tests</a>. The document concludes with a section describing HUnit's <a+ href="#ConstituentFiles">constituent files</a> and a section giving <a+ href="#References">references</a> to further information.</p>++ <h2 id="GettingStarted">Getting Started</h2>++ <p>In the Haskell module where your tests will reside, import module <tt>Test.HUnit</tt>:</p>+ <pre>+ import Test.HUnit+</pre>+ <p>Define test cases as appropriate:</p>+ <pre>+ 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)+</pre>+ <p>Name the test cases and group them together:</p>+ <pre>+ tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]+</pre>+ <p>Run the tests as a group. At a Haskell interpreter prompt, apply the function+ <tt>runTestTT</tt> to the collected tests. (The "<tt>TT</tt>" suggests+ <strong>T</strong>ext orientation with output to the <strong>T</strong>erminal.)</p>+ <pre>+ > runTestTT tests+ Cases: 2 Tried: 2 Errors: 0 Failures: 0+ >+</pre>+ <p>If the tests are proving their worth, you might see:</p>+ <pre>+ > runTestTT tests+ ### Failure in: 0:test1+ for (foo 3),+ expected: (1,2)+ but got: (1,3)+ Cases: 2 Tried: 2 Errors: 0 Failures: 1+ >+</pre>+ <p>Isn't that easy?</p>++ <p>You can specify tests even more succinctly using operators and overloaded functions that+ HUnit provides:</p>+ <pre>+ 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" ]+</pre>+ <p>Assuming the same test failures as before, you would see:</p>+ <pre>+ > runTestTT tests+ ### Failure in: 0:test1:(foo 3)+ expected: (1,2)+ but got: (1,3)+ Cases: 2 Tried: 2 Errors: 0 Failures: 1+ >+</pre>++ <h2 id="WritingTests">Writing Tests</h2>++ <p>Tests are specified compositionally. <a href="#Assertions">Assertions</a> are combined to+ make a <a href="#TestCase">test case</a>, and test cases are combined into <a+ href="#Tests">tests</a>. HUnit also provides <a href="#AdvancedFeatures">advanced+ features</a> for more convenient test specification.</p>++ <h3 id="Assertions">Assertions</h3>++ <p>The basic building block of a test is an <b>assertion</b>.</p>+ <pre>+ type Assertion = IO ()+</pre>+ <p>An assertion is an <tt>IO</tt> computation that always produces a void result. Why is an+ assertion an <tt>IO</tt> 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 <tt>assertFailure</tt>.</p>+ <pre>+ assertFailure :: String -> Assertion+ assertFailure msg = ioError (userError ("HUnit:" ++ msg))+</pre>+ <p><tt>(assertFailure msg)</tt> raises an exception. The string argument identifies the+ failure. The failure message is prefixed by "<tt>HUnit:</tt>" 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 <tt>assertFailure</tt> are subject to change and should+ not be relied upon.)</p>++ <p><tt>assertFailure</tt> can be used directly, but it is much more common to use it+ indirectly through other assertion functions that conditionally assert failure.</p>+ <pre>+ 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+</pre>+ <p>With <tt>assertBool</tt> you give the assertion condition and failure message separately.+ With <tt>assertString</tt> the two are combined. With <tt>assertEqual</tt> 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 <a href="#AdvancedFeatures">Advanced Features</a>.</p>++ <p>Since assertions are <tt>IO</tt> computations, they may be combined--along with other+ <tt>IO</tt> computations--using <tt>(>>=)</tt>, <tt>(>>)</tt>, and the <tt>do</tt>+ notation. As long as its result is of type <tt>(IO ())</tt>, 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.</p>++ <h3 id="TestCase">Test Case</h3>++ <p>A <b>test case</b> 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.</p>++ <p>A test case consists of a single, possibly collective, assertion. The possibly multiple+ constituent assertions in a test case's collective assertion are <b>not</b> 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+ <tt>IO.bracket</tt> function to achieve the desired effect.</p>++ <p>You can make a test case from an assertion by applying the <tt>TestCase</tt> constructor.+ For example, <tt>(TestCase (return ()))</tt> is a test case that never+ fails, and+ <tt>(TestCase (assertEqual "for x," 3 x))</tt>+ is a test case that checks that the value of <tt>x</tt> is 3. Additional ways+ to create test cases are described later under <a href="#AdvancedFeatures">Advanced+ Features</a>.</p>++ <h3 id="Tests">Tests</h3>++ <p>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.</p>++ <p>In tune with the "composite" design pattern [<a href="#DesignPatterns">1</a>], a+ <b>test</b> 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.</p>+ <pre>+ data Test = TestCase Assertion+ | TestList [Test]+ | TestLabel String Test+</pre>+ <p>There are three important features of this definition to note:</p>+ <ul>+ <li>A <tt>TestList</tt> consists of a list of tests rather than a list of test cases.+ This means that the structure of a <tt>Test</tt> is actually a tree. Using a+ hierarchy helps organize tests just as it helps organize files in a file system.</li>+ <li>A <tt>TestLabel</tt> 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.</li>+ <li>A <tt>TestLabel</tt> is separate from both <tt>TestCase</tt> and <tt>TestList</tt>.+ 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.</li>+ </ul>+ <p>The number of test cases that a test comprises can be computed with+ <tt>testCaseCount</tt>.</p>+ <pre>+ testCaseCount :: Test -> Int+</pre>+ <p>As mentioned above, a test is identified by its <b>path</b> in the test hierarchy.</p>+ <pre>+ data Node = ListItem Int | Label String+ deriving (Eq, Show, Read)++ type Path = [Node] -- Node order is from test case to root.+</pre>+ <p>Each occurrence of <tt>TestList</tt> gives rise to a <tt>ListItem</tt> and each+ occurrence of <tt>TestLabel</tt> gives rise to a <tt>Label</tt>. The <tt>ListItem</tt>s+ by themselves ensure uniqueness among test case paths, while the <tt>Label</tt>s allow+ you to add mnemonic names for individual test cases and collections of them.</p>++ <p>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.</p>++ <p>The paths of the test cases that a test comprises can be computed with+ <tt>testCasePaths</tt>. The paths are listed in the order in which the corresponding+ test cases would be executed.</p>+ <pre>+ testCasePaths :: Test -> [Path]+</pre>++ <p>The three variants of <tt>Test</tt> can be constructed simply by applying+ <tt>TestCase</tt>, <tt>TestList</tt>, and <tt>TestLabel</tt> to appropriate arguments.+ Additional ways to create tests are described later under <a href="#AdvancedFeatures"+ >Advanced Features</a>.</p>++ <p>The design of the type <tt>Test</tt> provides great conciseness, flexibility, and+ convenience in specifying tests. Moreover, the nature of Haskell significantly augments+ these qualities:</p>+ <ul>+ <li>Combining assertions and other code to construct test cases is easy with the+ <tt>IO</tt> monad.</li>+ <li>Using overloaded functions and special operators (see below), specification of+ assertions and tests is extremely compact.</li>+ <li>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.</li>+ <li>Haskell's powerful abstraction facilities provide unmatched support for test+ refactoring.</li>+ </ul>++ <h3 id="AdvancedFeatures">Advanced Features</h3>++ <p>HUnit provides additional features for specifying assertions and tests more conveniently+ and concisely. These facilities make use of Haskell type classes.</p>++ <p>The following operators can be used to construct assertions.</p>+ <pre>+ 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+</pre>+ <p>You provide a boolean condition and failure message separately to <tt>(@?)</tt>, as for+ <tt>assertBool</tt>, but in a different order. The <tt>(@=?)</tt> and <tt>(@?=)</tt>+ operators provide shorthands for <tt>assertEqual</tt> 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.)</p>++ <p>The <tt>(@?)</tt> operator's first argument is something from which an assertion+ predicate can be made, that is, its type must be <tt>AssertionPredicable</tt>.</p>+ <pre>+ 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)+</pre>+ <p>The overloaded <tt>assert</tt> function in the <tt>Assertable</tt> type class constructs+ an assertion.</p>+ <pre>+ 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)+</pre>+ <p>The <tt>ListAssertable</tt> class allows <tt>assert</tt> to be applied to <tt>[Char]</tt>+ (that is, <tt>String</tt>).</p>+ <pre>+ class ListAssertable t+ where listAssert :: [t] -> Assertion++ instance ListAssertable Char+ where listAssert = assertString+</pre>+ <p>With the above declarations, <tt>(assert ())</tt>,+ <tt>(assert True)</tt>, and <tt>(assert "")</tt> (as well as+ <tt>IO</tt> forms of these values, such as <tt>(return ())</tt>) are all+ assertions that never fail, while <tt>(assert False)</tt> and+ <tt>(assert "some failure message")</tt> (and their+ <tt>IO</tt> forms) are assertions that always fail. You may define additional+ instances for the type classes <tt>Assertable</tt>, <tt>ListAssertable</tt>, and+ <tt>AssertionPredicable</tt> if that should be useful in your application.</p>++ <p>The overloaded <tt>test</tt> function in the <tt>Testable</tt> type class constructs a+ test.</p>+ <pre>+ 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+</pre>+ <p>The <tt>test</tt> function makes a test from either an <tt>Assertion</tt> (using+ <tt>TestCase</tt>), a list of <tt>Testable</tt> items (using <tt>TestList</tt>), or+ a <tt>Test</tt> (making no change).</p>++ <p>The following operators can be used to construct tests.</p>+ <pre>+ 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)+</pre>+ <p><tt>(~?)</tt>, <tt>(~=?)</tt>, and <tt>(~?=)</tt> each make an assertion, as for+ <tt>(@?)</tt>, <tt>(@=?)</tt>, and <tt>(@?=)</tt>, respectively, and then a test case+ from that assertion. <tt>(~:)</tt> attaches a label to something that is+ <tt>Testable</tt>. You may define additional instances for the type class+ <tt>Testable</tt> should that be useful.</p>++ <h2 id="RunningTests">Running Tests</h2>++ <p>HUnit is structured to support multiple test controllers. The first subsection below+ describes the <a href="#TestExecution">test execution</a> characteristics common to all+ test controllers. The second subsection describes the <a href="#Text-BasedController"+ >text-based controller</a> that is included with HUnit.</p>++ <h3 id="TestExecution">Test Execution</h3>++ <p>All test controllers share a common test execution model. They differ only in how the+ results of test execution are shown.</p>++ <p>The execution of a test (a value of type <tt>Test</tt>) involves the serial execution (in+ the <tt>IO</tt> 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:</p>+ <pre>+ data Counts = Counts { cases, tried, errors, failures :: Int }+ deriving (Eq, Show, Read)+</pre>+ <ul>+ <li><tt>cases</tt> 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.</li>+ <li><tt>tried</tt> is the number of test cases that have been executed so far during the+ test execution.</li>+ <li><tt>errors</tt> 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.</li>+ <li><tt>failures</tt> is the number of test cases whose execution asserted failure.+ Failures indicate problems with the code under test.</li>+ </ul>+ <p>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+ <tt>(tried - (errors + failures))</tt>. 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.</p>++ <p>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.)</p>+ <ul>+ <li><i>start</i> -- 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.</li>+ <li><i>error</i> -- 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).</li>+ <li><i>failure</i> -- 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).</li>+ </ul>+ <p>Typically, a test controller shows <i>error</i> and <i>failure</i> reports immediately+ but uses the <i>start</i> report merely to update an indication of overall test+ execution progress.</p>++ <h3 id="Text-BasedController">Text-Based Controller</h3>++ <p>A text-based test controller is included with HUnit.</p>+ <pre>+ runTestText :: PutText st -> Test -> IO (Counts, st)+</pre>+ <p><tt>runTestText</tt> is generalized on a <i>reporting scheme</i> 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.</p>++ <p>The strings for the three kinds of reporting event are as follows.</p>+ <ul>+ <li>A <i>start</i> report is the result of the function <tt>showCounts</tt> applied to+ the counts current immediately prior to initiation of the test case being started.</li>+ <li>An <i>error</i> report is of the form+ "<tt>Error in: <i>path</i>\n<i>message</i></tt>",+ where <i>path</i> is the path of the test case in error, as shown by+ <tt>showPath</tt>, and <i>message</i> is a message describing the error. If the path+ is empty, the report has the form "<tt>Error:\n<i>message</i></tt>".</li>+ <li>A <i>failure</i> report is of the form+ "<tt>Failure in: <i>path</i>\n<i>message</i></tt>", where+ <i>path</i> is the path of the test case in error, as shown by+ <tt>showPath</tt>, and <i>message</i> is the failure message. If the path is empty,+ the report has the form "<tt>Failure:\n<i>message</i></tt>".</li>+ </ul>++ <p>The function <tt>showCounts</tt> shows a set of counts.</p>+ <pre>+ showCounts :: Counts -> String+</pre>+ <p>The form of its result is+ "<tt>Cases: <i>cases</i> Tried: <i>tried</i> Errors: <i>errors</i> Failures: <i>failures</i></tt>"+ where <i>cases</i>, <i>tried</i>, <i>errors</i>, and <i>failures</i> are the count+ values.</p>++ <p>The function <tt>showPath</tt> shows a test case path.</p>+ <pre>+ showPath :: Path -> String+</pre>+ <p>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 '<tt>:</tt>' separators. The+ representation for <tt>(ListItem <i>n</i>)</tt> is <tt>(show n)</tt>. The representation+ for <tt>(Label <i>label</i>)</tt> is normally <i>label</i>. However, if <i>label</i>+ contains a colon or if <tt>(show <i>label</i>)</tt> is different from <i>label</i>+ surrounded by quotation marks--that is, if any ambiguity could exist--then <tt>(Label+ <i>label</i>)</tt> is represented as <tt>(show <i>label</i>)</tt>.</p>++ <p>HUnit includes two reporting schemes for the text-based test controller. You may define+ others if you wish.</p>+ <pre>+ putTextToHandle :: Handle -> Bool -> PutText Int+</pre>+ <p><tt>putTextToHandle</tt> 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 <tt>True</tt>, 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.</p>+ <pre>+ putTextToShowS :: PutText ShowS+</pre>+ <p><tt>putTextToShowS</tt> 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 <tt>runTestText</tt>) as a <tt>ShowS</tt>+ function (that is, one with type <tt>(String -> String)</tt>) whose+ first argument is a string to be appended to the accumulated report lines.</p>++ <p>HUnit provides a shorthand for the most common use of the text-based test controller.</p>+ <pre>+ runTestTT :: Test -> IO Counts+</pre>+ <p><tt>runTestTT</tt> invokes <tt>runTestText</tt>, specifying <tt>(putTextToHandle stderr+ True)</tt> for the reporting scheme, and returns the final counts from the test+ execution.</p>+++ <h2 id="References">References</h2>++ <dl>++ <dt id="DesignPatterns">[1] Gamma, E., et al. Design Patterns: Elements of Reusable+ Object-Oriented Software, Addison-Wesley, Reading, MA, 1995.</dt>+ <dd>The classic book describing design patterns in an object-oriented context.</dd>++ <dt>+ <a href="http://www.junit.org">http://www.junit.org</a>+ </dt>+ <dd>Web page for JUnit, the tool after which HUnit is modeled.</dd>++ <dt>+ <a href="http://junit.sourceforge.net/doc/testinfected/testing.htm">+ http://junit.sourceforge.net/doc/testinfected/testing.htm</a>+ </dt>+ <dd>A good introduction to test-first development and the use of JUnit.</dd>++ <dt>+ <a href="http://junit.sourceforge.net/doc/cookstour/cookstour.htm">+ http://junit.sourceforge.net/doc/cookstour/cookstour.htm</a>+ </dt>+ <dd>A description of the internal structure of JUnit. Makes for an interesting+ comparison between JUnit and HUnit.</dd>++ </dl>++ <hr/>++ <p>The HUnit software and this guide were written by Dean Herington (<a+ href="mailto:heringto@cs.unc.edu">heringto@cs.unc.edu</a>).</p>+ </body>+</html>
+ examples/Example.hs view
@@ -0,0 +1,40 @@+-- 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++import Test.HUnit+++foo :: Int -> (Int, Int)+foo x = (1, x)++partA :: Int -> IO (Int, Int)+partA v = return (v+2, v+3)++partB :: Int -> IO Bool+partB v = return (v > 5)++test1 :: Test+test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3))++test2 :: Test+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)++tests :: Test+tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]++tests' :: Test+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" ]++main :: IO Counts+main = do runTestTT tests+ runTestTT tests'
+ prologue.txt view
@@ -0,0 +1,2 @@+HUnit is a unit testing framework for Haskell, inspired by the JUnit+tool for Java, see: <http://www.junit.org>.
+ tests/HUnitTest98.lhs view
@@ -0,0 +1,9 @@+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])
+ tests/HUnitTestBase.lhs view
@@ -0,0 +1,382 @@+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]]++> ]
+ tests/HUnitTestExtended.lhs view
@@ -0,0 +1,39 @@+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)++> ]
+ tests/HUnitTests.cabal view
@@ -0,0 +1,28 @@+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+
+ tests/Setup.hs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runghc+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ tests/TerminalTest.lhs view
@@ -0,0 +1,24 @@+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+> ]