diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,43 @@ +## Changes + +#### 1.6.2.0 + +- Add support for GHC 7.0.* and 7.2.* + +#### 1.6.1.0 + +- Add `Test.HUnit.Text.runTestTTAndExit` + +#### 1.6.0.0 + +- Generalize return type of `assertFailure` to `IO a` + +#### 1.5.0.0 + +- Preserve actual/expected for `assertEqual` failures + +#### 1.4.0.0 + +- Depend on `call-stack` + +#### 1.3.1.2 + +- Fixes the test suite on GHC 8 + +#### 1.3.1.1 + +- Various updates to metadata and documentation removing outdated information and making other things more visible + +### 1.3.1.0 + +- add minimal support for GHC 8.0 + +### 1.3.0.0 + +- removed support for old compilers + +- add source locations for failing assertions (GHC >= 7.10.2 only) + +#### 1.2.5.2 + +- Added support for GHC 7.7 diff --git a/HUnit.cabal b/HUnit.cabal --- a/HUnit.cabal +++ b/HUnit.cabal @@ -1,94 +1,66 @@ -Name: HUnit -Version: 1.2.2.3 -Cabal-Version: >= 1.6 -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 - -source-repository head - type: darcs - location: http://code.haskell.org/HUnit/ +cabal-version: 1.12 -flag base4 +-- This file has been generated from package.yaml by hpack version 0.34.3. +-- +-- see: https://github.com/sol/hpack -Library - Build-Depends: base <5 - if flag(base4) - Build-Depends: base >=4 - CPP-Options: -DBASE4 - GHC-Options: -Wall - else - 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 +name: HUnit +version: 1.6.2.0 +license: BSD3 +license-file: LICENSE +author: Dean Herington +maintainer: Simon Hengel +stability: stable +homepage: https://github.com/hspec/HUnit#readme +bug-reports: https://github.com/hspec/HUnit/issues +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: . +build-type: Simple +extra-source-files: + CHANGELOG.md + README.md -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 - GHC-Options: -Wall - else - Build-Depends: base <4 - if impl(ghc >= 6.10) - Build-Depends: base >=4 - Extensions: CPP +source-repository head + type: git + location: https://github.com/hspec/HUnit -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 - GHC-Options: -Wall - else - Build-Depends: base <4 - if impl(ghc >= 6.10) - Build-Depends: base >=4 - Extensions: CPP +library + hs-source-dirs: + src + build-depends: + base ==4.*, + call-stack >=0.3.0, + deepseq + exposed-modules: + Test.HUnit.Base + Test.HUnit.Lang + Test.HUnit.Terminal + Test.HUnit.Text + Test.HUnit + other-modules: + Paths_HUnit + default-language: Haskell2010 + ghc-options: -Wall -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 +test-suite tests + type: exitcode-stdio-1.0 + main-is: HUnitTests.hs + hs-source-dirs: + tests + examples + build-depends: + HUnit, + base ==4.*, + call-stack >=0.3.0, + deepseq, + filepath + other-modules: + HUnitTestBase + HUnitTestExtended + TerminalTest + Example + Paths_HUnit + default-language: Haskell2010 + ghc-options: -Wall diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,12 +0,0 @@ -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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,545 @@ +# HUnit 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 +[https://github.com/hspec/HUnit](https://github.com/hspec/HUnit) + +## Introduction +A test-centered methodology for software development is most effective when tests are +easy to create, change, and execute. The [JUnit](www.junit.org) tool +pioneered support for test-first development in [Java](http://java.sun.com). +HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely functional +programming language. (To learn more about Haskell, see [www.haskell.org](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](#writing-tests) and [running tests](#running-tests). +The document concludes with a section describing HUnit's [constituent files](#constituent-files) +and a section giving [references](#references) to further information. + +## Getting Started + +In the Haskell module where your tests will reside, import module `Test.HUnit`: + +```haskell +import Test.HUnit +``` + +Define test cases as appropriate: + +```haskell +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: + +```haskell +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.) + +```haskell +> runTestTT tests +Cases: 2 Tried: 2 Errors: 0 Failures: 0 +> +``` + +If the tests are proving their worth, you might see: + +```haskell +> 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: + +```haskell +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: + +```haskell +> 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](#assertions) are +combined to make a [test case](#test-case), and test cases are combined +into [tests](#tests). HUnit also provides [advanced +features](#advanced-features) for more convenient test specification. + +### Assertions + + The basic building block of a test is an **assertion**. + +```haskell +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`. + +```haskell +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. + +```haskell +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](#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](#advanced-eatures). + +### 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. + +```haskell +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`. + +```haskell +testCaseCount :: Test -> Int +``` + +As mentioned above, a test is identified by its **path** in the test hierarchy. + +```haskell +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 `ListItem`s + by themselves ensure uniqueness among test case paths, while the `Label`s 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. + +```haskell +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](#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. + +```haskell +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`. + +```haskell +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. + +```haskell +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`). + +```haskell +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. + +```haskell +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. + +```haskell +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](#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: + +```haskell +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. + +```haskell +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*\n*message*`", + 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:\n*message*`". +* A *failure* report is of the form + "`Failure in: *path*\n*message*`", 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:\n*message*`". + +The function `showCounts` shows a set of counts. + +```haskell +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. + +```haskell + 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. + +```haskell +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. + +```haskell +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. + +```haskell +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. + +* [junit.org](http://www.junit.org): Web page for JUnit, the tool after which HUnit is modeled. + +* [http://junit.sourceforge.net/doc/testinfected/testing.htm](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](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](mailto:heringto@cs.unc.edu) diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,26 +0,0 @@ -#!/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 = 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/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/Test/HUnit.hs b/Test/HUnit.hs deleted file mode 100644 --- a/Test/HUnit.hs +++ /dev/null @@ -1,80 +0,0 @@ --- | 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/Base.hs b/Test/HUnit/Base.hs deleted file mode 100644 --- a/Test/HUnit/Base.hs +++ /dev/null @@ -1,355 +0,0 @@ --- | 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 -predi @? msg = assertionPredicate predi >>= assertBool msg - --- | Asserts that the specified actual value is equal to the expected value --- (with the expected value on the left-hand side). -(@=?) :: (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 _ (TestCase _) = showString "TestCase _" - showsPrec _ (TestList ts) = showString "TestList " . showList ts - showsPrec p (TestLabel l t) = showString "TestLabel " . showString l - . showChar ' ' . showsPrec p t - --- Overloaded `test` Function --- -------------------------- - --- | Provides a way to convert data into a @Test@ or set of @Test@. -class Testable t - where test :: t -> Test - -instance Testable Test - where test = id - -instance (Assertable t) => Testable (IO t) - where test = TestCase . assert - -instance (Testable t) => Testable [t] - where test = TestList . map test - - --- Test Construction Operators --- --------------------------- - -infix 1 ~?, ~=?, ~?= -infixr 0 ~: - --- | Creates a test case resulting from asserting the condition obtained --- from the specified 'AssertionPredicable'. -(~?) :: (AssertionPredicable t) => t -- ^ A value of which the asserted condition is predicated - -> String -- ^ A message that is displayed on test failure - -> Test -predi ~? msg = TestCase (predi @? msg) - --- | Shorthand for a test case that asserts equality (with the expected --- value on the left-hand side, and the actual value on the right-hand --- side). -(~=?) :: (Eq a, Show a) => a -- ^ The expected value - -> a -- ^ The actual value - -> Test -expected ~=? actual = TestCase (expected @=? actual) - --- | Shorthand for a test case that asserts equality (with the actual --- value on the left-hand side, and the expected value on the right-hand --- side). -(~?=) :: (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 t0 = tcp t0 [] - where tcp (TestCase _) p = [p] - tcp (TestList ts) p = - concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ] - tcp (TestLabel l t) p = tcp t (Label l : p) - --- | Counts the number of 'TestCase's in a tree of @Test@s. -testCaseCount :: Test -> Int -testCaseCount (TestCase _) = 1 -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 initialUs initialT = do - (ss', us') <- pt initState initialUs initialT - unless (null (path ss')) $ error "performTest: Final path is nonnull" - return (counts ss', us') - where - initState = State{ path = [], counts = initCounts } - initCounts = Counts{ cases = testCaseCount initialT, tried = 0, - errors = 0, failures = 0} - - pt ss us (TestCase a) = do - us' <- reportStart ss us - r <- performTestCase a - case r of Nothing -> do return (ss', us') - Just (True, m) -> do usF <- reportFailure m ssF us' - return (ssF, usF) - Just (False, m) -> do usE <- reportError m ssE us' - return (ssE, usE) - where c@Counts{ tried = n } = counts ss - ss' = ss{ counts = c{ tried = n + 1 } } - ssF = ss{ counts = c{ tried = n + 1, failures = failures c + 1 } } - ssE = ss{ counts = c{ tried = n + 1, errors = errors c + 1 } } - - pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..]) - where f (ss', us') (t, n) = withNode (ListItem n) ss' us' t - - pt ss us (TestLabel label t) = withNode (Label label) ss us t - - withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t - return (ss2{ path = path0 }, us1) - where path0 = path ss0 - ss1 = ss0{ path = node : path0 } diff --git a/Test/HUnit/Lang.hs b/Test/HUnit/Lang.hs deleted file mode 100644 --- a/Test/HUnit/Lang.hs +++ /dev/null @@ -1,119 +0,0 @@ --- | 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 --- ------- - -#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -import Data.Dynamic -import Control.Exception as E -#else -import Data.List (isPrefixOf) -import System.IO.Error (ioeGetErrorString, try) -#endif - - - --- 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/Terminal.hs b/Test/HUnit/Terminal.hs deleted file mode 100644 --- a/Test/HUnit/Terminal.hs +++ /dev/null @@ -1,42 +0,0 @@ --- | 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/Text.hs b/Test/HUnit/Text.hs deleted file mode 100644 --- a/Test/HUnit/Text.hs +++ /dev/null @@ -1,128 +0,0 @@ --- | 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 _ = 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 rest = f (line ++ '\n' : rest) - - --- | 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 us0) t = do - (counts', us1) <- performTest reportStart reportError reportFailure us0 t - us2 <- put (showCounts counts') True us1 - return (counts', us2) - where - reportStart ss us = put (showCounts (counts ss)) False us - reportError = reportProblem "Error:" "Error in: " - 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/doc/Guide.html b/doc/Guide.html deleted file mode 100644 --- a/doc/Guide.html +++ /dev/null @@ -1,539 +0,0 @@ - - - - - - - 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 --- a/examples/Example.hs +++ b/examples/Example.hs @@ -1,9 +1,9 @@ -- Example.hs -- Examples from HUnit user's guide -- -- For more examples, check out the tests directory. It contains unit tests --- for HUnit. +-- for HUnit. -module Main where +module Example where import Test.HUnit @@ -36,5 +36,5 @@ partB y @? "(partB " ++ show y ++ ") failed" ] main :: IO Counts -main = do runTestTT tests +main = do _ <- runTestTT tests runTestTT tests' diff --git a/prologue.txt b/prologue.txt deleted file mode 100644 --- a/prologue.txt +++ /dev/null @@ -1,2 +0,0 @@ -HUnit is a unit testing framework for Haskell, inspired by the JUnit -tool for Java, see: . diff --git a/src/Test/HUnit.hs b/src/Test/HUnit.hs new file mode 100644 --- /dev/null +++ b/src/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/src/Test/HUnit/Base.hs b/src/Test/HUnit/Base.hs new file mode 100644 --- /dev/null +++ b/src/Test/HUnit/Base.hs @@ -0,0 +1,361 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} + +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE ConstraintKinds #-} +#define HasCallStack_ HasCallStack => +#else +#define HasCallStack_ +#endif + +-- | 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) +import Data.CallStack + + +-- Assertion Definition +-- ==================== + +import Test.HUnit.Lang + + +-- Conditional Assertion Functions +-- ------------------------------- + +-- | Asserts that the specified condition holds. +assertBool :: HasCallStack_ + 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 :: HasCallStack_ + String -- ^ The message that is displayed with the assertion failure + -> Assertion +assertString s = unless (null s) (assertFailure s) + +-- 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 :: HasCallStack_ 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 :: HasCallStack_ [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. +(@?) :: HasCallStack_ AssertionPredicable t + => t -- ^ A value of which the asserted condition is predicated + -> String -- ^ A message that is displayed if the assertion fails + -> Assertion +predi @? msg = assertionPredicate predi >>= assertBool msg + +-- | Asserts that the specified actual value is equal to the expected value +-- (with the expected value on the left-hand side). +(@=?) :: HasCallStack_ (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). +(@?=) :: HasCallStack_ (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 _ (TestCase _) = showString "TestCase _" + showsPrec _ (TestList ts) = showString "TestList " . showList ts + showsPrec p (TestLabel l t) = showString "TestLabel " . showString l + . showChar ' ' . showsPrec p t + +-- Overloaded `test` Function +-- -------------------------- + +-- | Provides a way to convert data into a @Test@ or set of @Test@. +class Testable t + where test :: HasCallStack_ 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'. +(~?) :: HasCallStack_ AssertionPredicable t + => t -- ^ A value of which the asserted condition is predicated + -> String -- ^ A message that is displayed on test failure + -> Test +predi ~? msg = TestCase (predi @? msg) + +-- | Shorthand for a test case that asserts equality (with the expected +-- value on the left-hand side, and the actual value on the right-hand +-- side). +(~=?) :: HasCallStack_ (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). +(~?=) :: HasCallStack_ (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. +(~:) :: HasCallStack_ 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 = Maybe SrcLoc -> 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 t0 = tcp t0 [] + where tcp (TestCase _) p = [p] + tcp (TestList ts) p = + concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ] + tcp (TestLabel l t) p = tcp t (Label l : p) + +-- | Counts the number of 'TestCase's in a tree of @Test@s. +testCaseCount :: Test -> Int +testCaseCount (TestCase _) = 1 +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 initialUs initialT = do + (ss', us') <- pt initState initialUs initialT + unless (null (path ss')) $ error "performTest: Final path is nonnull" + return (counts ss', us') + where + initState = State{ path = [], counts = initCounts } + initCounts = Counts{ cases = testCaseCount initialT, tried = 0, + errors = 0, failures = 0} + + pt ss us (TestCase a) = do + us' <- reportStart ss us + r <- performTestCase a + case r of + Success -> do + return (ss', us') + Failure loc m -> do + usF <- reportFailure loc m ssF us' + return (ssF, usF) + Error loc m -> do + usE <- reportError loc m ssE us' + return (ssE, usE) + where c@Counts{ tried = n } = counts ss + ss' = ss{ counts = c{ tried = n + 1 } } + ssF = ss{ counts = c{ tried = n + 1, failures = failures c + 1 } } + ssE = ss{ counts = c{ tried = n + 1, errors = errors c + 1 } } + + pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..]) + where f (ss', us') (t, n) = withNode (ListItem n) ss' us' t + + pt ss us (TestLabel label t) = withNode (Label label) ss us t + + withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t + return (ss2{ path = path0 }, us1) + where path0 = path ss0 + ss1 = ss0{ path = node : path0 } diff --git a/src/Test/HUnit/Lang.hs b/src/Test/HUnit/Lang.hs new file mode 100644 --- /dev/null +++ b/src/Test/HUnit/Lang.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} + +#if __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE ConstraintKinds #-} +#define HasCallStack_ HasCallStack => +#else +#define HasCallStack_ +#endif + +module Test.HUnit.Lang ( + Assertion, + assertFailure, + assertEqual, + + Result (..), + performTestCase, +-- * Internals +-- | +-- /Note:/ This is not part of the public API! It is exposed so that you can +-- tinker with the internals of HUnit, but do not expect it to be stable! + HUnitFailure (..), + FailureReason (..), + formatFailureReason +) where + +import Control.DeepSeq +import Control.Exception as E +import Control.Monad +import Data.List +import Data.Typeable +import Data.CallStack + +-- | 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 () + +data HUnitFailure = HUnitFailure (Maybe SrcLoc) FailureReason + deriving (Eq, Show, Typeable) + +instance Exception HUnitFailure + +data FailureReason = Reason String | ExpectedButGot (Maybe String) String String + deriving (Eq, Show, Typeable) + +location :: HasCallStack_ Maybe SrcLoc +location = case reverse callStack of + (_, loc) : _ -> Just loc + [] -> Nothing + +-- | Unconditionally signals that a failure has occurred. +assertFailure :: + HasCallStack_ + String -- ^ A message that is displayed with the assertion failure + -> IO a +assertFailure msg = msg `deepseq` E.throwIO (HUnitFailure location $ Reason msg) + +-- | 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 :: HasCallStack_ (Eq a, Show a) + => String -- ^ The message prefix + -> a -- ^ The expected value + -> a -- ^ The actual value + -> Assertion +assertEqual preface expected actual = + unless (actual == expected) $ do + (prefaceMsg `deepseq` expectedMsg `deepseq` actualMsg `deepseq` E.throwIO (HUnitFailure location $ ExpectedButGot prefaceMsg expectedMsg actualMsg)) + where + prefaceMsg + | null preface = Nothing + | otherwise = Just preface + expectedMsg = show expected + actualMsg = show actual + +formatFailureReason :: FailureReason -> String +formatFailureReason (Reason reason) = reason +formatFailureReason (ExpectedButGot preface expected actual) = intercalate "\n" . maybe id (:) preface $ ["expected: " ++ expected, " but got: " ++ actual] + +data Result = Success | Failure (Maybe SrcLoc) String | Error (Maybe SrcLoc) String + deriving (Eq, Show) + +-- | Performs a single test case. +performTestCase :: Assertion -- ^ an assertion to be made during the test case run + -> IO Result +performTestCase action = + (action >> return Success) + `E.catches` + [E.Handler (\(HUnitFailure loc reason) -> return $ Failure loc (formatFailureReason reason)), + + -- Re-throw AsyncException, otherwise execution will not terminate on + -- SIGINT (ctrl-c). Currently, all AsyncExceptions are being thrown + -- because it's thought that none of them will be encountered during + -- normal HUnit operation. If you encounter an example where this + -- is not the case, please email the maintainer. + E.Handler (\e -> throw (e :: E.AsyncException)), + + E.Handler (\e -> return $ Error Nothing $ show (e :: E.SomeException))] diff --git a/src/Test/HUnit/Terminal.hs b/src/Test/HUnit/Terminal.hs new file mode 100644 --- /dev/null +++ b/src/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/src/Test/HUnit/Text.hs b/src/Test/HUnit/Text.hs new file mode 100644 --- /dev/null +++ b/src/Test/HUnit/Text.hs @@ -0,0 +1,152 @@ +-- | 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, + runTestTTAndExit +) +where + +import Test.HUnit.Base + +import Data.CallStack +import Control.Monad (when) +import System.IO (Handle, stderr, hPutStr, hPutStrLn) +import System.Exit (exitSuccess, exitFailure) + + +-- | 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 _ = 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 rest = f (line ++ '\n' : rest) + + +-- | 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 us0) t = do + (counts', us1) <- performTest reportStart reportError reportFailure us0 t + us2 <- put (showCounts counts') True us1 + return (counts', us2) + where + reportStart ss us = put (showCounts (counts ss)) False us + reportError = reportProblem "Error:" "Error in: " + reportFailure = reportProblem "Failure:" "Failure in: " + reportProblem p0 p1 loc msg ss us = put line True us + where line = "### " ++ kind ++ path' ++ "\n" ++ formatLocation loc ++ msg + kind = if null path' then p0 else p1 + path' = showPath (path ss) + +formatLocation :: Maybe SrcLoc -> String +formatLocation Nothing = "" +formatLocation (Just loc) = srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ "\n" + +-- | 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' + +-- | Convenience wrapper for 'runTestTT'. +-- Simply runs 'runTestTT' and then exits back to the OS, +-- using 'exitSuccess' if there were no errors or failures, +-- or 'exitFailure' if there were. For example: +-- +-- > tests :: Test +-- > tests = ... +-- > +-- > main :: IO () +-- > main = runTestTTAndExit tests + +runTestTTAndExit :: Test -> IO () +runTestTTAndExit tests = do + c <- runTestTT tests + if (errors c == 0) && (failures c == 0) + then exitSuccess + else exitFailure diff --git a/tests/HUnitTest98.lhs b/tests/HUnitTest98.lhs deleted file mode 100644 --- a/tests/HUnitTest98.lhs +++ /dev/null @@ -1,9 +0,0 @@ -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 --- a/tests/HUnitTestBase.lhs +++ b/tests/HUnitTestBase.lhs @@ -1,7 +1,9 @@ HUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant) +> {-# LANGUAGE CPP #-} > module HUnitTestBase where +> import Data.List > import Test.HUnit > import Test.HUnit.Terminal (terminalAppearance) > import System.IO (IOMode(..), openFile, hClose) @@ -26,8 +28,8 @@ > expectReports :: [Report] -> Counts -> Test -> Test > expectReports reports1 counts1 t = TestCase $ do > (counts2, reports2) <- performTest (\ ss us -> return (Start ss : us)) -> (\m ss us -> return (Error m ss : us)) -> (\m ss us -> return (Failure m ss : us)) +> (\_loc m ss us -> return (Error m ss : us)) +> (\_loc m ss us -> return (Failure m ss : us)) > [] t > assertEqual "for the reports from a test," reports1 (reverse reports2) > assertEqual "for the counts from a test," counts1 counts2 @@ -79,7 +81,7 @@ > ok :: Test > ok = test (assert ()) > bad :: String -> Test -> bad m = test (assertFailure m) +> bad m = test (assertFailure m :: Assertion) > assertTests :: Test @@ -88,11 +90,7 @@ > "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 @@ -110,7 +108,7 @@ > "assertFailure" ~: > let msg = "simple assertFailure" -> in expectFailure msg (test (assertFailure msg)), +> in expectFailure msg (test (assertFailure msg :: Assertion)), > "assertString null" ~: expectSuccess (TestCase (assertString "")), @@ -257,12 +255,14 @@ > reportTests :: Test > reportTests = "reports" ~: expectReports suiteReports suiteCounts suite +> removeLocation :: String -> String +> removeLocation = unlines . filter (not . isInfixOf __FILE__) . lines > expectText :: Counts -> String -> Test -> Test > expectText counts1 text1 t = TestCase $ do > (counts2, text2) <- runTestText putTextToShowS t > assertEqual "for the final counts," counts1 counts2 -> assertEqual "for the failure text output," text1 (text2 "") +> assertEqual "for the failure text output," text1 (removeLocation $ text2 "") > textTests :: Test @@ -270,11 +270,7 @@ > "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" ~: @@ -295,7 +291,7 @@ > hClose handle > assertEqual "for the final counts," suiteCounts counts' > text <- readFile filename -> let text' = if flag then trim (terminalAppearance text) else text +> let text' = removeLocation $ if flag then trim (terminalAppearance text) else text > assertEqual "for the failure text output," suiteOutput text' > | flag <- [False, True] ] diff --git a/tests/HUnitTestExtended.hs b/tests/HUnitTestExtended.hs new file mode 100644 --- /dev/null +++ b/tests/HUnitTestExtended.hs @@ -0,0 +1,19 @@ +module HUnitTestExtended (extendedTests) where + +import Test.HUnit +import HUnitTestBase + +extendedTests :: Test +extendedTests = test [ + "div by 0" ~: + expectError "divide by zero" (TestCase ((3 `div` 0 :: Integer) `seq` return ())), + + "list ref out of bounds" ~: + expectUnspecifiedError (TestCase ([1 .. 4 :: Integer] !! 10 `seq` return ())), + + "error" ~: + expectUnspecifiedError (TestCase (error "error")), + + "tail []" ~: + expectUnspecifiedError (TestCase (tail [] `seq` return ())) + ] diff --git a/tests/HUnitTestExtended.lhs b/tests/HUnitTestExtended.lhs deleted file mode 100644 --- a/tests/HUnitTestExtended.lhs +++ /dev/null @@ -1,39 +0,0 @@ -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 :: Integer) `seq` return ())), - -> "list ref out of bounds" ~: -> expectUnspecifiedError (TestCase ([1 .. 4 :: Integer] !! 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 deleted file mode 100644 --- a/tests/HUnitTests.cabal +++ /dev/null @@ -1,28 +0,0 @@ -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/HUnitTests.hs b/tests/HUnitTests.hs new file mode 100644 --- /dev/null +++ b/tests/HUnitTests.hs @@ -0,0 +1,24 @@ +-- HUnitTests.hs +-- +-- This file is an entry point for running all of the tests. + +module Main (main) where + +import System.Exit + +import Test.HUnit +import HUnitTestBase +import HUnitTestExtended +import TerminalTest +import Example () + +main :: IO () +main = do + counts2 <- runTestTT (test [ + baseTests, + extendedTests, + terminalTests + ]) + if (errors counts2 + failures counts2 == 0) + then exitSuccess + else exitFailure diff --git a/tests/Setup.hs b/tests/Setup.hs deleted file mode 100644 --- a/tests/Setup.hs +++ /dev/null @@ -1,7 +0,0 @@ -#!/usr/bin/env runghc -module Main (main) where - -import Distribution.Simple - -main :: IO () -main = defaultMain diff --git a/tests/TerminalTest.hs b/tests/TerminalTest.hs new file mode 100644 --- /dev/null +++ b/tests/TerminalTest.hs @@ -0,0 +1,23 @@ +-- TerminalTest.hs + +module TerminalTest (terminalTests) where + +import Test.HUnit.Terminal +import Test.HUnit + +try :: String -> String -> String -> Test +try lab inp exp' = lab ~: terminalAppearance inp ~?= exp' + +terminalTests :: Test +terminalTests = 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 + ] diff --git a/tests/TerminalTest.lhs b/tests/TerminalTest.lhs deleted file mode 100644 --- a/tests/TerminalTest.lhs +++ /dev/null @@ -1,24 +0,0 @@ -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 -> ]