diff --git a/HUnit.cabal b/HUnit.cabal --- a/HUnit.cabal +++ b/HUnit.cabal @@ -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: . -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: . +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 diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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 . + +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. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -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 + diff --git a/Test/HUnit.hs b/Test/HUnit.hs new file mode 100644 --- /dev/null +++ b/Test/HUnit.hs @@ -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 + diff --git a/Test/HUnit.lhs b/Test/HUnit.lhs deleted file mode 100644 --- a/Test/HUnit.lhs +++ /dev/null @@ -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 diff --git a/Test/HUnit/Base.hs b/Test/HUnit/Base.hs new file mode 100644 --- /dev/null +++ b/Test/HUnit/Base.hs @@ -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 } diff --git a/Test/HUnit/Base.lhs b/Test/HUnit/Base.lhs deleted file mode 100644 --- a/Test/HUnit/Base.lhs +++ /dev/null @@ -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 } diff --git a/Test/HUnit/Lang.hs b/Test/HUnit/Lang.hs new file mode 100644 --- /dev/null +++ b/Test/HUnit/Lang.hs @@ -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 diff --git a/Test/HUnit/Lang.lhs b/Test/HUnit/Lang.lhs deleted file mode 100644 --- a/Test/HUnit/Lang.lhs +++ /dev/null @@ -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 diff --git a/Test/HUnit/Terminal.hs b/Test/HUnit/Terminal.hs new file mode 100644 --- /dev/null +++ b/Test/HUnit/Terminal.hs @@ -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) diff --git a/Test/HUnit/Terminal.lhs b/Test/HUnit/Terminal.lhs deleted file mode 100644 --- a/Test/HUnit/Terminal.lhs +++ /dev/null @@ -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) diff --git a/Test/HUnit/Text.hs b/Test/HUnit/Text.hs new file mode 100644 --- /dev/null +++ b/Test/HUnit/Text.hs @@ -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 diff --git a/Test/HUnit/Text.lhs b/Test/HUnit/Text.lhs deleted file mode 100644 --- a/Test/HUnit/Text.lhs +++ /dev/null @@ -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 diff --git a/doc/Guide.html b/doc/Guide.html new file mode 100644 --- /dev/null +++ b/doc/Guide.html @@ -0,0 +1,539 @@ + + + + + + + HUnit 1.0 User's Guide + + + +

HUnit 1.2 User's Guide

+ +

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

+ +

Introduction

+ +

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

+ +

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

+ +

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

+ +

Getting Started

+ +

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 + Text orientation with output to the Terminal.)

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

Isn't that easy?

+ +

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

+ 
+    tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3),
+                   "test2" ~: do (x, y) <- partA 3
+                                 assertEqual "for the first result of partA," 5 x
+                                 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
+    >
+
+ +

Writing Tests

+ +

Tests are specified compositionally. Assertions are combined to + make a test case, and test cases are combined into tests. HUnit also provides advanced + features for more convenient test specification.

+ +

Assertions

+ +

The basic building block of a test is an assertion.

+ 
+    type Assertion = IO ()
+
+

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

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

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

+ +

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

+ 
+    assertBool :: String -> Bool -> Assertion
+    assertBool msg b = unless b (assertFailure msg)
+
+    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
+
+

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

+ +

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

+ +

Test Case

+ +

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

+ +

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

+ +

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

+ +

Tests

+ +

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

+ +

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

+ 
+    data Test = TestCase Assertion
+              | TestList [Test]
+              | TestLabel String Test
+
+

There are three important features of this definition to note:

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

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

+ 
+    testCaseCount :: Test -> Int
+
+

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

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

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

+ +

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

+ +

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

+ 
+    testCasePaths :: Test -> [Path]
+
+ +

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

+ +

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

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

Advanced Features

+ +

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

+ +

The following operators can be used to construct assertions.

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

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

+ +

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

+ 
+    type AssertionPredicate = IO Bool
+
+    class AssertionPredicable t
+     where assertionPredicate :: t -> AssertionPredicate
+
+    instance AssertionPredicable Bool
+     where assertionPredicate = return
+
+    instance (AssertionPredicable t) => AssertionPredicable (IO t)
+     where assertionPredicate = (>>= assertionPredicate)
+
+

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

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

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

