[[project @ 2004-03-26 11:23:10 by malcolm]
malcolm**20040326112310
Import the HUnit unit-testing framework into the hierarchical libraries
under Test.HUnit. There is not yet a build system to make this into
a library package for any compiler.
] {
addfile ./Example.hs
addfile ./Guide.html
addfile ./License
addfile ./README
adddir ./src
adddir ./src/Test
adddir ./src/Test/HUnit
addfile ./src/Test/HUnit.lhs
addfile ./src/Test/HUnit/Base.lhs
addfile ./src/Test/HUnit/Lang.lhs
addfile ./src/Test/HUnit/Lang98.lhs
addfile ./src/Test/HUnit/LangExtended.lhs
addfile ./src/Test/HUnit/Terminal.lhs
addfile ./src/Test/HUnit/Text.lhs
adddir ./test
addfile ./test/HUnitTest98.lhs
addfile ./test/HUnitTestBase.lhs
addfile ./test/HUnitTestExtended.lhs
addfile ./test/TerminalTest.lhs
hunk ./Example.hs 1
+-- Example.hs -- Examples from HUnit user's guide
+
+-- $Id: Example.hs,v 1.1 2004/03/26 11:23:07 malcolm Exp $
+
+
+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 = 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)
+
+tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]
+
+
+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 = do runTestTT tests
+ runTestTT tests'
hunk ./Guide.html 1
+
+
+
+
+
+
+
+ HUnit 1.0 User's Guide
+
+
+
+HUnit 1.0 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://hunit.sourceforge.net.
+
+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.
+
+
+
+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.
+
+
+
+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.
+
+
+
+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.
+
+
+
+HUnit 1.0 consists of the following files.
+
+
+- Guide.html
+
-
+This document.
+
- Example.hs
+
-
+Haskell module that includes the examples given in the Getting Started section. Run this
+program to make sure you understand how to use HUnit.
+
- src/Test/HUnit.lhs
+
-
+Haskell module that you import to use HUnit.
+
- src/Test/HUnit/Base.lhs
+
-
+Haskell module that defines HUnit's basic facilities.
+
- src/Test/HUnit/Lang.lhs
+
-
+Haskell module that defines how assertion failure is signaled and
+caught. By default, it is a copy of
+src/Test/HUnit/Lang98.lhs. Replace it by a copy of
+src/Test/HUnit/LangExtended.lhs for more robust exception behavior.
+
- src/Test/HUnit/Lang98.lhs
+
-
+Haskell module that defines generic assertion failure handling.
+It is compliant to Haskell 98 but catches only IO errors.
+
- src/Test/HUnit/LangExtended.lhs
+
-
+Haskell module that defines more robust assertion failure
+handling. It catches more (though unfortunately not all) kinds
+of exceptions. However, it works only with Hugs (Dec. 2001 or
+later) and GHC (5.00 and later).
+
- test/HUnitTest98.lhs
+
-
+Haskell module that tests HUnit, assuming the generic assertion
+failure handling of HUnitLang98.lhs.
+
- test/HUnitTestBase.lhs
+
-
+Haskell module that defines testing support and basic (Haskell 98
+compliant) tests of HUnit (using HUnit, of course!). Contains
+more extensive and advanced examples of testing with HUnit.
+
- test/HUnitTestExtended.lhs
+
-
+Haskell module that tests HUnit, assuming the extended assertion
+failure handling of HUnitLangExc.lhs.
+
- src/Test/HUnit/Text.lhs
+
-
+Haskell module that defines HUnit's text-based test controller.
+
- License
+
-
+The license for use of HUnit.
+
- src/Test/HUnit/Terminal.lhs
+
-
+Haskell module that assists in checking the output of HUnit tests
+performed by the text-based test controller.
+
- test/TerminalTest.lhs
+
-
+Haskell module that tests src/Test/HUnit/Terminal.lhs (using HUnit, of
+course!).
+
+
+
+
+
+
+-
+[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).
+
+
+HUnit development is supported by
+
+
+
+
+
+[$Revision: 1.1 $ $Date: 2004/03/26 11:23:07 $]
+
+
+
hunk ./License 1
+HUnit is Copyright (c) Dean Herington, 2002, all rights reserved,
+and is distributed as free software under the following license.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+- Redistributions of source code must retain the above copyright
+notice, this list of conditions, and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions, and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+- The names of the copyright holders may not be used to endorse or
+promote products derived from this software without specific prior
+written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
hunk ./README 1
+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.0 consists of a number of files. Besides Haskell source files
+(whose names end in ".hs" or ".lhs"), these files include:
+
+ * README -- this file
+ * Guide.html -- user's guide, in HTML format
+ * License -- license for use of HUnit
+
+See the user's guide for more information.
hunk ./src/Test/HUnit/Base.lhs 1
+HUnitBase.lhs -- basic definitions
+
+$Id: Base.lhs,v 1.1 2004/03/26 11:23:09 malcolm Exp $
+
+> 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 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 }
hunk ./src/Test/HUnit/Lang.lhs 1
+Test/HUnit/Lang.lhs -- HUnit language support.
+
+Module `Test.HUnit.Lang` is a mere redirection to *one* of the following:
+ Test.HUnit.Lang98
+ Test.HUnit.LangExtended
+
+$Id: Lang.lhs,v 1.1 2004/03/26 11:23:09 malcolm Exp $
+
+> module Test.HUnit.Lang
+> (
+> Assertion,
+> assertFailure,
+> performTestCase
+> )
+> where
+
+
+Import for re-export
+--------------------
+
+> import Test.HUnit.Lang98
+
+The alternative is:
+
+ import Test.HUnit.LangExtended
+
hunk ./src/Test/HUnit/Lang98.lhs 1
+HUnitLang98.lhs -- HUnit language support, generic Haskell 98 variant
+
+$Id: Lang98.lhs,v 1.1 2004/03/26 11:23:09 malcolm Exp $
+
+> module Test.HUnit.Lang98
+> (
+> 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 List (isPrefixOf)
+> import IO (ioeGetErrorString, try)
+
+
+
+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
+---------------
+
+> hunitPrefix = "HUnit:"
+
+> hugsPrefix = "IO Error: User error\nReason: "
+> nhc98Prefix = "I/O error (user-defined), call to function `userError':\n "
+> -- GHC prepends no prefix to the user-supplied string.
+
+> 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 hugsPrefix s0
+> (_, s2) = dropPrefix nhc98Prefix s1
+> in dropPrefix hunitPrefix s2
+> dropPrefix pref str = if pref `isPrefixOf` str
+> then (True, drop (length pref) str)
+> else (False, str)
hunk ./src/Test/HUnit/LangExtended.lhs 1
+HUnitLangExc.lhs -- HUnit language support, using `Exception` type
+
+$Id: LangExtended.lhs,v 1.1 2004/03/26 11:23:09 malcolm Exp $
+
+> module Test.HUnit.LangExtended
+> (
+> 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 List (isPrefixOf)
+> import qualified Exception (try)
+
+
+
+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
+---------------
+
+> hunitPrefix = "HUnit:"
+
+> hugsPrefix = "IO Error: User error\nReason: "
+> -- GHC prepends no prefix to the user-supplied string.
+
+> assertFailure msg = ioError (userError (hunitPrefix ++ msg))
+
+> performTestCase action = do r <- Exception.try action
+> case r of Right () -> return Nothing
+> Left e -> return (Just (decode e))
+> where
+> decode e = let s0 = show e
+> (_, s1) = dropPrefix hugsPrefix s0
+> in dropPrefix hunitPrefix s1
+> dropPrefix pref str = if pref `isPrefixOf` str
+> then (True, drop (length pref) str)
+> else (False, str)
hunk ./src/Test/HUnit/Terminal.lhs 1
+> module Test.HUnit.Terminal
+> (
+> terminalAppearance
+> )
+> where
+
+> import 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 accumlating `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)
hunk ./src/Test/HUnit/Text.lhs 1
+HUnitText.lhs -- text-based test controller
+
+$Id: Text.lhs,v 1.1 2004/03/26 11:23:10 malcolm Exp $
+
+> module Test.HUnit.Text
+> (
+> PutText(..),
+> putTextToHandle, putTextToShowS,
+> runTestText,
+> showPath, showCounts,
+> runTestTT
+> )
+> where
+
+> import Test.HUnit.Base
+
+> import Monad (when)
+> import 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
hunk ./src/Test/HUnit.lhs 1
+HUnit.lhs -- interface module for HUnit
+
+$Id: HUnit.lhs,v 1.1 2004/03/26 11:23:08 malcolm Exp $
+
+> module Test.HUnit
+> (
+> module Test.HUnit.Base,
+> module Test.HUnit.Text
+> )
+> where
+
+> import Test.HUnit.Base
+> import Test.HUnit.Text
hunk ./test/HUnitTest98.lhs 1
+HUnitTest98.lhs -- test for HUnit, using Haskell language system "98"
+
+$Id: HUnitTest98.lhs,v 1.1 2004/03/26 11:23:10 malcolm Exp $
+
+> module Main (main) where
+
+> import Test.HUnit
+> import HUnitTestBase
+
+
+> main = runTestTT (test [baseTests])
hunk ./test/HUnitTestBase.lhs 1
+HUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant)
+
+$Id: HUnitTestBase.lhs,v 1.1 2004/03/26 11:23:10 malcolm Exp $
+
+> module HUnitTestBase where
+
+> import Test.HUnit
+> import Test.HUnit.Terminal (terminalAppearance)
+> import IO (IOMode(..), openFile, hClose)
+
+
+> data Report = Start State
+> | Error String State
+> | UnspecifiedError State
+> | Failure String State
+> deriving (Show, Read)
+
+> instance Eq Report where
+> Start s1 == Start s2 = s1 == s2
+> Error m1 s1 == Error m2 s2 = m1 == m2 && s1 == s2
+> Error m1 s1 == UnspecifiedError s2 = s1 == s2
+> UnspecifiedError s1 == Error m2 s2 = s1 == s2
+> UnspecifiedError s1 == UnspecifiedError s2 = s1 == s2
+> Failure m1 s1 == Failure m2 s2 = m1 == m2 && s1 == s2
+> _ == _ = False
+
+
+> expectReports :: [Report] -> Counts -> Test -> Test
+> expectReports reports counts test = TestCase $ do
+> (counts', reports') <- performTest (\ ss us -> return (Start ss : us))
+> (\m ss us -> return (Error m ss : us))
+> (\m ss us -> return (Failure m ss : us))
+> [] test
+> assertEqual "for the reports from a test," reports (reverse reports')
+> assertEqual "for the counts from a test," counts counts'
+
+
+> simpleStart = Start (State [] (Counts 1 0 0 0))
+
+> expectSuccess :: Test -> Test
+> expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0)
+
+> expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test
+> expectProblem kind err msg =
+> expectReports [simpleStart, kind msg (State [] counts)] counts
+> where counts = Counts 1 1 err (1-err)
+
+> expectError, expectFailure :: String -> Test -> Test
+> expectError = expectProblem Error 1
+> expectFailure = expectProblem Failure 0
+
+> expectUnspecifiedError :: Test -> Test
+> expectUnspecifiedError = expectProblem (\ msg st -> UnspecifiedError st) 1 undefined
+
+
+> data Expect = Succ | Err String | UErr | Fail String
+
+> expect :: Expect -> Test -> Test
+> expect Succ test = expectSuccess test
+> expect (Err m) test = expectError m test
+> expect UErr test = expectUnspecifiedError test
+> expect (Fail m) test = expectFailure m test
+
+
+
+> baseTests = test [ assertTests,
+> testCaseCountTests,
+> testCasePathsTests,
+> reportTests,
+> textTests,
+> showPathTests,
+> showCountsTests,
+> assertableTests,
+> predicableTests,
+> compareTests,
+> extendedTestTests ]
+
+
+> ok = test (assert ())
+> bad m = test (assertFailure m)
+
+
+> assertTests = test [
+
+> "null" ~: expectSuccess ok,
+
+> "userError" ~:
+> expectError "error" (TestCase (ioError (userError "error"))),
+
+> "IO error (file missing)" ~:
+> expectUnspecifiedError
+> (test (do openFile "3g9djs" ReadMode; return ())),
+
+ "error" ~:
+ expectError "error" (TestCase (error "error")),
+
+ "tail []" ~:
+ expectUnspecifiedError (TestCase (tail [] `seq` return ())),
+
+ -- GHC doesn't currently catch arithmetic exceptions.
+ "div by 0" ~:
+ expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())),
+
+> "assertFailure" ~:
+> let msg = "simple assertFailure"
+> in expectFailure msg (test (assertFailure msg)),
+
+> "assertString null" ~: expectSuccess (TestCase (assertString "")),
+
+> "assertString nonnull" ~:
+> let msg = "assertString nonnull"
+> in expectFailure msg (TestCase (assertString msg)),
+
+> let exp v non =
+> show v ++ " with " ++ non ++ "null message" ~:
+> expect (if v then Succ else Fail non) $ test $ assertBool non v
+> in "assertBool" ~: [ exp v non | v <- [True, False], non <- ["non", ""] ],
+
+> let msg = "assertBool True"
+> in msg ~: expectSuccess (test (assertBool msg True)),
+
+> let msg = "assertBool False"
+> in msg ~: expectFailure msg (test (assertBool msg False)),
+
+> "assertEqual equal" ~:
+> expectSuccess (test (assertEqual "" 3 3)),
+
+> "assertEqual unequal no msg" ~:
+> expectFailure "expected: 3\n but got: 4"
+> (test (assertEqual "" 3 4)),
+
+> "assertEqual unequal with msg" ~:
+> expectFailure "for x,\nexpected: 3\n but got: 4"
+> (test (assertEqual "for x," 3 4))
+
+> ]
+
+
+> emptyTest0 = TestList []
+> emptyTest1 = TestLabel "empty" emptyTest0
+> emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ]
+> emptyTests = [emptyTest0, emptyTest1, emptyTest2]
+
+> testCountEmpty test = TestCase (assertEqual "" 0 (testCaseCount test))
+
+> suite0 = (0, ok)
+> suite1 = (1, TestList [])
+> suite2 = (2, TestLabel "3" ok)
+> suite3 = (3, suite)
+
+> suite =
+> TestLabel "0"
+> (TestList [ TestLabel "1" (bad "1"),
+> TestLabel "2" (TestList [ TestLabel "2.1" ok,
+> ok,
+> TestLabel "2.3" (bad "2") ]),
+> TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))),
+> TestList [ TestList [ TestLabel "6" (bad "4") ] ] ])
+
+> suiteCount = (6 :: Int)
+
+> suitePaths = [
+> [Label "0", ListItem 0, Label "1"],
+> [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"],
+> [Label "0", ListItem 1, Label "2", ListItem 1],
+> [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"],
+> [Label "0", ListItem 2, Label "3", Label "4", Label "5"],
+> [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]]
+
+> suiteReports = [ Start (State (p 0) (Counts 6 0 0 0)),
+> Failure "1" (State (p 0) (Counts 6 1 0 1)),
+> Start (State (p 1) (Counts 6 1 0 1)),
+> Start (State (p 2) (Counts 6 2 0 1)),
+> Start (State (p 3) (Counts 6 3 0 1)),
+> Failure "2" (State (p 3) (Counts 6 4 0 2)),
+> Start (State (p 4) (Counts 6 4 0 2)),
+> Failure "3" (State (p 4) (Counts 6 5 0 3)),
+> Start (State (p 5) (Counts 6 5 0 3)),
+> Failure "4" (State (p 5) (Counts 6 6 0 4))]
+> where p n = reverse (suitePaths !! n)
+
+> suiteCounts = Counts 6 6 0 4
+
+> suiteOutput = "### Failure in: 0:0:1\n\
+> \1\n\
+> \### Failure in: 0:1:2:2:2.3\n\
+> \2\n\
+> \### Failure in: 0:2:3:4:5\n\
+> \3\n\
+> \### Failure in: 0:3:0:0:6\n\
+> \4\n\
+> \Cases: 6 Tried: 6 Errors: 0 Failures: 4\n"
+
+
+> suites = [suite0, suite1, suite2, suite3]
+
+
+> testCount (num, test) count =
+> "testCaseCount suite" ++ show num ~:
+> TestCase $ assertEqual "for test count," count (testCaseCount test)
+
+> testCaseCountTests = TestList [
+
+> "testCaseCount empty" ~: test (map testCountEmpty emptyTests),
+
+> testCount suite0 1,
+> testCount suite1 0,
+> testCount suite2 1,
+> testCount suite3 suiteCount
+
+> ]
+
+
+> testPaths (num, test) paths =
+> "testCasePaths suite" ++ show num ~:
+> TestCase $ assertEqual "for test paths,"
+> (map reverse paths) (testCasePaths test)
+
+> testPathsEmpty test = TestCase $ assertEqual "" [] (testCasePaths test)
+
+> testCasePathsTests = TestList [
+
+> "testCasePaths empty" ~: test (map testPathsEmpty emptyTests),
+
+> testPaths suite0 [[]],
+> testPaths suite1 [],
+> testPaths suite2 [[Label "3"]],
+> testPaths suite3 suitePaths
+
+> ]
+
+
+> reportTests = "reports" ~: expectReports suiteReports suiteCounts suite
+
+
+> expectText counts text test = TestCase $ do
+> (counts', text') <- runTestText putTextToShowS test
+> assertEqual "for the final counts," counts counts'
+> assertEqual "for the failure text output," text (text' "")
+
+
+> textTests = test [
+
+> "lone error" ~:
+> expectText (Counts 1 1 1 0)
+> "### Error:\nxyz\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n"
+> (test (do ioError (userError "xyz"); return ())),
+
+> "lone failure" ~:
+> expectText (Counts 1 1 0 1)
+> "### Failure:\nxyz\nCases: 1 Tried: 1 Errors: 0 Failures: 1\n"
+> (test (assert "xyz")),
+
+> "putTextToShowS" ~:
+> expectText suiteCounts suiteOutput suite,
+
+> "putTextToHandle (file)" ~:
+> let filename = "HUnitTest.tmp"
+> trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines
+> in map test
+> [ "show progress = " ++ show flag ~: do
+> handle <- openFile filename WriteMode
+> (counts, _) <- runTestText (putTextToHandle handle flag) suite
+> hClose handle
+> assertEqual "for the final counts," suiteCounts counts
+> text <- readFile filename
+> let text' = if flag then trim (terminalAppearance text) else text
+> assertEqual "for the failure text output," suiteOutput text'
+> | flag <- [False, True] ]
+
+> ]
+
+
+> showPathTests = "showPath" ~: [
+
+> "empty" ~: showPath [] ~?= "",
+> ":" ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"",
+> "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"",
+> "misc" ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?=
+> "foo:3:2:b"
+
+> ]
+
+
+> showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?=
+> "Cases: 4 Tried: 3 Errors: 2 Failures: 1"
+
+
+
+> lift :: a -> IO a
+> lift a = return a
+
+
+> assertableTests =
+> let assertables x = [
+> ( "", assert x , test (lift x)) ,
+> ( "IO ", assert (lift x) , test (lift (lift x))) ,
+> ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))]
+> assertabled l e x =
+> test [ test [ "assert" ~: pre ++ l ~: expect e $ test $ a,
+> "test" ~: pre ++ "IO " ++ l ~: expect e $ t ]
+> | (pre, a, t) <- assertables x ]
+> in "assertable" ~: [
+> assertabled "()" Succ (),
+> assertabled "True" Succ True,
+> assertabled "False" (Fail "") False,
+> assertabled "\"\"" Succ "",
+> assertabled "\"x\"" (Fail "x") "x"
+> ]
+
+
+> predicableTests =
+> let predicables x m = [
+> ( "", assertionPredicate x , x @? m, x ~? m ),
+> ( "IO ", assertionPredicate (l x) , l x @? m, l x ~? m ),
+> ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )]
+> l x = lift x
+> predicabled l e m x =
+> test [ test [ "pred" ~: pre ++ l ~: m ~: expect e $ test $ tst p,
+> "(@?)" ~: pre ++ l ~: m ~: expect e $ test $ a,
+> "(~?)" ~: pre ++ l ~: m ~: expect e $ t ]
+> | (pre, p, a, t) <- predicables x m ]
+> where tst p = p >>= assertBool m
+> in "predicable" ~: [
+> predicabled "True" Succ "error" True,
+> predicabled "False" (Fail "error") "error" False,
+> predicabled "True" Succ "" True,
+> predicabled "False" (Fail "" ) "" False
+> ]
+
+
+> compareTests = test [
+
+> let succ = const Succ
+> compare f exp act = test [ "(@=?)" ~: expect e $ test (exp @=? act),
+> "(@?=)" ~: expect e $ test (act @?= exp),
+> "(~=?)" ~: expect e $ exp ~=? act,
+> "(~?=)" ~: expect e $ act ~?= exp ]
+> where e = f $ "expected: " ++ show exp ++ "\n but got: " ++ show act
+> in test [
+> compare succ 1 1,
+> compare Fail 1 2,
+> compare succ (1,'b',3.0) (1,'b',3.0),
+> compare Fail (1,'b',3.0) (1,'b',3.1)
+> ]
+
+> ]
+
+
+> expectList1 :: Int -> Test -> Test
+> expectList1 c =
+> expectReports
+> [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ]
+> (Counts c c 0 0)
+
+> expectList2 :: [Int] -> Test -> Test
+> expectList2 cs test =
+> expectReports
+> [ Start (State [ListItem j, ListItem i] (Counts c n 0 0))
+> | ((i,j),n) <- zip coords [0..] ]
+> (Counts c c 0 0)
+> test
+> where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ]
+> c = testCaseCount test
+
+
+> extendedTestTests = test [
+
+> "test idempotent" ~: expect Succ $ test $ test $ test $ ok,
+
+> "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True],
+
+> "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]]
+
+> ]
hunk ./test/HUnitTestExtended.lhs 1
+HUnitTestExc.lhs -- test for HUnit, using Haskell language system "Exc"
+
+$Id: HUnitTestExtended.lhs,v 1.1 2004/03/26 11:23:10 malcolm Exp $
+
+> module Main (main) where
+
+> import Test.HUnit
+> import HUnitTestBase
+> import qualified Exception (assert)
+
+
+ assertionMessage = "HUnitTestExc.lhs:13: Assertion failed\n"
+ assertion = Exception.assert False (return ())
+
+
+
+> main = runTestTT (test [baseTests, excTests])
+
+> excTests = test [
+
+ -- Hugs and GHC don't currently catch arithmetic exceptions.
+ "div by 0" ~:
+ expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())),
+
+ -- GHC doesn't currently catch array-related exceptions.
+ "array ref out of bounds" ~:
+ expectUnspecifiedError (TestCase (... `seq` return ())),
+
+> "error" ~:
+> expectError "error" (TestCase (error "error")),
+
+> "tail []" ~:
+> expectUnspecifiedError (TestCase (tail [] `seq` return ()))
+
+ -- Hugs doesn't provide `assert`.
+ "assert" ~:
+ expectError assertionMessage (TestCase assertion)
+
+> ]
hunk ./test/TerminalTest.lhs 1
+TerminalTest.lhs
+
+> import Test.HUnit.Terminal
+> import Test.HUnit
+
+> main = runTestTT tests
+
+> try lab inp exp = lab ~: terminalAppearance inp ~?= exp
+
+> 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
+> ]
}