├── .ghci ├── .github └── workflows │ ├── build.yml │ └── publish.yml ├── .gitignore ├── CHANGELOG.md ├── HUnit.cabal ├── LICENSE ├── README.md ├── Setup.lhs ├── cabal.project ├── examples └── Example.hs ├── package.yaml ├── src └── Test │ ├── HUnit.hs │ └── HUnit │ ├── Base.hs │ ├── Lang.hs │ ├── Terminal.hs │ └── Text.hs └── tests ├── HUnitTestBase.lhs ├── HUnitTestExtended.hs ├── HUnitTests.hs └── TerminalTest.hs /.ghci: -------------------------------------------------------------------------------- 1 | :set -isrc -itest 2 | :set -optP-includedist/build/autogen/cabal_macros.h 3 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | 3 | on: 4 | push: 5 | branches: 6 | - main 7 | pull_request: 8 | branches: 9 | - main 10 | 11 | jobs: 12 | build: 13 | name: ${{ matrix.os }} / GHC ${{ matrix.ghc }} 14 | runs-on: ${{ matrix.os }} 15 | 16 | strategy: 17 | matrix: 18 | os: 19 | - ubuntu-18.04 20 | ghc: 21 | - 7.0.1 22 | - 7.0.4 23 | - 7.2.2 24 | - 7.4.1 25 | - 7.4.2 26 | - 7.6.3 27 | - 7.8.4 28 | - 7.10.3 29 | - 8.0.2 30 | - 8.2.2 31 | - 8.4.1 32 | - 8.4.2 33 | - 8.4.3 34 | - 8.4.4 35 | - 8.6.1 36 | - 8.6.2 37 | - 8.6.3 38 | - 8.6.4 39 | - 8.6.5 40 | - 8.8.1 41 | - 8.8.2 42 | - 8.8.3 43 | - 8.8.4 44 | - 8.10.1 45 | - 8.10.2 46 | - 8.10.3 47 | - 8.10.4 48 | - 8.10.5 49 | - 8.10.6 50 | - 8.10.7 51 | - 9.0.1 52 | - 9.0.2 53 | - 9.2.1 54 | - 9.2.2 55 | include: 56 | - os: macos-latest 57 | ghc: latest 58 | - os: windows-latest 59 | ghc: latest 60 | steps: 61 | - uses: actions/checkout@v3 62 | - uses: hspec/setup-haskell@v1 63 | with: 64 | ghc-version: ${{ matrix.ghc }} 65 | - uses: sol/run-haskell-tests@v1 66 | 67 | success: 68 | needs: build 69 | runs-on: ubuntu-latest 70 | if: always() # this is required as GitHub considers "skipped" jobs as "passed" when checking branch protection rules 71 | 72 | steps: 73 | - run: false 74 | if: needs.build.result != 'success' 75 | -------------------------------------------------------------------------------- /.github/workflows/publish.yml: -------------------------------------------------------------------------------- 1 | name: publish 2 | 3 | on: 4 | push: 5 | branches: 6 | - main 7 | 8 | jobs: 9 | publish: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: actions/checkout@v2 13 | 14 | - uses: sol/haskell-autotag@v1 15 | id: autotag 16 | with: 17 | prefix: null 18 | 19 | - run: cabal sdist 20 | 21 | - uses: haskell-actions/hackage-publish@v1.1 22 | with: 23 | hackageToken: ${{ secrets.HACKAGE_AUTH_TOKEN }} 24 | publish: true 25 | if: steps.autotag.outputs.created 26 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist/ 2 | /HunitTest.tmp 3 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## Changes 2 | 3 | #### 1.6.2.0 4 | 5 | - Add support for GHC 7.0.* and 7.2.* 6 | 7 | #### 1.6.1.0 8 | 9 | - Add `Test.HUnit.Text.runTestTTAndExit` 10 | 11 | #### 1.6.0.0 12 | 13 | - Generalize return type of `assertFailure` to `IO a` 14 | 15 | #### 1.5.0.0 16 | 17 | - Preserve actual/expected for `assertEqual` failures 18 | 19 | #### 1.4.0.0 20 | 21 | - Depend on `call-stack` 22 | 23 | #### 1.3.1.2 24 | 25 | - Fixes the test suite on GHC 8 26 | 27 | #### 1.3.1.1 28 | 29 | - Various updates to metadata and documentation removing outdated information and making other things more visible 30 | 31 | ### 1.3.1.0 32 | 33 | - add minimal support for GHC 8.0 34 | 35 | ### 1.3.0.0 36 | 37 | - removed support for old compilers 38 | 39 | - add source locations for failing assertions (GHC >= 7.10.2 only) 40 | 41 | #### 1.2.5.2 42 | 43 | - Added support for GHC 7.7 44 | -------------------------------------------------------------------------------- /HUnit.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.34.3. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: HUnit 8 | version: 1.6.2.0 9 | license: BSD3 10 | license-file: LICENSE 11 | author: Dean Herington 12 | maintainer: Simon Hengel 13 | stability: stable 14 | homepage: https://github.com/hspec/HUnit#readme 15 | bug-reports: https://github.com/hspec/HUnit/issues 16 | category: Testing 17 | synopsis: A unit testing framework for Haskell 18 | description: HUnit is a unit testing framework for Haskell, inspired by the 19 | JUnit tool for Java, see: . 20 | build-type: Simple 21 | extra-source-files: 22 | CHANGELOG.md 23 | README.md 24 | 25 | source-repository head 26 | type: git 27 | location: https://github.com/hspec/HUnit 28 | 29 | library 30 | hs-source-dirs: 31 | src 32 | build-depends: 33 | base ==4.*, 34 | call-stack >=0.3.0, 35 | deepseq 36 | exposed-modules: 37 | Test.HUnit.Base 38 | Test.HUnit.Lang 39 | Test.HUnit.Terminal 40 | Test.HUnit.Text 41 | Test.HUnit 42 | other-modules: 43 | Paths_HUnit 44 | default-language: Haskell2010 45 | ghc-options: -Wall 46 | 47 | test-suite tests 48 | type: exitcode-stdio-1.0 49 | main-is: HUnitTests.hs 50 | hs-source-dirs: 51 | tests 52 | examples 53 | build-depends: 54 | HUnit, 55 | base ==4.*, 56 | call-stack >=0.3.0, 57 | deepseq, 58 | filepath 59 | other-modules: 60 | HUnitTestBase 61 | HUnitTestExtended 62 | TerminalTest 63 | Example 64 | Paths_HUnit 65 | default-language: Haskell2010 66 | ghc-options: -Wall 67 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | HUnit is Copyright (c) Dean Herington, 2002, all rights reserved, 2 | and is distributed as free software under the following license. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | - Redistributions of source code must retain the above copyright 9 | notice, this list of conditions, and the following disclaimer. 10 | 11 | - Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions, and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | - The names of the copyright holders may not be used to endorse or 16 | promote products derived from this software without specific prior 17 | written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY 20 | EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 21 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 22 | PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE 23 | LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 24 | CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 25 | SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 26 | BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 27 | WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 28 | OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 29 | IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # HUnit User's Guide 2 | 3 | HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java. This 4 | guide describes how to use HUnit, assuming you are familiar with Haskell, though not 5 | necessarily with JUnit. You can obtain HUnit, including this guide, at 6 | [https://github.com/hspec/HUnit](https://github.com/hspec/HUnit) 7 | 8 | ## Introduction 9 | A test-centered methodology for software development is most effective when tests are 10 | easy to create, change, and execute. The [JUnit](www.junit.org) tool 11 | pioneered support for test-first development in [Java](http://java.sun.com). 12 | HUnit is an adaptation of JUnit to Haskell, a general-purpose, purely functional 13 | programming language. (To learn more about Haskell, see [www.haskell.org](http://www.haskell.org)). 14 | 15 | With HUnit, as with JUnit, you can easily create tests, name them, group them into 16 | suites, and execute them, with the framework checking the results automatically. Test 17 | specification in HUnit is even more concise and flexible than in JUnit, thanks to the 18 | nature of the Haskell language. HUnit currently includes only a text-based test 19 | controller, but the framework is designed for easy extension. (Would anyone care to 20 | write a graphical test controller for HUnit?) 21 | 22 | The next section helps you get started using HUnit in simple ways. Subsequent sections 23 | give details on [writing tests](#writing-tests) and [running tests](#running-tests). 24 | The document concludes with a section describing HUnit's [constituent files](#constituent-files) 25 | and a section giving [references](#references) to further information. 26 | 27 | ## Getting Started 28 | 29 | In the Haskell module where your tests will reside, import module `Test.HUnit`: 30 | 31 | ```haskell 32 | import Test.HUnit 33 | ``` 34 | 35 | Define test cases as appropriate: 36 | 37 | ```haskell 38 | test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3)) 39 | test2 = TestCase (do (x,y) <- partA 3 40 | assertEqual "for the first result of partA," 5 x 41 | b <- partB y 42 | assertBool ("(partB " ++ show y ++ ") failed") b) 43 | ``` 44 | 45 | Name the test cases and group them together: 46 | 47 | ```haskell 48 | tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2] 49 | ``` 50 | 51 | Run the tests as a group. At a Haskell interpreter prompt, apply the 52 | function `runTestTT` to the collected tests. (The `TT` suggests 53 | **T**ext orientation with output to the **T**erminal.) 54 | 55 | ```haskell 56 | > runTestTT tests 57 | Cases: 2 Tried: 2 Errors: 0 Failures: 0 58 | > 59 | ``` 60 | 61 | If the tests are proving their worth, you might see: 62 | 63 | ```haskell 64 | > runTestTT tests 65 | ### Failure in: 0:test1 66 | for (foo 3), 67 | expected: (1,2) 68 | but got: (1,3) 69 | Cases: 2 Tried: 2 Errors: 0 Failures: 1 70 | > 71 | ``` 72 | 73 | Isn't that easy? 74 | 75 | You can specify tests even more succinctly using operators and 76 | overloaded functions that HUnit provides: 77 | 78 | ```haskell 79 | tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3), 80 | "test2" ~: do (x, y) <- partA 3 81 | assertEqual "for the first result of partA," 5 x 82 | partB y @? "(partB " ++ show y ++ ") failed" ] 83 | ``` 84 | 85 | Assuming the same test failures as before, you would see: 86 | 87 | ```haskell 88 | > runTestTT tests 89 | ### Failure in: 0:test1:(foo 3) 90 | expected: (1,2) 91 | but got: (1,3) 92 | Cases: 2 Tried: 2 Errors: 0 Failures: 1 93 | > 94 | ``` 95 | 96 | ## Writing Tests 97 | 98 | Tests are specified compositionally. [Assertions](#assertions) are 99 | combined to make a [test case](#test-case), and test cases are combined 100 | into [tests](#tests). HUnit also provides [advanced 101 | features](#advanced-features) for more convenient test specification. 102 | 103 | ### Assertions 104 | 105 | The basic building block of a test is an **assertion**. 106 | 107 | ```haskell 108 | type Assertion = IO () 109 | ``` 110 | 111 | 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`. 112 | 113 | ```haskell 114 | assertFailure :: String -> Assertion 115 | assertFailure msg = ioError (userError ("HUnit:" ++ msg)) 116 | ``` 117 | 118 | `(assertFailure msg)` raises an exception. The string argument identifies the 119 | failure. The failure message is prefixed by "`HUnit:`" to mark it as an HUnit 120 | assertion failure message. The HUnit test framework interprets such an exception as 121 | indicating failure of the test whose execution raised the exception. (Note: The details 122 | concerning the implementation of `assertFailure` are subject to change and should 123 | not be relied upon.) 124 | 125 | `assertFailure` can be used directly, but it is much more common to use it 126 | indirectly through other assertion functions that conditionally assert failure. 127 | 128 | ```haskell 129 | assertBool :: String -> Bool -> Assertion 130 | assertBool msg b = unless b (assertFailure msg) 131 | 132 | assertString :: String -> Assertion 133 | assertString s = unless (null s) (assertFailure s) 134 | 135 | assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion 136 | assertEqual preface expected actual = 137 | unless (actual == expected) (assertFailure msg) 138 | where msg = (if null preface then "" else preface ++ "\n") ++ 139 | "expected: " ++ show expected ++ "\n but got: " ++ show actual 140 | ``` 141 | 142 | With `assertBool` you give the assertion condition and failure message separately. 143 | With `assertString` the two are combined. With `assertEqual` you provide a 144 | "preface", an expected value, and an actual value; the failure message shows the two 145 | unequal values and is prefixed by the preface. Additional ways to create assertions are 146 | described later under [Advanced Features](#advanced-features) 147 | 148 | Since assertions are `IO` computations, they may be combined--along with other 149 | `IO` computations--using `(>>=)`, `(>>)`, and the `do` 150 | notation. As long as its result is of type `(IO ())`, such a combination 151 | constitutes a single, collective assertion, incorporating any number of constituent 152 | assertions. The important features of such a collective assertion are that it fails if 153 | any of its constituent assertions is executed and fails, and that the first constituent 154 | assertion to fail terminates execution of the collective assertion. Such behavior is 155 | essential to specifying a test case. 156 | 157 | ### Test Case 158 | 159 | A **test case** is the unit of test execution. That is, distinct test cases are 160 | executed independently. The failure of one is independent of the failure of any other. 161 | 162 | A test case consists of a single, possibly collective, assertion. The possibly multiple 163 | constituent assertions in a test case's collective assertion are **not** independent. 164 | Their interdependence may be crucial to specifying correct operation for a test. A test 165 | case may involve a series of steps, each concluding in an assertion, where each step 166 | must succeed in order for the test case to continue. As another example, a test may 167 | require some "set up" to be performed that must be undone ("torn down" in JUnit 168 | parlance) once the test is complete. In this case, you could use Haskell's 169 | `IO.bracket` function to achieve the desired effect. 170 | 171 | You can make a test case from an assertion by applying the `TestCase` constructor. 172 | For example, `(TestCase (return ()))` is a test case that never 173 | fails, and `(TestCase (assertEqual "for x," 3 x))` 174 | is a test case that checks that the value of `x` is 3. Additional ways 175 | to create test cases are described later under [Advanced Features](#advanced-features). 176 | 177 | ### Tests 178 | 179 | As soon as you have more than one test, you'll want to name them to tell them apart. As 180 | soon as you have more than several tests, you'll want to group them to process them more 181 | easily. So, naming and grouping are the two keys to managing collections of tests. 182 | 183 | In tune with the "composite" design pattern [1], a 184 | **test** is defined as a package of test cases. Concretely, a test is either a single 185 | test case, a group of tests, or either of the first two identified by a label. 186 | 187 | ```haskell 188 | data Test = TestCase Assertion 189 | | TestList [Test] 190 | | TestLabel String Test 191 | ``` 192 | 193 | There are three important features of this definition to note: 194 | 195 | 196 | * A `TestList` consists of a list of tests rather than a list of test cases. 197 | This means that the structure of a `Test` is actually a tree. Using a 198 | hierarchy helps organize tests just as it helps organize files in a file system. 199 | * A `TestLabel` is attached to a test rather than to a test case. This means 200 | that all nodes in the test tree, not just test case (leaf) nodes, can be labeled. 201 | Hierarchical naming helps organize tests just as it helps organize files in a file 202 | system. 203 | * A `TestLabel` is separate from both `TestCase` and `TestList`. 204 | This means that labeling is optional everywhere in the tree. Why is this a good 205 | thing? Because of the hierarchical structure of a test, each constituent test case 206 | is uniquely identified by its path in the tree, ignoring all labels. Sometimes a 207 | test case's path (or perhaps its subpath below a certain node) is a perfectly 208 | adequate "name" for the test case (perhaps relative to a certain node). In this 209 | case, creating a label for the test case is both unnecessary and inconvenient. 210 | 211 | 212 | The number of test cases that a test comprises can be computed with `testCaseCount`. 213 | 214 | ```haskell 215 | testCaseCount :: Test -> Int 216 | ``` 217 | 218 | As mentioned above, a test is identified by its **path** in the test hierarchy. 219 | 220 | ```haskell 221 | data Node = ListItem Int | Label String 222 | deriving (Eq, Show, Read) 223 | 224 | type Path = [Node] -- Node order is from test case to root. 225 | ``` 226 | 227 | Each occurrence of `TestList` gives rise to a `ListItem` and each 228 | occurrence of `TestLabel` gives rise to a `Label`. The `ListItem`s 229 | by themselves ensure uniqueness among test case paths, while the `Label`s allow 230 | you to add mnemonic names for individual test cases and collections of them. 231 | 232 | Note that the order of nodes in a path is reversed from what you might expect: The first 233 | node in the list is the one deepest in the tree. This order is a concession to 234 | efficiency: It allows common path prefixes to be shared. 235 | 236 | The paths of the test cases that a test comprises can be computed with 237 | `testCasePaths`. The paths are listed in the order in which the corresponding 238 | test cases would be executed. 239 | 240 | ```haskell 241 | testCasePaths :: Test -> [Path] 242 | ``` 243 | 244 | The three variants of `Test` can be constructed simply by applying 245 | `TestCase`, `TestList`, and `TestLabel` to appropriate arguments. 246 | Additional ways to create tests are described later under [Advanced Features](#advanced-features). 247 | 248 | The design of the type `Test` provides great conciseness, flexibility, and 249 | convenience in specifying tests. Moreover, the nature of Haskell significantly augments 250 | these qualities: 251 | 252 | * Combining assertions and other code to construct test cases is easy with the 253 | `IO` monad. 254 | * Using overloaded functions and special operators (see below), specification of 255 | assertions and tests is extremely compact. 256 | * Structuring a test tree by value, rather than by name as in JUnit, provides for more 257 | convenient, flexible, and robust test suite specification. In particular, a test 258 | suite can more easily be computed "on the fly" than in other test frameworks. 259 | * Haskell's powerful abstraction facilities provide unmatched support for test 260 | refactoring. 261 | 262 | ### Advanced Features 263 | 264 | HUnit provides additional features for specifying assertions and tests more conveniently 265 | and concisely. These facilities make use of Haskell type classes. 266 | 267 | The following operators can be used to construct assertions. 268 | 269 | ```haskell 270 | infix 1 @?, @=?, @?= 271 | 272 | (@?) :: (AssertionPredicable t) => t -> String -> Assertion 273 | pred @? msg = assertionPredicate pred >>= assertBool msg 274 | 275 | (@=?) :: (Eq a, Show a) => a -> a -> Assertion 276 | expected @=? actual = assertEqual "" expected actual 277 | 278 | (@?=) :: (Eq a, Show a) => a -> a -> Assertion 279 | actual @?= expected = assertEqual "" expected actual 280 | ``` 281 | 282 | You provide a boolean condition and failure message separately to `(@?)`, as for 283 | `assertBool`, but in a different order. The `(@=?)` and `(@?=)` 284 | operators provide shorthands for `assertEqual` when no preface is required. They 285 | differ only in the order in which the expected and actual values are provided. (The 286 | actual value--the uncertain one--goes on the "?" side of the operator.) 287 | 288 | The `(@?)` operator's first argument is something from which an assertion 289 | predicate can be made, that is, its type must be `AssertionPredicable`. 290 | 291 | ```haskell 292 | type AssertionPredicate = IO Bool 293 | 294 | class AssertionPredicable t 295 | where assertionPredicate :: t -> AssertionPredicate 296 | 297 | instance AssertionPredicable Bool 298 | where assertionPredicate = return 299 | 300 | instance (AssertionPredicable t) => AssertionPredicable (IO t) 301 | where assertionPredicate = (>>= assertionPredicate) 302 | ``` 303 | 304 | The overloaded `assert` function in the `Assertable` type class constructs 305 | an assertion. 306 | 307 | ```haskell 308 | class Assertable t 309 | where assert :: t -> Assertion 310 | 311 | instance Assertable () 312 | where assert = return 313 | 314 | instance Assertable Bool 315 | where assert = assertBool "" 316 | 317 | instance (ListAssertable t) => Assertable [t] 318 | where assert = listAssert 319 | 320 | instance (Assertable t) => Assertable (IO t) 321 | where assert = (>>= assert) 322 | ``` 323 | 324 | The `ListAssertable` class allows `assert` to be applied to `[Char]` 325 | (that is, `String`). 326 | 327 | ```haskell 328 | class ListAssertable t 329 | where listAssert :: [t] -> Assertion 330 | 331 | instance ListAssertable Char 332 | where listAssert = assertString 333 | ``` 334 | 335 | With the above declarations, `(assert ())`, 336 | `(assert True)`, and `(assert "")` (as well as 337 | `IO` forms of these values, such as `(return ())`) are all 338 | assertions that never fail, while `(assert False)` and 339 | `(assert "some failure message")` (and their 340 | `IO` forms) are assertions that always fail. You may define additional 341 | instances for the type classes `Assertable`, `ListAssertable`, and 342 | `AssertionPredicable` if that should be useful in your application. 343 | 344 | The overloaded `test` function in the `Testable` type class constructs a 345 | test. 346 | 347 | ```haskell 348 | class Testable t 349 | where test :: t -> Test 350 | 351 | instance Testable Test 352 | where test = id 353 | 354 | instance (Assertable t) => Testable (IO t) 355 | where test = TestCase . assert 356 | 357 | instance (Testable t) => Testable [t] 358 | where test = TestList . map test 359 | ``` 360 | 361 | The `test` function makes a test from either an `Assertion` (using 362 | `TestCase`), a list of `Testable` items (using `TestList`), or 363 | a `Test` (making no change). 364 | 365 | The following operators can be used to construct tests. 366 | 367 | ```haskell 368 | infix 1 ~?, ~=?, ~?= 369 | infixr 0 ~: 370 | 371 | (~?) :: (AssertionPredicable t) => t -> String -> Test 372 | pred ~? msg = TestCase (pred @? msg) 373 | 374 | (~=?) :: (Eq a, Show a) => a -> a -> Test 375 | expected ~=? actual = TestCase (expected @=? actual) 376 | 377 | (~?=) :: (Eq a, Show a) => a -> a -> Test 378 | actual ~?= expected = TestCase (actual @?= expected) 379 | 380 | (~:) :: (Testable t) => String -> t -> Test 381 | label ~: t = TestLabel label (test t) 382 | ``` 383 | 384 | `(~?)`, `(~=?)`, and `(~?=)` each make an assertion, as for 385 | `(@?)`, `(@=?)`, and `(@?=)`, respectively, and then a test case 386 | from that assertion. `(~:)` attaches a label to something that is 387 | `Testable`. You may define additional instances for the type class 388 | `Testable` should that be useful. 389 | 390 | ## Running Tests 391 | 392 | HUnit is structured to support multiple test controllers. The first 393 | subsection below describes the [test execution](#test-execution) 394 | characteristics common to all test controllers. The second subsection 395 | describes the text-based controller that is included with HUnit. 396 | 397 | ## Test Execution 398 | 399 | All test controllers share a common test execution model. They differ only in how the 400 | results of test execution are shown. 401 | 402 | The execution of a test (a value of type `Test`) involves the serial execution (in 403 | the `IO` monad) of its constituent test cases. The test cases are executed in a 404 | depth-first, left-to-right order. During test execution, four counts of test cases are 405 | maintained: 406 | 407 | ```haskell 408 | data Counts = Counts { cases, tried, errors, failures :: Int } 409 | deriving (Eq, Show, Read) 410 | ``` 411 | 412 | 413 | * `cases` is the number of test cases included in the test. This number is a 414 | static property of a test and remains unchanged during test execution. 415 | * `tried` is the number of test cases that have been executed so far during the 416 | test execution. 417 | * `errors` is the number of test cases whose execution ended with an unexpected 418 | exception being raised. Errors indicate problems with test cases, as opposed to the 419 | code under test. 420 | * `failures` is the number of test cases whose execution asserted failure. 421 | Failures indicate problems with the code under test. 422 | 423 | 424 | Why is there no count for test case successes? The technical reason is that the counts 425 | are maintained such that the number of test case successes is always equal to 426 | `(tried - (errors + failures))`. The 427 | psychosocial reason is that, with test-centered development and the expectation that 428 | test failures will be few and short-lived, attention should be focused on the failures 429 | rather than the successes. 430 | 431 | As test execution proceeds, three kinds of reporting event are communicated to the test 432 | controller. (What the controller does in response to the reporting events depends on the 433 | controller.) 434 | 435 | * *start* -- Just prior to initiation of a test case, the path of the test case 436 | and the current counts (excluding the current test case) are reported. 437 | * *error* -- When a test case terminates with an error, the error message is 438 | reported, along with the test case path and current counts (including the current 439 | test case). 440 | * *failure* -- When a test case terminates with a failure, the failure message is 441 | reported, along with the test case path and current counts (including the current 442 | test case). 443 | 444 | Typically, a test controller shows *error* and *failure* reports immediately 445 | but uses the *start* report merely to update an indication of overall test 446 | execution progress. 447 | 448 | ### Text-Based Controller 449 | 450 | A text-based test controller is included with HUnit. 451 | 452 | ```haskell 453 | runTestText :: PutText st -> Test -> IO (Counts, st) 454 | ``` 455 | 456 | `runTestText` is generalized on a *reporting scheme* given as its first 457 | argument. During execution of the test given as its second argument, the controller 458 | creates a string for each reporting event and processes it according to the reporting 459 | scheme. When test execution is complete, the controller returns the final counts along 460 | with the final state for the reporting scheme. 461 | 462 | The strings for the three kinds of reporting event are as follows. 463 | 464 | * A *start* report is the result of the function `showCounts` applied to 465 | the counts current immediately prior to initiation of the test case being started. 466 | * An *error* report is of the form 467 | "`Error in: *path*\n*message*`", 468 | where *path* is the path of the test case in error, as shown by 469 | `showPath`, and *message* is a message describing the error. If the path 470 | is empty, the report has the form "`Error:\n*message*`". 471 | * A *failure* report is of the form 472 | "`Failure in: *path*\n*message*`", where 473 | *path* is the path of the test case in error, as shown by 474 | `showPath`, and *message* is the failure message. If the path is empty, 475 | the report has the form "`Failure:\n*message*`". 476 | 477 | The function `showCounts` shows a set of counts. 478 | 479 | ```haskell 480 | showCounts :: Counts -> String 481 | ``` 482 | 483 | The form of its result is 484 | `Cases: *cases* Tried: *tried* Errors: *errors* Failures: *failures*` 485 | where *cases*, *tried*, *errors*, and *failures* are the count values. 486 | 487 | The function `showPath` shows a test case path. 488 | 489 | ```haskell 490 | showPath :: Path -> String 491 | ``` 492 | 493 | The nodes in the path are reversed (so that the path reads from the root down to the test 494 | case), and the representations for the nodes are joined by '`:`' separators. The 495 | representation for `(ListItem *n*)` is `(show n)`. The representation 496 | for `(Label *label*)` is normally *label*. However, if *label* 497 | contains a colon or if `(show *label*)` is different from *label* 498 | surrounded by quotation marks--that is, if any ambiguity could exist--then `(Label 499 | *label*)` is represented as `(show *label*)`. 500 | 501 | HUnit includes two reporting schemes for the text-based test controller. You may define 502 | others if you wish. 503 | 504 | ```haskell 505 | putTextToHandle :: Handle -> Bool -> PutText Int 506 | ``` 507 | 508 | `putTextToHandle` writes error and failure reports, plus a report of the final 509 | counts, to the given handle. Each of these reports is terminated by a newline. In 510 | addition, if the given flag is `True`, it writes start reports to the handle as 511 | well. A start report, however, is not terminated by a newline. Before the next report is 512 | written, the start report is "erased" with an appropriate sequence of carriage return 513 | and space characters. Such overwriting realizes its intended effect on terminal devices. 514 | 515 | ```haskell 516 | putTextToShowS :: PutText ShowS 517 | ``` 518 | 519 | `putTextToShowS` ignores start reports and simply accumulates error and failure 520 | reports, terminating them with newlines. The accumulated reports are returned (as the 521 | second element of the pair returned by `runTestText`) as a `ShowS` 522 | function (that is, one with type `(String -> String)`) whose 523 | first argument is a string to be appended to the accumulated report lines. 524 | 525 | HUnit provides a shorthand for the most common use of the text-based test controller. 526 | 527 | ```haskell 528 | runTestTT :: Test -> IO Counts 529 | ``` 530 | 531 | `runTestTT` invokes `runTestText`, specifying `(putTextToHandle stderr 532 | True)` for the reporting scheme, and returns the final counts from the 533 | test execution. 534 | 535 | ## References 536 | 537 | * [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. 538 | 539 | * [junit.org](http://www.junit.org): Web page for JUnit, the tool after which HUnit is modeled. 540 | 541 | * [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. 542 | 543 | * [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. 544 | 545 | The HUnit software and this guide were written by Dean Herington [heringto@cs.unc.edu](mailto:heringto@cs.unc.edu) 546 | -------------------------------------------------------------------------------- /Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: 2 | HUnit.cabal 3 | 4 | package HUnit 5 | ghc-options: -Werror 6 | -------------------------------------------------------------------------------- /examples/Example.hs: -------------------------------------------------------------------------------- 1 | -- Example.hs -- Examples from HUnit user's guide 2 | -- 3 | -- For more examples, check out the tests directory. It contains unit tests 4 | -- for HUnit. 5 | 6 | module Example where 7 | 8 | import Test.HUnit 9 | 10 | 11 | foo :: Int -> (Int, Int) 12 | foo x = (1, x) 13 | 14 | partA :: Int -> IO (Int, Int) 15 | partA v = return (v+2, v+3) 16 | 17 | partB :: Int -> IO Bool 18 | partB v = return (v > 5) 19 | 20 | test1 :: Test 21 | test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3)) 22 | 23 | test2 :: Test 24 | test2 = TestCase (do (x,y) <- partA 3 25 | assertEqual "for the first result of partA," 5 x 26 | b <- partB y 27 | assertBool ("(partB " ++ show y ++ ") failed") b) 28 | 29 | tests :: Test 30 | tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2] 31 | 32 | tests' :: Test 33 | tests' = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3), 34 | "test2" ~: do (x, y) <- partA 3 35 | assertEqual "for the first result of partA," 5 x 36 | partB y @? "(partB " ++ show y ++ ") failed" ] 37 | 38 | main :: IO Counts 39 | main = do _ <- runTestTT tests 40 | runTestTT tests' 41 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: HUnit 2 | version: 1.6.2.0 3 | synopsis: A unit testing framework for Haskell 4 | category: Testing 5 | stability: stable 6 | author: Dean Herington 7 | maintainer: Simon Hengel 8 | license: BSD3 9 | github: hspec/HUnit 10 | description: | 11 | HUnit is a unit testing framework for Haskell, inspired by the 12 | JUnit tool for Java, see: . 13 | 14 | extra-source-files: 15 | - CHANGELOG.md 16 | - README.md 17 | 18 | dependencies: 19 | - base == 4.* 20 | - deepseq 21 | - call-stack >= 0.3.0 22 | 23 | ghc-options: -Wall 24 | 25 | library: 26 | source-dirs: src 27 | exposed-modules: 28 | - Test.HUnit.Base 29 | - Test.HUnit.Lang 30 | - Test.HUnit.Terminal 31 | - Test.HUnit.Text 32 | - Test.HUnit 33 | 34 | tests: 35 | tests: 36 | main: HUnitTests.hs 37 | source-dirs: 38 | - tests 39 | - examples 40 | dependencies: 41 | - filepath 42 | - HUnit 43 | -------------------------------------------------------------------------------- /src/Test/HUnit.hs: -------------------------------------------------------------------------------- 1 | -- | HUnit is a unit testing framework for Haskell, inspired by the JUnit tool 2 | -- for Java. This guide describes how to use HUnit, assuming you are familiar 3 | -- with Haskell, though not necessarily with JUnit. 4 | -- 5 | -- In the Haskell module where your tests will reside, import module 6 | -- @Test.HUnit@: 7 | -- 8 | -- @ 9 | -- import Test.HUnit 10 | -- @ 11 | -- 12 | -- Define test cases as appropriate: 13 | -- 14 | -- @ 15 | -- test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3)) 16 | -- test2 = TestCase (do (x,y) <- partA 3 17 | -- assertEqual "for the first result of partA," 5 x 18 | -- b <- partB y 19 | -- assertBool ("(partB " ++ show y ++ ") failed") b) 20 | -- @ 21 | -- 22 | -- Name the test cases and group them together: 23 | -- 24 | -- @ 25 | -- tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2] 26 | -- @ 27 | -- 28 | -- Run the tests as a group. At a Haskell interpreter prompt, apply the function 29 | -- @runTestTT@ to the collected tests. (The /TT/ suggests /T/ext orientation 30 | -- with output to the /T/erminal.) 31 | -- 32 | -- @ 33 | -- \> runTestTT tests 34 | -- Cases: 2 Tried: 2 Errors: 0 Failures: 0 35 | -- \> 36 | -- @ 37 | -- 38 | -- If the tests are proving their worth, you might see: 39 | -- 40 | -- @ 41 | -- \> runTestTT tests 42 | -- ### Failure in: 0:test1 43 | -- for (foo 3), 44 | -- expected: (1,2) 45 | -- but got: (1,3) 46 | -- Cases: 2 Tried: 2 Errors: 0 Failures: 1 47 | -- \> 48 | -- @ 49 | -- 50 | -- You can specify tests even more succinctly using operators and overloaded 51 | -- functions that HUnit provides: 52 | -- 53 | -- @ 54 | -- tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3), 55 | -- "test2" ~: do (x, y) <- partA 3 56 | -- assertEqual "for the first result of partA," 5 x 57 | -- partB y \@? "(partB " ++ show y ++ ") failed" ] 58 | -- @ 59 | -- 60 | -- Assuming the same test failures as before, you would see: 61 | -- 62 | -- @ 63 | -- \> runTestTT tests 64 | -- ### Failure in: 0:test1:(foo 3) 65 | -- expected: (1,2) 66 | -- but got: (1,3) 67 | -- Cases: 2 Tried: 2 Errors: 0 Failures: 1 68 | -- \> 69 | -- @ 70 | 71 | module Test.HUnit 72 | ( 73 | module Test.HUnit.Base, 74 | module Test.HUnit.Text 75 | ) 76 | where 77 | 78 | import Test.HUnit.Base 79 | import Test.HUnit.Text 80 | 81 | -------------------------------------------------------------------------------- /src/Test/HUnit/Base.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | 4 | #if __GLASGOW_HASKELL__ >= 704 5 | {-# LANGUAGE ConstraintKinds #-} 6 | #define HasCallStack_ HasCallStack => 7 | #else 8 | #define HasCallStack_ 9 | #endif 10 | 11 | -- | Basic definitions for the HUnit library. 12 | -- 13 | -- This module contains what you need to create assertions and test cases and 14 | -- combine them into test suites. 15 | -- 16 | -- This module also provides infrastructure for 17 | -- implementing test controllers (which are used to execute tests). 18 | -- See "Test.HUnit.Text" for a great example of how to implement a test 19 | -- controller. 20 | 21 | module Test.HUnit.Base 22 | ( 23 | -- ** Declaring tests 24 | Test(..), 25 | (~=?), (~?=), (~:), (~?), 26 | 27 | -- ** Making assertions 28 | assertFailure, {- from Test.HUnit.Lang: -} 29 | assertBool, assertEqual, assertString, 30 | Assertion, {- from Test.HUnit.Lang: -} 31 | (@=?), (@?=), (@?), 32 | 33 | -- ** Extending the assertion functionality 34 | Assertable(..), ListAssertable(..), 35 | AssertionPredicate, AssertionPredicable(..), 36 | Testable(..), 37 | 38 | -- ** Test execution 39 | -- $testExecutionNote 40 | State(..), Counts(..), 41 | Path, Node(..), 42 | testCasePaths, 43 | testCaseCount, 44 | ReportStart, ReportProblem, 45 | performTest 46 | ) where 47 | 48 | import Control.Monad (unless, foldM) 49 | import Data.CallStack 50 | 51 | 52 | -- Assertion Definition 53 | -- ==================== 54 | 55 | import Test.HUnit.Lang 56 | 57 | 58 | -- Conditional Assertion Functions 59 | -- ------------------------------- 60 | 61 | -- | Asserts that the specified condition holds. 62 | assertBool :: HasCallStack_ 63 | String -- ^ The message that is displayed if the assertion fails 64 | -> Bool -- ^ The condition 65 | -> Assertion 66 | assertBool msg b = unless b (assertFailure msg) 67 | 68 | -- | Signals an assertion failure if a non-empty message (i.e., a message 69 | -- other than @\"\"@) is passed. 70 | assertString :: HasCallStack_ 71 | String -- ^ The message that is displayed with the assertion failure 72 | -> Assertion 73 | assertString s = unless (null s) (assertFailure s) 74 | 75 | -- Overloaded `assert` Function 76 | -- ---------------------------- 77 | 78 | -- | Allows the extension of the assertion mechanism. 79 | -- 80 | -- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions, 81 | -- there is a fair amount of flexibility of what can be achieved. As a rule, 82 | -- the resulting @Assertion@ should be the body of a 'TestCase' or part of 83 | -- a @TestCase@; it should not be used to assert multiple, independent 84 | -- conditions. 85 | -- 86 | -- If more complex arrangements of assertions are needed, 'Test's and 87 | -- 'Testable' should be used. 88 | class Assertable t 89 | where assert :: HasCallStack_ t -> Assertion 90 | 91 | instance Assertable () 92 | where assert = return 93 | 94 | instance Assertable Bool 95 | where assert = assertBool "" 96 | 97 | instance (ListAssertable t) => Assertable [t] 98 | where assert = listAssert 99 | 100 | instance (Assertable t) => Assertable (IO t) 101 | where assert = (>>= assert) 102 | 103 | -- | A specialized form of 'Assertable' to handle lists. 104 | class ListAssertable t 105 | where listAssert :: HasCallStack_ [t] -> Assertion 106 | 107 | instance ListAssertable Char 108 | where listAssert = assertString 109 | 110 | 111 | -- Overloaded `assertionPredicate` Function 112 | -- ---------------------------------------- 113 | 114 | -- | The result of an assertion that hasn't been evaluated yet. 115 | -- 116 | -- Most test cases follow the following steps: 117 | -- 118 | -- 1. Do some processing or an action. 119 | -- 120 | -- 2. Assert certain conditions. 121 | -- 122 | -- However, this flow is not always suitable. @AssertionPredicate@ allows for 123 | -- additional steps to be inserted without the initial action to be affected 124 | -- by side effects. Additionally, clean-up can be done before the test case 125 | -- has a chance to end. A potential work flow is: 126 | -- 127 | -- 1. Write data to a file. 128 | -- 129 | -- 2. Read data from a file, evaluate conditions. 130 | -- 131 | -- 3. Clean up the file. 132 | -- 133 | -- 4. Assert that the side effects of the read operation meet certain conditions. 134 | -- 135 | -- 5. Assert that the conditions evaluated in step 2 are met. 136 | type AssertionPredicate = IO Bool 137 | 138 | -- | Used to signify that a data type can be converted to an assertion 139 | -- predicate. 140 | class AssertionPredicable t 141 | where assertionPredicate :: t -> AssertionPredicate 142 | 143 | instance AssertionPredicable Bool 144 | where assertionPredicate = return 145 | 146 | instance (AssertionPredicable t) => AssertionPredicable (IO t) 147 | where assertionPredicate = (>>= assertionPredicate) 148 | 149 | 150 | -- Assertion Construction Operators 151 | -- -------------------------------- 152 | 153 | infix 1 @?, @=?, @?= 154 | 155 | -- | Asserts that the condition obtained from the specified 156 | -- 'AssertionPredicable' holds. 157 | (@?) :: HasCallStack_ AssertionPredicable t 158 | => t -- ^ A value of which the asserted condition is predicated 159 | -> String -- ^ A message that is displayed if the assertion fails 160 | -> Assertion 161 | predi @? msg = assertionPredicate predi >>= assertBool msg 162 | 163 | -- | Asserts that the specified actual value is equal to the expected value 164 | -- (with the expected value on the left-hand side). 165 | (@=?) :: HasCallStack_ (Eq a, Show a) 166 | => a -- ^ The expected value 167 | -> a -- ^ The actual value 168 | -> Assertion 169 | expected @=? actual = assertEqual "" expected actual 170 | 171 | -- | Asserts that the specified actual value is equal to the expected value 172 | -- (with the actual value on the left-hand side). 173 | (@?=) :: HasCallStack_ (Eq a, Show a) 174 | => a -- ^ The actual value 175 | -> a -- ^ The expected value 176 | -> Assertion 177 | actual @?= expected = assertEqual "" expected actual 178 | 179 | 180 | 181 | -- Test Definition 182 | -- =============== 183 | 184 | -- | The basic structure used to create an annotated tree of test cases. 185 | data Test 186 | -- | A single, independent test case composed. 187 | = TestCase Assertion 188 | -- | A set of @Test@s sharing the same level in the hierarchy. 189 | | TestList [Test] 190 | -- | A name or description for a subtree of the @Test@s. 191 | | TestLabel String Test 192 | 193 | instance Show Test where 194 | showsPrec _ (TestCase _) = showString "TestCase _" 195 | showsPrec _ (TestList ts) = showString "TestList " . showList ts 196 | showsPrec p (TestLabel l t) = showString "TestLabel " . showString l 197 | . showChar ' ' . showsPrec p t 198 | 199 | -- Overloaded `test` Function 200 | -- -------------------------- 201 | 202 | -- | Provides a way to convert data into a @Test@ or set of @Test@. 203 | class Testable t 204 | where test :: HasCallStack_ t -> Test 205 | 206 | instance Testable Test 207 | where test = id 208 | 209 | instance (Assertable t) => Testable (IO t) 210 | where test = TestCase . assert 211 | 212 | instance (Testable t) => Testable [t] 213 | where test = TestList . map test 214 | 215 | 216 | -- Test Construction Operators 217 | -- --------------------------- 218 | 219 | infix 1 ~?, ~=?, ~?= 220 | infixr 0 ~: 221 | 222 | -- | Creates a test case resulting from asserting the condition obtained 223 | -- from the specified 'AssertionPredicable'. 224 | (~?) :: HasCallStack_ AssertionPredicable t 225 | => t -- ^ A value of which the asserted condition is predicated 226 | -> String -- ^ A message that is displayed on test failure 227 | -> Test 228 | predi ~? msg = TestCase (predi @? msg) 229 | 230 | -- | Shorthand for a test case that asserts equality (with the expected 231 | -- value on the left-hand side, and the actual value on the right-hand 232 | -- side). 233 | (~=?) :: HasCallStack_ (Eq a, Show a) 234 | => a -- ^ The expected value 235 | -> a -- ^ The actual value 236 | -> Test 237 | expected ~=? actual = TestCase (expected @=? actual) 238 | 239 | -- | Shorthand for a test case that asserts equality (with the actual 240 | -- value on the left-hand side, and the expected value on the right-hand 241 | -- side). 242 | (~?=) :: HasCallStack_ (Eq a, Show a) 243 | => a -- ^ The actual value 244 | -> a -- ^ The expected value 245 | -> Test 246 | actual ~?= expected = TestCase (actual @?= expected) 247 | 248 | -- | Creates a test from the specified 'Testable', with the specified 249 | -- label attached to it. 250 | -- 251 | -- Since 'Test' is @Testable@, this can be used as a shorthand way of attaching 252 | -- a 'TestLabel' to one or more tests. 253 | (~:) :: HasCallStack_ Testable t => String -> t -> Test 254 | label ~: t = TestLabel label (test t) 255 | 256 | 257 | 258 | -- Test Execution 259 | -- ============== 260 | 261 | -- $testExecutionNote 262 | -- Note: the rest of the functionality in this module is intended for 263 | -- implementors of test controllers. If you just want to run your tests cases, 264 | -- simply use a test controller, such as the text-based controller in 265 | -- "Test.HUnit.Text". 266 | 267 | -- | A data structure that hold the results of tests that have been performed 268 | -- up until this point. 269 | data Counts = Counts { cases, tried, errors, failures :: Int } 270 | deriving (Eq, Show, Read) 271 | 272 | -- | Keeps track of the remaining tests and the results of the performed tests. 273 | -- As each test is performed, the path is removed and the counts are 274 | -- updated as appropriate. 275 | data State = State { path :: Path, counts :: Counts } 276 | deriving (Eq, Show, Read) 277 | 278 | -- | Report generator for reporting the start of a test run. 279 | type ReportStart us = State -> us -> IO us 280 | 281 | -- | Report generator for reporting problems that have occurred during 282 | -- a test run. Problems may be errors or assertion failures. 283 | type ReportProblem us = Maybe SrcLoc -> String -> State -> us -> IO us 284 | 285 | -- | Uniquely describes the location of a test within a test hierarchy. 286 | -- Node order is from test case to root. 287 | type Path = [Node] 288 | 289 | -- | Composed into 'Path's. 290 | data Node = ListItem Int | Label String 291 | deriving (Eq, Show, Read) 292 | 293 | -- | Determines the paths for all 'TestCase's in a tree of @Test@s. 294 | testCasePaths :: Test -> [Path] 295 | testCasePaths t0 = tcp t0 [] 296 | where tcp (TestCase _) p = [p] 297 | tcp (TestList ts) p = 298 | concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ] 299 | tcp (TestLabel l t) p = tcp t (Label l : p) 300 | 301 | -- | Counts the number of 'TestCase's in a tree of @Test@s. 302 | testCaseCount :: Test -> Int 303 | testCaseCount (TestCase _) = 1 304 | testCaseCount (TestList ts) = sum (map testCaseCount ts) 305 | testCaseCount (TestLabel _ t) = testCaseCount t 306 | 307 | -- | Performs a test run with the specified report generators. 308 | -- 309 | -- This handles the actual running of the tests. Most developers will want 310 | -- to use @HUnit.Text.runTestTT@ instead. A developer could use this function 311 | -- to execute tests via another IO system, such as a GUI, or to output the 312 | -- results in a different manner (e.g., upload XML-formatted results to a 313 | -- webservice). 314 | -- 315 | -- Note that the counts in a start report do not include the test case 316 | -- being started, whereas the counts in a problem report do include the 317 | -- test case just finished. The principle is that the counts are sampled 318 | -- only between test case executions. As a result, the number of test 319 | -- case successes always equals the difference of test cases tried and 320 | -- the sum of test case errors and failures. 321 | performTest :: ReportStart us -- ^ report generator for the test run start 322 | -> ReportProblem us -- ^ report generator for errors during the test run 323 | -> ReportProblem us -- ^ report generator for assertion failures during the test run 324 | -> us 325 | -> Test -- ^ the test to be executed 326 | -> IO (Counts, us) 327 | performTest reportStart reportError reportFailure initialUs initialT = do 328 | (ss', us') <- pt initState initialUs initialT 329 | unless (null (path ss')) $ error "performTest: Final path is nonnull" 330 | return (counts ss', us') 331 | where 332 | initState = State{ path = [], counts = initCounts } 333 | initCounts = Counts{ cases = testCaseCount initialT, tried = 0, 334 | errors = 0, failures = 0} 335 | 336 | pt ss us (TestCase a) = do 337 | us' <- reportStart ss us 338 | r <- performTestCase a 339 | case r of 340 | Success -> do 341 | return (ss', us') 342 | Failure loc m -> do 343 | usF <- reportFailure loc m ssF us' 344 | return (ssF, usF) 345 | Error loc m -> do 346 | usE <- reportError loc m ssE us' 347 | return (ssE, usE) 348 | where c@Counts{ tried = n } = counts ss 349 | ss' = ss{ counts = c{ tried = n + 1 } } 350 | ssF = ss{ counts = c{ tried = n + 1, failures = failures c + 1 } } 351 | ssE = ss{ counts = c{ tried = n + 1, errors = errors c + 1 } } 352 | 353 | pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..]) 354 | where f (ss', us') (t, n) = withNode (ListItem n) ss' us' t 355 | 356 | pt ss us (TestLabel label t) = withNode (Label label) ss us t 357 | 358 | withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t 359 | return (ss2{ path = path0 }, us1) 360 | where path0 = path ss0 361 | ss1 = ss0{ path = node : path0 } 362 | -------------------------------------------------------------------------------- /src/Test/HUnit/Lang.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveDataTypeable #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | 5 | #if __GLASGOW_HASKELL__ >= 704 6 | {-# LANGUAGE ConstraintKinds #-} 7 | #define HasCallStack_ HasCallStack => 8 | #else 9 | #define HasCallStack_ 10 | #endif 11 | 12 | module Test.HUnit.Lang ( 13 | Assertion, 14 | assertFailure, 15 | assertEqual, 16 | 17 | Result (..), 18 | performTestCase, 19 | -- * Internals 20 | -- | 21 | -- /Note:/ This is not part of the public API! It is exposed so that you can 22 | -- tinker with the internals of HUnit, but do not expect it to be stable! 23 | HUnitFailure (..), 24 | FailureReason (..), 25 | formatFailureReason 26 | ) where 27 | 28 | import Control.DeepSeq 29 | import Control.Exception as E 30 | import Control.Monad 31 | import Data.List 32 | import Data.Typeable 33 | import Data.CallStack 34 | 35 | -- | When an assertion is evaluated, it will output a message if and only if the 36 | -- assertion fails. 37 | -- 38 | -- Test cases are composed of a sequence of one or more assertions. 39 | type Assertion = IO () 40 | 41 | data HUnitFailure = HUnitFailure (Maybe SrcLoc) FailureReason 42 | deriving (Eq, Show, Typeable) 43 | 44 | instance Exception HUnitFailure 45 | 46 | data FailureReason = Reason String | ExpectedButGot (Maybe String) String String 47 | deriving (Eq, Show, Typeable) 48 | 49 | location :: HasCallStack_ Maybe SrcLoc 50 | location = case reverse callStack of 51 | (_, loc) : _ -> Just loc 52 | [] -> Nothing 53 | 54 | -- | Unconditionally signals that a failure has occurred. 55 | assertFailure :: 56 | HasCallStack_ 57 | String -- ^ A message that is displayed with the assertion failure 58 | -> IO a 59 | assertFailure msg = msg `deepseq` E.throwIO (HUnitFailure location $ Reason msg) 60 | 61 | -- | Asserts that the specified actual value is equal to the expected value. 62 | -- The output message will contain the prefix, the expected value, and the 63 | -- actual value. 64 | -- 65 | -- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted 66 | -- and only the expected and actual values are output. 67 | assertEqual :: HasCallStack_ (Eq a, Show a) 68 | => String -- ^ The message prefix 69 | -> a -- ^ The expected value 70 | -> a -- ^ The actual value 71 | -> Assertion 72 | assertEqual preface expected actual = 73 | unless (actual == expected) $ do 74 | (prefaceMsg `deepseq` expectedMsg `deepseq` actualMsg `deepseq` E.throwIO (HUnitFailure location $ ExpectedButGot prefaceMsg expectedMsg actualMsg)) 75 | where 76 | prefaceMsg 77 | | null preface = Nothing 78 | | otherwise = Just preface 79 | expectedMsg = show expected 80 | actualMsg = show actual 81 | 82 | formatFailureReason :: FailureReason -> String 83 | formatFailureReason (Reason reason) = reason 84 | formatFailureReason (ExpectedButGot preface expected actual) = intercalate "\n" . maybe id (:) preface $ ["expected: " ++ expected, " but got: " ++ actual] 85 | 86 | data Result = Success | Failure (Maybe SrcLoc) String | Error (Maybe SrcLoc) String 87 | deriving (Eq, Show) 88 | 89 | -- | Performs a single test case. 90 | performTestCase :: Assertion -- ^ an assertion to be made during the test case run 91 | -> IO Result 92 | performTestCase action = 93 | (action >> return Success) 94 | `E.catches` 95 | [E.Handler (\(HUnitFailure loc reason) -> return $ Failure loc (formatFailureReason reason)), 96 | 97 | -- Re-throw AsyncException, otherwise execution will not terminate on 98 | -- SIGINT (ctrl-c). Currently, all AsyncExceptions are being thrown 99 | -- because it's thought that none of them will be encountered during 100 | -- normal HUnit operation. If you encounter an example where this 101 | -- is not the case, please email the maintainer. 102 | E.Handler (\e -> throw (e :: E.AsyncException)), 103 | 104 | E.Handler (\e -> return $ Error Nothing $ show (e :: E.SomeException))] 105 | -------------------------------------------------------------------------------- /src/Test/HUnit/Terminal.hs: -------------------------------------------------------------------------------- 1 | -- | This module handles the complexities of writing information to the 2 | -- terminal, including modifying text in place. 3 | 4 | module Test.HUnit.Terminal ( 5 | terminalAppearance 6 | ) where 7 | 8 | import Data.Char (isPrint) 9 | 10 | 11 | -- | Simplifies the input string by interpreting @\\r@ and @\\b@ characters 12 | -- specially so that the result string has the same final (or /terminal/, 13 | -- pun intended) appearance as would the input string when written to a 14 | -- terminal that overwrites character positions following carriage 15 | -- returns and backspaces. 16 | 17 | terminalAppearance :: String -> String 18 | terminalAppearance str = ta id "" "" str 19 | 20 | -- | The helper function @ta@ takes an accumulating @ShowS@-style function 21 | -- that holds /committed/ lines of text, a (reversed) list of characters 22 | -- on the current line /before/ the cursor, a (normal) list of characters 23 | -- on the current line /after/ the cursor, and the remaining input. 24 | 25 | ta 26 | :: ([Char] -> t) -- ^ An accumulating @ShowS@-style function 27 | -- that holds /committed/ lines of text 28 | -> [Char] -- ^ A (reversed) list of characters 29 | -- on the current line /before/ the cursor 30 | -> [Char] -- ^ A (normal) list of characters 31 | -- on the current line /after/ the cursor 32 | -> [Char] -- ^ The remaining input 33 | -> t 34 | ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs 35 | ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs 36 | ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs 37 | ta _ "" _ ('\b': _) = error "'\\b' at beginning of line" 38 | ta f bs as (c:cs) 39 | | not (isPrint c) = error "invalid nonprinting character" 40 | | null as = ta f (c:bs) "" cs 41 | | otherwise = ta f (c:bs) (tail as) cs 42 | ta f bs as "" = f (reverse bs ++ as) 43 | -------------------------------------------------------------------------------- /src/Test/HUnit/Text.hs: -------------------------------------------------------------------------------- 1 | -- | Text-based test controller for running HUnit tests and reporting 2 | -- results as text, usually to a terminal. 3 | 4 | module Test.HUnit.Text 5 | ( 6 | PutText(..), 7 | putTextToHandle, putTextToShowS, 8 | runTestText, 9 | showPath, showCounts, 10 | runTestTT, 11 | runTestTTAndExit 12 | ) 13 | where 14 | 15 | import Test.HUnit.Base 16 | 17 | import Data.CallStack 18 | import Control.Monad (when) 19 | import System.IO (Handle, stderr, hPutStr, hPutStrLn) 20 | import System.Exit (exitSuccess, exitFailure) 21 | 22 | 23 | -- | As the general text-based test controller ('runTestText') executes a 24 | -- test, it reports each test case start, error, and failure by 25 | -- constructing a string and passing it to the function embodied in a 26 | -- 'PutText'. A report string is known as a \"line\", although it includes 27 | -- no line terminator; the function in a 'PutText' is responsible for 28 | -- terminating lines appropriately. Besides the line, the function 29 | -- receives a flag indicating the intended \"persistence\" of the line: 30 | -- 'True' indicates that the line should be part of the final overall 31 | -- report; 'False' indicates that the line merely indicates progress of 32 | -- the test execution. Each progress line shows the current values of 33 | -- the cumulative test execution counts; a final, persistent line shows 34 | -- the final count values. 35 | -- 36 | -- The 'PutText' function is also passed, and returns, an arbitrary state 37 | -- value (called 'st' here). The initial state value is given in the 38 | -- 'PutText'; the final value is returned by 'runTestText'. 39 | 40 | data PutText st = PutText (String -> Bool -> st -> IO st) st 41 | 42 | 43 | -- | Two reporting schemes are defined here. @putTextToHandle@ writes 44 | -- report lines to a given handle. 'putTextToShowS' accumulates 45 | -- persistent lines for return as a whole by 'runTestText'. 46 | -- 47 | -- @putTextToHandle@ writes persistent lines to the given handle, 48 | -- following each by a newline character. In addition, if the given flag 49 | -- is @True@, it writes progress lines to the handle as well. A progress 50 | -- line is written with no line termination, so that it can be 51 | -- overwritten by the next report line. As overwriting involves writing 52 | -- carriage return and blank characters, its proper effect is usually 53 | -- only obtained on terminal devices. 54 | 55 | putTextToHandle 56 | :: Handle 57 | -> Bool -- ^ Write progress lines to handle? 58 | -> PutText Int 59 | putTextToHandle handle showProgress = PutText put initCnt 60 | where 61 | initCnt = if showProgress then 0 else -1 62 | put line pers (-1) = do when pers (hPutStrLn handle line); return (-1) 63 | put line True cnt = do hPutStrLn handle (erase cnt ++ line); return 0 64 | put line False _ = do hPutStr handle ('\r' : line); return (length line) 65 | -- The "erasing" strategy with a single '\r' relies on the fact that the 66 | -- lengths of successive summary lines are monotonically nondecreasing. 67 | erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r" 68 | 69 | 70 | -- | Accumulates persistent lines (dropping progress lines) for return by 71 | -- 'runTestText'. The accumulated lines are represented by a 72 | -- @'ShowS' ('String' -> 'String')@ function whose first argument is the 73 | -- string to be appended to the accumulated report lines. 74 | 75 | putTextToShowS :: PutText ShowS 76 | putTextToShowS = PutText put id 77 | where put line pers f = return (if pers then acc f line else f) 78 | acc f line rest = f (line ++ '\n' : rest) 79 | 80 | 81 | -- | Executes a test, processing each report line according to the given 82 | -- reporting scheme. The reporting scheme's state is threaded through calls 83 | -- to the reporting scheme's function and finally returned, along with final 84 | -- count values. 85 | 86 | runTestText :: PutText st -> Test -> IO (Counts, st) 87 | runTestText (PutText put us0) t = do 88 | (counts', us1) <- performTest reportStart reportError reportFailure us0 t 89 | us2 <- put (showCounts counts') True us1 90 | return (counts', us2) 91 | where 92 | reportStart ss us = put (showCounts (counts ss)) False us 93 | reportError = reportProblem "Error:" "Error in: " 94 | reportFailure = reportProblem "Failure:" "Failure in: " 95 | reportProblem p0 p1 loc msg ss us = put line True us 96 | where line = "### " ++ kind ++ path' ++ "\n" ++ formatLocation loc ++ msg 97 | kind = if null path' then p0 else p1 98 | path' = showPath (path ss) 99 | 100 | formatLocation :: Maybe SrcLoc -> String 101 | formatLocation Nothing = "" 102 | formatLocation (Just loc) = srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ "\n" 103 | 104 | -- | Converts test execution counts to a string. 105 | 106 | showCounts :: Counts -> String 107 | showCounts Counts{ cases = cases', tried = tried', 108 | errors = errors', failures = failures' } = 109 | "Cases: " ++ show cases' ++ " Tried: " ++ show tried' ++ 110 | " Errors: " ++ show errors' ++ " Failures: " ++ show failures' 111 | 112 | 113 | -- | Converts a test case path to a string, separating adjacent elements by 114 | -- the colon (\':\'). An element of the path is quoted (as with 'show') when 115 | -- there is potential ambiguity. 116 | 117 | showPath :: Path -> String 118 | showPath [] = "" 119 | showPath nodes = foldl1 f (map showNode nodes) 120 | where f b a = a ++ ":" ++ b 121 | showNode (ListItem n) = show n 122 | showNode (Label label) = safe label (show label) 123 | safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s 124 | 125 | 126 | -- | Provides the \"standard\" text-based test controller. Reporting is made to 127 | -- standard error, and progress reports are included. For possible 128 | -- programmatic use, the final counts are returned. 129 | -- 130 | -- The \"TT\" in the name suggests \"Text-based reporting to the Terminal\". 131 | 132 | runTestTT :: Test -> IO Counts 133 | runTestTT t = do (counts', 0) <- runTestText (putTextToHandle stderr True) t 134 | return counts' 135 | 136 | -- | Convenience wrapper for 'runTestTT'. 137 | -- Simply runs 'runTestTT' and then exits back to the OS, 138 | -- using 'exitSuccess' if there were no errors or failures, 139 | -- or 'exitFailure' if there were. For example: 140 | -- 141 | -- > tests :: Test 142 | -- > tests = ... 143 | -- > 144 | -- > main :: IO () 145 | -- > main = runTestTTAndExit tests 146 | 147 | runTestTTAndExit :: Test -> IO () 148 | runTestTTAndExit tests = do 149 | c <- runTestTT tests 150 | if (errors c == 0) && (failures c == 0) 151 | then exitSuccess 152 | else exitFailure 153 | -------------------------------------------------------------------------------- /tests/HUnitTestBase.lhs: -------------------------------------------------------------------------------- 1 | HUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant) 2 | 3 | > {-# LANGUAGE CPP #-} 4 | > module HUnitTestBase where 5 | 6 | > import Data.List 7 | > import Test.HUnit 8 | > import Test.HUnit.Terminal (terminalAppearance) 9 | > import System.IO (IOMode(..), openFile, hClose) 10 | 11 | 12 | > data Report = Start State 13 | > | Error String State 14 | > | UnspecifiedError State 15 | > | Failure String State 16 | > deriving (Show, Read) 17 | 18 | > instance Eq Report where 19 | > Start s1 == Start s2 = s1 == s2 20 | > Error m1 s1 == Error m2 s2 = m1 == m2 && s1 == s2 21 | > Error _ s1 == UnspecifiedError s2 = s1 == s2 22 | > UnspecifiedError s1 == Error _ s2 = s1 == s2 23 | > UnspecifiedError s1 == UnspecifiedError s2 = s1 == s2 24 | > Failure m1 s1 == Failure m2 s2 = m1 == m2 && s1 == s2 25 | > _ == _ = False 26 | 27 | 28 | > expectReports :: [Report] -> Counts -> Test -> Test 29 | > expectReports reports1 counts1 t = TestCase $ do 30 | > (counts2, reports2) <- performTest (\ ss us -> return (Start ss : us)) 31 | > (\_loc m ss us -> return (Error m ss : us)) 32 | > (\_loc m ss us -> return (Failure m ss : us)) 33 | > [] t 34 | > assertEqual "for the reports from a test," reports1 (reverse reports2) 35 | > assertEqual "for the counts from a test," counts1 counts2 36 | 37 | 38 | > simpleStart :: Report 39 | > simpleStart = Start (State [] (Counts 1 0 0 0)) 40 | 41 | > expectSuccess :: Test -> Test 42 | > expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0) 43 | 44 | > expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test 45 | > expectProblem kind err msg = 46 | > expectReports [simpleStart, kind msg (State [] counts')] counts' 47 | > where counts' = Counts 1 1 err (1-err) 48 | 49 | > expectError, expectFailure :: String -> Test -> Test 50 | > expectError = expectProblem Error 1 51 | > expectFailure = expectProblem Failure 0 52 | 53 | > expectUnspecifiedError :: Test -> Test 54 | > expectUnspecifiedError = expectProblem (\ _msg st -> UnspecifiedError st) 1 undefined 55 | 56 | 57 | > data Expect = Succ | Err String | UErr | Fail String 58 | 59 | > expect :: Expect -> Test -> Test 60 | > expect Succ t = expectSuccess t 61 | > expect (Err m) t = expectError m t 62 | > expect UErr t = expectUnspecifiedError t 63 | > expect (Fail m) t = expectFailure m t 64 | 65 | 66 | 67 | > baseTests :: Test 68 | > baseTests = test [ assertTests, 69 | > testCaseCountTests, 70 | > testCasePathsTests, 71 | > reportTests, 72 | > textTests, 73 | > showPathTests, 74 | > showCountsTests, 75 | > assertableTests, 76 | > predicableTests, 77 | > compareTests, 78 | > extendedTestTests ] 79 | 80 | 81 | > ok :: Test 82 | > ok = test (assert ()) 83 | > bad :: String -> Test 84 | > bad m = test (assertFailure m :: Assertion) 85 | 86 | 87 | > assertTests :: Test 88 | > assertTests = test [ 89 | 90 | > "null" ~: expectSuccess ok, 91 | 92 | > "userError" ~: 93 | > expectError "user error (error)" (TestCase (ioError (userError "error"))), 94 | 95 | > "IO error (file missing)" ~: 96 | > expectUnspecifiedError 97 | > (test (do _ <- openFile "3g9djs" ReadMode; return ())), 98 | 99 | "error" ~: 100 | expectError "error" (TestCase (error "error")), 101 | 102 | "tail []" ~: 103 | expectUnspecifiedError (TestCase (tail [] `seq` return ())), 104 | 105 | -- GHC doesn't currently catch arithmetic exceptions. 106 | "div by 0" ~: 107 | expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), 108 | 109 | > "assertFailure" ~: 110 | > let msg = "simple assertFailure" 111 | > in expectFailure msg (test (assertFailure msg :: Assertion)), 112 | 113 | > "assertString null" ~: expectSuccess (TestCase (assertString "")), 114 | 115 | > "assertString nonnull" ~: 116 | > let msg = "assertString nonnull" 117 | > in expectFailure msg (TestCase (assertString msg)), 118 | 119 | > let f v non = 120 | > show v ++ " with " ++ non ++ "null message" ~: 121 | > expect (if v then Succ else Fail non) $ test $ assertBool non v 122 | > in "assertBool" ~: [ f v non | v <- [True, False], non <- ["non", ""] ], 123 | 124 | > let msg = "assertBool True" 125 | > in msg ~: expectSuccess (test (assertBool msg True)), 126 | 127 | > let msg = "assertBool False" 128 | > in msg ~: expectFailure msg (test (assertBool msg False)), 129 | 130 | > "assertEqual equal" ~: 131 | > expectSuccess (test (assertEqual "" (3 :: Integer) (3 :: Integer))), 132 | 133 | > "assertEqual unequal no msg" ~: 134 | > expectFailure "expected: 3\n but got: 4" 135 | > (test (assertEqual "" (3 :: Integer) (4 :: Integer))), 136 | 137 | > "assertEqual unequal with msg" ~: 138 | > expectFailure "for x,\nexpected: 3\n but got: 4" 139 | > (test (assertEqual "for x," (3 :: Integer) (4 :: Integer))) 140 | 141 | > ] 142 | 143 | 144 | > emptyTest0, emptyTest1, emptyTest2 :: Test 145 | > emptyTest0 = TestList [] 146 | > emptyTest1 = TestLabel "empty" emptyTest0 147 | > emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ] 148 | > emptyTests :: [Test] 149 | > emptyTests = [emptyTest0, emptyTest1, emptyTest2] 150 | 151 | > testCountEmpty :: Test -> Test 152 | > testCountEmpty t = TestCase (assertEqual "" 0 (testCaseCount t)) 153 | 154 | > suite0, suite1, suite2, suite3 :: (Integer, Test) 155 | > suite0 = (0, ok) 156 | > suite1 = (1, TestList []) 157 | > suite2 = (2, TestLabel "3" ok) 158 | > suite3 = (3, suite) 159 | 160 | > suite :: Test 161 | > suite = 162 | > TestLabel "0" 163 | > (TestList [ TestLabel "1" (bad "1"), 164 | > TestLabel "2" (TestList [ TestLabel "2.1" ok, 165 | > ok, 166 | > TestLabel "2.3" (bad "2") ]), 167 | > TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))), 168 | > TestList [ TestList [ TestLabel "6" (bad "4") ] ] ]) 169 | 170 | > suiteCount :: Int 171 | > suiteCount = 6 172 | 173 | > suitePaths :: [[Node]] 174 | > suitePaths = [ 175 | > [Label "0", ListItem 0, Label "1"], 176 | > [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"], 177 | > [Label "0", ListItem 1, Label "2", ListItem 1], 178 | > [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"], 179 | > [Label "0", ListItem 2, Label "3", Label "4", Label "5"], 180 | > [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]] 181 | 182 | > suiteReports :: [Report] 183 | > suiteReports = [ Start (State (p 0) (Counts 6 0 0 0)), 184 | > Failure "1" (State (p 0) (Counts 6 1 0 1)), 185 | > Start (State (p 1) (Counts 6 1 0 1)), 186 | > Start (State (p 2) (Counts 6 2 0 1)), 187 | > Start (State (p 3) (Counts 6 3 0 1)), 188 | > Failure "2" (State (p 3) (Counts 6 4 0 2)), 189 | > Start (State (p 4) (Counts 6 4 0 2)), 190 | > Failure "3" (State (p 4) (Counts 6 5 0 3)), 191 | > Start (State (p 5) (Counts 6 5 0 3)), 192 | > Failure "4" (State (p 5) (Counts 6 6 0 4))] 193 | > where p n = reverse (suitePaths !! n) 194 | 195 | > suiteCounts :: Counts 196 | > suiteCounts = Counts 6 6 0 4 197 | 198 | > suiteOutput :: String 199 | > suiteOutput = concat [ 200 | > "### Failure in: 0:0:1\n", 201 | > "1\n", 202 | > "### Failure in: 0:1:2:2:2.3\n", 203 | > "2\n", 204 | > "### Failure in: 0:2:3:4:5\n", 205 | > "3\n", 206 | > "### Failure in: 0:3:0:0:6\n", 207 | > "4\n", 208 | > "Cases: 6 Tried: 6 Errors: 0 Failures: 4\n"] 209 | 210 | 211 | > suites :: [(Integer, Test)] 212 | > suites = [suite0, suite1, suite2, suite3] 213 | 214 | 215 | > testCount :: Show n => (n, Test) -> Int -> Test 216 | > testCount (num, t) count = 217 | > "testCaseCount suite" ++ show num ~: 218 | > TestCase $ assertEqual "for test count," count (testCaseCount t) 219 | 220 | > testCaseCountTests :: Test 221 | > testCaseCountTests = TestList [ 222 | 223 | > "testCaseCount empty" ~: test (map testCountEmpty emptyTests), 224 | 225 | > testCount suite0 1, 226 | > testCount suite1 0, 227 | > testCount suite2 1, 228 | > testCount suite3 suiteCount 229 | 230 | > ] 231 | 232 | 233 | > testPaths :: Show n => (n, Test) -> [[Node]] -> Test 234 | > testPaths (num, t) paths = 235 | > "testCasePaths suite" ++ show num ~: 236 | > TestCase $ assertEqual "for test paths," 237 | > (map reverse paths) (testCasePaths t) 238 | 239 | > testPathsEmpty :: Test -> Test 240 | > testPathsEmpty t = TestCase $ assertEqual "" [] (testCasePaths t) 241 | 242 | > testCasePathsTests :: Test 243 | > testCasePathsTests = TestList [ 244 | 245 | > "testCasePaths empty" ~: test (map testPathsEmpty emptyTests), 246 | 247 | > testPaths suite0 [[]], 248 | > testPaths suite1 [], 249 | > testPaths suite2 [[Label "3"]], 250 | > testPaths suite3 suitePaths 251 | 252 | > ] 253 | 254 | 255 | > reportTests :: Test 256 | > reportTests = "reports" ~: expectReports suiteReports suiteCounts suite 257 | 258 | > removeLocation :: String -> String 259 | > removeLocation = unlines . filter (not . isInfixOf __FILE__) . lines 260 | 261 | > expectText :: Counts -> String -> Test -> Test 262 | > expectText counts1 text1 t = TestCase $ do 263 | > (counts2, text2) <- runTestText putTextToShowS t 264 | > assertEqual "for the final counts," counts1 counts2 265 | > assertEqual "for the failure text output," text1 (removeLocation $ text2 "") 266 | 267 | 268 | > textTests :: Test 269 | > textTests = test [ 270 | 271 | > "lone error" ~: 272 | > expectText (Counts 1 1 1 0) 273 | > "### Error:\nuser error (xyz)\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" 274 | > (test (do _ <- ioError (userError "xyz"); return ())), 275 | 276 | > "lone failure" ~: 277 | > expectText (Counts 1 1 0 1) 278 | > "### Failure:\nxyz\nCases: 1 Tried: 1 Errors: 0 Failures: 1\n" 279 | > (test (assert "xyz")), 280 | 281 | > "putTextToShowS" ~: 282 | > expectText suiteCounts suiteOutput suite, 283 | 284 | > "putTextToHandle (file)" ~: 285 | > let filename = "HUnitTest.tmp" 286 | > trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines 287 | > in map test 288 | > [ "show progress = " ++ show flag ~: do 289 | > handle <- openFile filename WriteMode 290 | > (counts', _) <- runTestText (putTextToHandle handle flag) suite 291 | > hClose handle 292 | > assertEqual "for the final counts," suiteCounts counts' 293 | > text <- readFile filename 294 | > let text' = removeLocation $ if flag then trim (terminalAppearance text) else text 295 | > assertEqual "for the failure text output," suiteOutput text' 296 | > | flag <- [False, True] ] 297 | 298 | > ] 299 | 300 | 301 | > showPathTests :: Test 302 | > showPathTests = "showPath" ~: [ 303 | 304 | > "empty" ~: showPath [] ~?= "", 305 | > ":" ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"", 306 | > "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"", 307 | > "misc" ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?= 308 | > "foo:3:2:b" 309 | 310 | > ] 311 | 312 | 313 | > showCountsTests :: Test 314 | > showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?= 315 | > "Cases: 4 Tried: 3 Errors: 2 Failures: 1" 316 | 317 | 318 | 319 | > lift :: a -> IO a 320 | > lift a = return a 321 | 322 | 323 | > assertableTests :: Test 324 | > assertableTests = 325 | > let assertables x = [ 326 | > ( "", assert x , test (lift x)) , 327 | > ( "IO ", assert (lift x) , test (lift (lift x))) , 328 | > ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))] 329 | > assertabled l e x = 330 | > test [ test [ "assert" ~: pre ++ l ~: expect e $ test $ a, 331 | > "test" ~: pre ++ "IO " ++ l ~: expect e $ t ] 332 | > | (pre, a, t) <- assertables x ] 333 | > in "assertable" ~: [ 334 | > assertabled "()" Succ (), 335 | > assertabled "True" Succ True, 336 | > assertabled "False" (Fail "") False, 337 | > assertabled "\"\"" Succ "", 338 | > assertabled "\"x\"" (Fail "x") "x" 339 | > ] 340 | 341 | 342 | > predicableTests :: Test 343 | > predicableTests = 344 | > let predicables x m = [ 345 | > ( "", assertionPredicate x , x @? m, x ~? m ), 346 | > ( "IO ", assertionPredicate (l x) , l x @? m, l x ~? m ), 347 | > ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )] 348 | > l x = lift x 349 | > predicabled lab e m x = 350 | > test [ test [ "pred" ~: pre ++ lab ~: m ~: expect e $ test $ tst p, 351 | > "(@?)" ~: pre ++ lab ~: m ~: expect e $ test $ a, 352 | > "(~?)" ~: pre ++ lab ~: m ~: expect e $ t ] 353 | > | (pre, p, a, t) <- predicables x m ] 354 | > where tst p = p >>= assertBool m 355 | > in "predicable" ~: [ 356 | > predicabled "True" Succ "error" True, 357 | > predicabled "False" (Fail "error") "error" False, 358 | > predicabled "True" Succ "" True, 359 | > predicabled "False" (Fail "" ) "" False 360 | > ] 361 | 362 | 363 | > compareTests :: Test 364 | > compareTests = test [ 365 | 366 | > let succ' = const Succ 367 | > compare1 :: (String -> Expect) -> Integer -> Integer -> Test 368 | > compare1 = compare' 369 | > compare2 :: (String -> Expect) 370 | > -> (Integer, Char, Double) 371 | > -> (Integer, Char, Double) 372 | > -> Test 373 | > compare2 = compare' 374 | > compare' f expected actual 375 | > = test [ "(@=?)" ~: expect e $ test (expected @=? actual), 376 | > "(@?=)" ~: expect e $ test (actual @?= expected), 377 | > "(~=?)" ~: expect e $ expected ~=? actual, 378 | > "(~?=)" ~: expect e $ actual ~?= expected ] 379 | > where e = f $ "expected: " ++ show expected ++ 380 | > "\n but got: " ++ show actual 381 | > in test [ 382 | > compare1 succ' 1 1, 383 | > compare1 Fail 1 2, 384 | > compare2 succ' (1,'b',3.0) (1,'b',3.0), 385 | > compare2 Fail (1,'b',3.0) (1,'b',3.1) 386 | > ] 387 | 388 | > ] 389 | 390 | 391 | > expectList1 :: Int -> Test -> Test 392 | > expectList1 c = 393 | > expectReports 394 | > [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ] 395 | > (Counts c c 0 0) 396 | 397 | > expectList2 :: [Int] -> Test -> Test 398 | > expectList2 cs t = 399 | > expectReports 400 | > [ Start (State [ListItem j, ListItem i] (Counts c n 0 0)) 401 | > | ((i,j),n) <- zip coords [0..] ] 402 | > (Counts c c 0 0) 403 | > t 404 | > where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ] 405 | > c = testCaseCount t 406 | 407 | 408 | > extendedTestTests :: Test 409 | > extendedTestTests = test [ 410 | 411 | > "test idempotent" ~: expect Succ $ test $ test $ test $ ok, 412 | 413 | > "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True], 414 | 415 | > "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]] 416 | 417 | > ] 418 | -------------------------------------------------------------------------------- /tests/HUnitTestExtended.hs: -------------------------------------------------------------------------------- 1 | module HUnitTestExtended (extendedTests) where 2 | 3 | import Test.HUnit 4 | import HUnitTestBase 5 | 6 | extendedTests :: Test 7 | extendedTests = test [ 8 | "div by 0" ~: 9 | expectError "divide by zero" (TestCase ((3 `div` 0 :: Integer) `seq` return ())), 10 | 11 | "list ref out of bounds" ~: 12 | expectUnspecifiedError (TestCase ([1 .. 4 :: Integer] !! 10 `seq` return ())), 13 | 14 | "error" ~: 15 | expectUnspecifiedError (TestCase (error "error")), 16 | 17 | "tail []" ~: 18 | expectUnspecifiedError (TestCase (tail [] `seq` return ())) 19 | ] 20 | -------------------------------------------------------------------------------- /tests/HUnitTests.hs: -------------------------------------------------------------------------------- 1 | -- HUnitTests.hs 2 | -- 3 | -- This file is an entry point for running all of the tests. 4 | 5 | module Main (main) where 6 | 7 | import System.Exit 8 | 9 | import Test.HUnit 10 | import HUnitTestBase 11 | import HUnitTestExtended 12 | import TerminalTest 13 | import Example () 14 | 15 | main :: IO () 16 | main = do 17 | counts2 <- runTestTT (test [ 18 | baseTests, 19 | extendedTests, 20 | terminalTests 21 | ]) 22 | if (errors counts2 + failures counts2 == 0) 23 | then exitSuccess 24 | else exitFailure 25 | -------------------------------------------------------------------------------- /tests/TerminalTest.hs: -------------------------------------------------------------------------------- 1 | -- TerminalTest.hs 2 | 3 | module TerminalTest (terminalTests) where 4 | 5 | import Test.HUnit.Terminal 6 | import Test.HUnit 7 | 8 | try :: String -> String -> String -> Test 9 | try lab inp exp' = lab ~: terminalAppearance inp ~?= exp' 10 | 11 | terminalTests :: Test 12 | terminalTests = test [ 13 | try "empty" "" "", 14 | try "end in \\n" "abc\ndef\n" "abc\ndef\n", 15 | try "not end in \\n" "abc\ndef" "abc\ndef", 16 | try "return 1" "abc\ndefgh\rxyz" "abc\nxyzgh", 17 | try "return 2" "\nabcdefgh\rijklm\rxy\n" "\nxyklmfgh\n", 18 | try "return 3" "\r\rabc\r\rdef\r\r\r\nghi\r\r\n" "def\nghi\n", 19 | try "back 1" "abc\bdef\b\bgh\b" "abdgh", 20 | try "back 2" "abc\b\b\bdef\b\bxy\b\b\n" "dxy\n" 21 | -- \b at beginning of line 22 | -- nonprinting char 23 | ] 24 | --------------------------------------------------------------------------------