+ 
+    class ListAssertable t
+     where listAssert :: [t] -> Assertion
+
+    instance ListAssertable Char
+     where listAssert = assertString
+
+

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

+ +

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

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

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

+ +

The following operators can be used to construct tests.

+ 
+    infix  1 ~?, ~=?, ~?=
+    infixr 0 ~:
+
+    (~?) :: (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)
+
+

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

+ +

Running Tests

+ +

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

+ +

Test Execution

+ +

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

+ +

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

+ 
+    data Counts = Counts { cases, tried, errors, failures :: Int }
+      deriving (Eq, Show, Read)
+
+
    +
  • cases is the number of test cases included in the test. This number is a + static property of a test and remains unchanged during test execution.
    • +
  • tried is the number of test cases that have been executed so far during the + test execution.
    • +
  • errors is the number of test cases whose execution ended with an unexpected + exception being raised. Errors indicate problems with test cases, as opposed to the + code under test.
    • +
  • failures is the number of test cases whose execution asserted failure. + Failures indicate problems with the code under test.
    • +
+

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

+ +

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

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

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

+ +

Text-Based Controller

+ +

A text-based test controller is included with HUnit.

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

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

+ +

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

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

The function showCounts shows a set of counts.

+ 
+    showCounts :: Counts -> String
+
+

The form of its result is + "Cases: cases  Tried: tried  Errors: errors  Failures: failures" + where cases, tried, errors, and failures are the count + values.

+ +

The function showPath shows a test case path.

+ 
+    showPath :: Path -> String
+
+

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

+ +

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

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

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

+ 
+    putTextToShowS :: PutText ShowS
+
+

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

+ +

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

+ 
+    runTestTT :: Test -> IO Counts
+
+

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

+ + +

References

+ +
+ +
[1] Gamma, E., et al. Design Patterns: Elements of Reusable + Object-Oriented Software, Addison-Wesley, Reading, MA, 1995.
+
The classic book describing design patterns in an object-oriented context.
+ +
+ http://www.junit.org +
+
Web page for JUnit, the tool after which HUnit is modeled.
+ +
+ + http://junit.sourceforge.net/doc/testinfected/testing.htm +
+
A good introduction to test-first development and the use of JUnit.
+ +
+ + http://junit.sourceforge.net/doc/cookstour/cookstour.htm +
+
A description of the internal structure of JUnit. Makes for an interesting + comparison between JUnit and HUnit.
+ +
+ +
+ +

The HUnit software and this guide were written by Dean Herington (heringto@cs.unc.edu).

+ + diff --git a/examples/Example.hs b/examples/Example.hs new file mode 100644 --- /dev/null +++ b/examples/Example.hs @@ -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' diff --git a/prologue.txt b/prologue.txt new file mode 100644 --- /dev/null +++ b/prologue.txt @@ -0,0 +1,2 @@ +HUnit is a unit testing framework for Haskell, inspired by the JUnit +tool for Java, see: . diff --git a/tests/HUnitTest98.lhs b/tests/HUnitTest98.lhs new file mode 100644 --- /dev/null +++ b/tests/HUnitTest98.lhs @@ -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]) diff --git a/tests/HUnitTestBase.lhs b/tests/HUnitTestBase.lhs new file mode 100644 --- /dev/null +++ b/tests/HUnitTestBase.lhs @@ -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]] + +> ] diff --git a/tests/HUnitTestExtended.lhs b/tests/HUnitTestExtended.lhs new file mode 100644 --- /dev/null +++ b/tests/HUnitTestExtended.lhs @@ -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) + +> ] diff --git a/tests/HUnitTests.cabal b/tests/HUnitTests.cabal new file mode 100644 --- /dev/null +++ b/tests/HUnitTests.cabal @@ -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 + diff --git a/tests/Setup.hs b/tests/Setup.hs new file mode 100644 --- /dev/null +++ b/tests/Setup.hs @@ -0,0 +1,7 @@ +#!/usr/bin/env runghc +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/tests/TerminalTest.lhs b/tests/TerminalTest.lhs new file mode 100644 --- /dev/null +++ b/tests/TerminalTest.lhs @@ -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 +> ]