HUnit-1.2.5.2/0000755000000000000000000000000012126363552011101 5ustar0000000000000000HUnit-1.2.5.2/HUnit.cabal0000644000000000000000000000271112126363552013115 0ustar0000000000000000Name: HUnit Version: 1.2.5.2 Cabal-Version: >= 1.8 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 == 7.4.1 GHC == 7.4.2 GHC == 7.7 Build-Type: Simple Extra-Source-Files: HUnit.cabal.hugs HUnit.cabal.tests Setup.hs.hugs tests/HUnitTests.hs tests/HUnitTestBase.lhs tests/HUnitTestExtended.hs tests/HUnitTestOptimize.hs tests/TerminalTest.hs Data-Files: doc/Guide.html examples/Example.hs prologue.txt README source-repository head type: darcs location: http://code.haskell.org/HUnit/ flag base4 Library Build-Depends: base < 5, deepseq 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 HUnit-1.2.5.2/HUnit.cabal.hugs0000644000000000000000000000120712126363552014061 0ustar0000000000000000Name: HUnit Version: 1.2.5.0 License: BSD3 License-File: LICENSE Author: Dean Herington Homepage: http://hunit.sourceforge.net/ Category: Testing Build-Depends: base Synopsis: A unit testing framework for Haskell Description: HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java, see: . Exposed-Modules: Test.HUnit.Base, Test.HUnit.Lang, Test.HUnit.Terminal, Test.HUnit.Text, Test.HUnit Extensions: CPP Hugs-Options: -98HUnit-1.2.5.2/HUnit.cabal.tests0000644000000000000000000000644312126363552014264 0ustar0000000000000000-- This CABAL file is used to build and run all of the various tests for the -- project. This separate file is necessary because Hackage does not allow -- the optimization level to be specified when building executables and some -- tests require different optimization levels to be set. -- -- To use this file, simply copy it to HUnit.cabal, then build as normal. You -- may rename the existing version of HUnit.cabal first, if you like. Name: HUnit Version: 1.2.5.2 Cabal-Version: >= 1.8 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 == 7.4.1 GHC == 7.4.2 GHC == 7.7 Build-Type: Simple Extra-Source-Files: HUnit.cabal.hugs HUnit.cabal.tests Setup.hs.hugs tests/HUnitTests.hs tests/HUnitTestBase.lhs tests/HUnitTestExtended.hs tests/HUnitTestOptimize.hs tests/TerminalTest.hs Data-Files: doc/Guide.html examples/Example.hs prologue.txt README source-repository head type: darcs location: http://code.haskell.org/HUnit/ flag base4 Library Build-Depends: base < 5, deepseq 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 Test-Suite hunit-tests-optimize-0 Type: exitcode-stdio-1.0 Main-Is: HUnitTests.hs HS-Source-Dirs: . tests Build-Depends: base < 5, deepseq, filepath GHC-Options: -O0 if flag(base4) Build-Depends: base >= 4 CPP-Options: -DBASE4 -DO0 GHC-Options: -Wall else Build-Depends: base < 4 if impl(ghc >= 6.10) Build-Depends: base >= 4 Extensions: CPP Test-Suite hunit-tests-optimize-1 Type: exitcode-stdio-1.0 Main-Is: HUnitTests.hs HS-Source-Dirs: . tests Build-Depends: base < 5, deepseq GHC-Options: -O1 if flag(base4) Build-Depends: base >= 4 CPP-Options: -DBASE4 -DO1 GHC-Options: -Wall else Build-Depends: base < 4 if impl(ghc >= 6.10) Build-Depends: base >= 4 Extensions: CPP Test-Suite hunit-tests-optimize-2 Type: exitcode-stdio-1.0 Main-Is: HUnitTests.hs HS-Source-Dirs: . tests Build-Depends: base < 5, deepseq GHC-Options: -O2 if flag(base4) Build-Depends: base >= 4 CPP-Options: -DBASE4 -DO2 GHC-Options: -Wall else Build-Depends: base < 4 if impl(ghc >= 6.10) Build-Depends: base >= 4 Extensions: CPP HUnit-1.2.5.2/LICENSE0000644000000000000000000000272412126363552012113 0ustar0000000000000000HUnit is Copyright (c) Dean Herington, 2002, all rights reserved, and is distributed as free software under the following license. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions, and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions, and the following disclaimer in the documentation and/or other materials provided with the distribution. - The names of the copyright holders may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. HUnit-1.2.5.2/README0000644000000000000000000000101512126363552011756 0ustar0000000000000000HUnit 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. HUnit-1.2.5.2/Setup.hs0000644000000000000000000000005612126363552012536 0ustar0000000000000000import Distribution.Simple main = defaultMain HUnit-1.2.5.2/Setup.hs.hugs0000644000000000000000000000015512126363552013503 0ustar0000000000000000#!/usr/bin/env runghc module Main (main) where import Distribution.Simple main :: IO () main = defaultMain HUnit-1.2.5.2/prologue.txt0000644000000000000000000000016112126363552013474 0ustar0000000000000000HUnit is a unit testing framework for Haskell, inspired by the JUnit tool for Java, see: . HUnit-1.2.5.2/Test/0000755000000000000000000000000012126363552012020 5ustar0000000000000000HUnit-1.2.5.2/Test/HUnit.hs0000644000000000000000000000427512126363552013413 0ustar0000000000000000-- | 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 HUnit-1.2.5.2/Test/HUnit/0000755000000000000000000000000012126363552013047 5ustar0000000000000000HUnit-1.2.5.2/Test/HUnit/Base.hs0000644000000000000000000003100112126363552014250 0ustar0000000000000000-- | 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 } HUnit-1.2.5.2/Test/HUnit/Lang.hs0000644000000000000000000001051412126363552014265 0ustar0000000000000000-- | This module abstracts the differences between implementations of -- Haskell (e.g., GHC, Hugs, and NHC). {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable #-} #endif module Test.HUnit.Lang ( Assertion, assertFailure, performTestCase, #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) -- * 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 (..) #endif ) 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 import Control.DeepSeq -- 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 #if __GLASGOW_HASKELL__ >= 707 deriving (Show, Typeable) #else deriving Show hunitFailureTc :: TyCon #if MIN_VERSION_base(4,4,0) hunitFailureTc = mkTyCon3 "HUnit" "Test.HUnit.Lang" "HUnitFailure" #else hunitFailureTc = mkTyCon "HUnitFailure" #endif {-# NOINLINE hunitFailureTc #-} instance Typeable HUnitFailure where typeOf _ = mkTyConApp hunitFailureTc [] #endif #ifdef BASE4 instance Exception HUnitFailure assertFailure msg = msg `deepseq` E.throwIO (HUnitFailure msg) performTestCase action = do action return Nothing `E.catches` [E.Handler (\(HUnitFailure msg) -> return $ Just (True, msg)), -- 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 $ Just (False, show (e :: E.SomeException)))] #else assertFailure msg = msg `deepseq` 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 = msg `deepseq` 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 HUnit-1.2.5.2/Test/HUnit/Terminal.hs0000644000000000000000000000344112126363552015160 0ustar0000000000000000-- | 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) HUnit-1.2.5.2/Test/HUnit/Text.hs0000644000000000000000000001252512126363552014334 0ustar0000000000000000-- | 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' HUnit-1.2.5.2/doc/0000755000000000000000000000000012126363552011646 5ustar0000000000000000HUnit-1.2.5.2/doc/Guide.html0000644000000000000000000007051212126363552013576 0ustar0000000000000000 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).

HUnit-1.2.5.2/examples/0000755000000000000000000000000012126363552012717 5ustar0000000000000000HUnit-1.2.5.2/examples/Example.hs0000644000000000000000000000206112126363552014645 0ustar0000000000000000-- Example.hs -- Examples from HUnit user's guide -- -- For more examples, check out the tests directory. It contains unit tests -- for HUnit. module Main where import Test.HUnit foo :: Int -> (Int, Int) foo x = (1, x) partA :: Int -> IO (Int, Int) partA v = return (v+2, v+3) partB :: Int -> IO Bool partB v = return (v > 5) test1 :: Test test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3)) test2 :: Test test2 = TestCase (do (x,y) <- partA 3 assertEqual "for the first result of partA," 5 x b <- partB y assertBool ("(partB " ++ show y ++ ") failed") b) tests :: Test tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2] tests' :: Test tests' = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3), "test2" ~: do (x, y) <- partA 3 assertEqual "for the first result of partA," 5 x partB y @? "(partB " ++ show y ++ ") failed" ] main :: IO Counts main = do runTestTT tests runTestTT tests' HUnit-1.2.5.2/tests/0000755000000000000000000000000012126363552012243 5ustar0000000000000000HUnit-1.2.5.2/tests/HUnitTestBase.lhs0000644000000000000000000003324512126363552015444 0ustar0000000000000000HUnitTestBase.lhs -- test support and basic tests (Haskell 98 compliant) > module HUnitTestBase where > import Test.HUnit > import Test.HUnit.Terminal (terminalAppearance) > import System.IO (IOMode(..), openFile, hClose) > data Report = Start State > | Error String State > | UnspecifiedError State > | Failure String State > deriving (Show, Read) > instance Eq Report where > Start s1 == Start s2 = s1 == s2 > Error m1 s1 == Error m2 s2 = m1 == m2 && s1 == s2 > Error _ s1 == UnspecifiedError s2 = s1 == s2 > UnspecifiedError s1 == Error _ s2 = s1 == s2 > UnspecifiedError s1 == UnspecifiedError s2 = s1 == s2 > Failure m1 s1 == Failure m2 s2 = m1 == m2 && s1 == s2 > _ == _ = False > expectReports :: [Report] -> Counts -> Test -> Test > expectReports 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)) > [] t > assertEqual "for the reports from a test," reports1 (reverse reports2) > assertEqual "for the counts from a test," counts1 counts2 > simpleStart :: Report > simpleStart = Start (State [] (Counts 1 0 0 0)) > expectSuccess :: Test -> Test > expectSuccess = expectReports [simpleStart] (Counts 1 1 0 0) > expectProblem :: (String -> State -> Report) -> Int -> String -> Test -> Test > expectProblem kind err msg = > expectReports [simpleStart, kind msg (State [] counts')] counts' > where counts' = Counts 1 1 err (1-err) > expectError, expectFailure :: String -> Test -> Test > expectError = expectProblem Error 1 > expectFailure = expectProblem Failure 0 > expectUnspecifiedError :: Test -> Test > expectUnspecifiedError = expectProblem (\ _msg st -> UnspecifiedError st) 1 undefined > data Expect = Succ | Err String | UErr | Fail String > expect :: Expect -> Test -> Test > expect Succ t = expectSuccess t > expect (Err m) t = expectError m t > expect UErr t = expectUnspecifiedError t > expect (Fail m) t = expectFailure m t > baseTests :: Test > baseTests = test [ assertTests, > testCaseCountTests, > testCasePathsTests, > reportTests, > textTests, > showPathTests, > showCountsTests, > assertableTests, > predicableTests, > compareTests, > extendedTestTests ] > ok :: Test > ok = test (assert ()) > bad :: String -> Test > bad m = test (assertFailure m) > assertTests :: Test > assertTests = test [ > "null" ~: expectSuccess ok, > "userError" ~: #if defined(__GLASGOW_HASKELL__) > expectError "user error (error)" (TestCase (ioError (userError "error"))), #else > expectError "error" (TestCase (ioError (userError "error"))), #endif > "IO error (file missing)" ~: > expectUnspecifiedError > (test (do _ <- openFile "3g9djs" ReadMode; return ())), "error" ~: expectError "error" (TestCase (error "error")), "tail []" ~: expectUnspecifiedError (TestCase (tail [] `seq` return ())), -- GHC doesn't currently catch arithmetic exceptions. "div by 0" ~: expectUnspecifiedError (TestCase ((3 `div` 0) `seq` return ())), > "assertFailure" ~: > let msg = "simple assertFailure" > in expectFailure msg (test (assertFailure msg)), > "assertString null" ~: expectSuccess (TestCase (assertString "")), > "assertString nonnull" ~: > let msg = "assertString nonnull" > in expectFailure msg (TestCase (assertString msg)), > let f v non = > show v ++ " with " ++ non ++ "null message" ~: > expect (if v then Succ else Fail non) $ test $ assertBool non v > in "assertBool" ~: [ f v non | v <- [True, False], non <- ["non", ""] ], > let msg = "assertBool True" > in msg ~: expectSuccess (test (assertBool msg True)), > let msg = "assertBool False" > in msg ~: expectFailure msg (test (assertBool msg False)), > "assertEqual equal" ~: > expectSuccess (test (assertEqual "" (3 :: Integer) (3 :: Integer))), > "assertEqual unequal no msg" ~: > expectFailure "expected: 3\n but got: 4" > (test (assertEqual "" (3 :: Integer) (4 :: Integer))), > "assertEqual unequal with msg" ~: > expectFailure "for x,\nexpected: 3\n but got: 4" > (test (assertEqual "for x," (3 :: Integer) (4 :: Integer))) > ] > emptyTest0, emptyTest1, emptyTest2 :: Test > emptyTest0 = TestList [] > emptyTest1 = TestLabel "empty" emptyTest0 > emptyTest2 = TestList [ emptyTest0, emptyTest1, emptyTest0 ] > emptyTests :: [Test] > emptyTests = [emptyTest0, emptyTest1, emptyTest2] > testCountEmpty :: Test -> Test > testCountEmpty t = TestCase (assertEqual "" 0 (testCaseCount t)) > suite0, suite1, suite2, suite3 :: (Integer, Test) > suite0 = (0, ok) > suite1 = (1, TestList []) > suite2 = (2, TestLabel "3" ok) > suite3 = (3, suite) > suite :: Test > suite = > TestLabel "0" > (TestList [ TestLabel "1" (bad "1"), > TestLabel "2" (TestList [ TestLabel "2.1" ok, > ok, > TestLabel "2.3" (bad "2") ]), > TestLabel "3" (TestLabel "4" (TestLabel "5" (bad "3"))), > TestList [ TestList [ TestLabel "6" (bad "4") ] ] ]) > suiteCount :: Int > suiteCount = 6 > suitePaths :: [[Node]] > suitePaths = [ > [Label "0", ListItem 0, Label "1"], > [Label "0", ListItem 1, Label "2", ListItem 0, Label "2.1"], > [Label "0", ListItem 1, Label "2", ListItem 1], > [Label "0", ListItem 1, Label "2", ListItem 2, Label "2.3"], > [Label "0", ListItem 2, Label "3", Label "4", Label "5"], > [Label "0", ListItem 3, ListItem 0, ListItem 0, Label "6"]] > suiteReports :: [Report] > suiteReports = [ Start (State (p 0) (Counts 6 0 0 0)), > Failure "1" (State (p 0) (Counts 6 1 0 1)), > Start (State (p 1) (Counts 6 1 0 1)), > Start (State (p 2) (Counts 6 2 0 1)), > Start (State (p 3) (Counts 6 3 0 1)), > Failure "2" (State (p 3) (Counts 6 4 0 2)), > Start (State (p 4) (Counts 6 4 0 2)), > Failure "3" (State (p 4) (Counts 6 5 0 3)), > Start (State (p 5) (Counts 6 5 0 3)), > Failure "4" (State (p 5) (Counts 6 6 0 4))] > where p n = reverse (suitePaths !! n) > suiteCounts :: Counts > suiteCounts = Counts 6 6 0 4 > suiteOutput :: String > suiteOutput = concat [ > "### Failure in: 0:0:1\n", > "1\n", > "### Failure in: 0:1:2:2:2.3\n", > "2\n", > "### Failure in: 0:2:3:4:5\n", > "3\n", > "### Failure in: 0:3:0:0:6\n", > "4\n", > "Cases: 6 Tried: 6 Errors: 0 Failures: 4\n"] > suites :: [(Integer, Test)] > suites = [suite0, suite1, suite2, suite3] > testCount :: Show n => (n, Test) -> Int -> Test > testCount (num, t) count = > "testCaseCount suite" ++ show num ~: > TestCase $ assertEqual "for test count," count (testCaseCount t) > testCaseCountTests :: Test > testCaseCountTests = TestList [ > "testCaseCount empty" ~: test (map testCountEmpty emptyTests), > testCount suite0 1, > testCount suite1 0, > testCount suite2 1, > testCount suite3 suiteCount > ] > testPaths :: Show n => (n, Test) -> [[Node]] -> Test > testPaths (num, t) paths = > "testCasePaths suite" ++ show num ~: > TestCase $ assertEqual "for test paths," > (map reverse paths) (testCasePaths t) > testPathsEmpty :: Test -> Test > testPathsEmpty t = TestCase $ assertEqual "" [] (testCasePaths t) > testCasePathsTests :: Test > testCasePathsTests = TestList [ > "testCasePaths empty" ~: test (map testPathsEmpty emptyTests), > testPaths suite0 [[]], > testPaths suite1 [], > testPaths suite2 [[Label "3"]], > testPaths suite3 suitePaths > ] > reportTests :: Test > reportTests = "reports" ~: expectReports suiteReports suiteCounts suite > 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 "") > textTests :: Test > textTests = test [ > "lone error" ~: > expectText (Counts 1 1 1 0) #if defined(__GLASGOW_HASKELL__) > "### Error:\nuser error (xyz)\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" #else > "### Error:\nxyz\nCases: 1 Tried: 1 Errors: 1 Failures: 0\n" #endif > (test (do _ <- ioError (userError "xyz"); return ())), > "lone failure" ~: > expectText (Counts 1 1 0 1) > "### Failure:\nxyz\nCases: 1 Tried: 1 Errors: 0 Failures: 1\n" > (test (assert "xyz")), > "putTextToShowS" ~: > expectText suiteCounts suiteOutput suite, > "putTextToHandle (file)" ~: > let filename = "HUnitTest.tmp" > trim = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines > in map test > [ "show progress = " ++ show flag ~: do > handle <- openFile filename WriteMode > (counts', _) <- runTestText (putTextToHandle handle flag) suite > hClose handle > assertEqual "for the final counts," suiteCounts counts' > text <- readFile filename > let text' = if flag then trim (terminalAppearance text) else text > assertEqual "for the failure text output," suiteOutput text' > | flag <- [False, True] ] > ] > showPathTests :: Test > showPathTests = "showPath" ~: [ > "empty" ~: showPath [] ~?= "", > ":" ~: showPath [Label ":", Label "::"] ~?= "\"::\":\":\"", > "\"\\\n" ~: showPath [Label "\"\\n\n\""] ~?= "\"\\\"\\\\n\\n\\\"\"", > "misc" ~: showPath [Label "b", ListItem 2, ListItem 3, Label "foo"] ~?= > "foo:3:2:b" > ] > showCountsTests :: Test > showCountsTests = "showCounts" ~: showCounts (Counts 4 3 2 1) ~?= > "Cases: 4 Tried: 3 Errors: 2 Failures: 1" > lift :: a -> IO a > lift a = return a > assertableTests :: Test > assertableTests = > let assertables x = [ > ( "", assert x , test (lift x)) , > ( "IO ", assert (lift x) , test (lift (lift x))) , > ( "IO IO ", assert (lift (lift x)), test (lift (lift (lift x))))] > assertabled l e x = > test [ test [ "assert" ~: pre ++ l ~: expect e $ test $ a, > "test" ~: pre ++ "IO " ++ l ~: expect e $ t ] > | (pre, a, t) <- assertables x ] > in "assertable" ~: [ > assertabled "()" Succ (), > assertabled "True" Succ True, > assertabled "False" (Fail "") False, > assertabled "\"\"" Succ "", > assertabled "\"x\"" (Fail "x") "x" > ] > predicableTests :: Test > predicableTests = > let predicables x m = [ > ( "", assertionPredicate x , x @? m, x ~? m ), > ( "IO ", assertionPredicate (l x) , l x @? m, l x ~? m ), > ( "IO IO ", assertionPredicate (l(l x)), l(l x) @? m, l(l x) ~? m )] > l x = lift x > predicabled lab e m x = > test [ test [ "pred" ~: pre ++ lab ~: m ~: expect e $ test $ tst p, > "(@?)" ~: pre ++ lab ~: m ~: expect e $ test $ a, > "(~?)" ~: pre ++ lab ~: m ~: expect e $ t ] > | (pre, p, a, t) <- predicables x m ] > where tst p = p >>= assertBool m > in "predicable" ~: [ > predicabled "True" Succ "error" True, > predicabled "False" (Fail "error") "error" False, > predicabled "True" Succ "" True, > predicabled "False" (Fail "" ) "" False > ] > compareTests :: Test > compareTests = test [ > let succ' = const Succ > compare1 :: (String -> Expect) -> Integer -> Integer -> Test > compare1 = compare' > compare2 :: (String -> Expect) > -> (Integer, Char, Double) > -> (Integer, Char, Double) > -> Test > compare2 = compare' > compare' f expected actual > = test [ "(@=?)" ~: expect e $ test (expected @=? actual), > "(@?=)" ~: expect e $ test (actual @?= expected), > "(~=?)" ~: expect e $ expected ~=? actual, > "(~?=)" ~: expect e $ actual ~?= expected ] > where e = f $ "expected: " ++ show expected ++ > "\n but got: " ++ show actual > in test [ > compare1 succ' 1 1, > compare1 Fail 1 2, > compare2 succ' (1,'b',3.0) (1,'b',3.0), > compare2 Fail (1,'b',3.0) (1,'b',3.1) > ] > ] > expectList1 :: Int -> Test -> Test > expectList1 c = > expectReports > [ Start (State [ListItem n] (Counts c n 0 0)) | n <- [0..c-1] ] > (Counts c c 0 0) > expectList2 :: [Int] -> Test -> Test > expectList2 cs t = > expectReports > [ Start (State [ListItem j, ListItem i] (Counts c n 0 0)) > | ((i,j),n) <- zip coords [0..] ] > (Counts c c 0 0) > t > where coords = [ (i,j) | i <- [0 .. length cs - 1], j <- [0 .. cs!!i - 1] ] > c = testCaseCount t > extendedTestTests :: Test > extendedTestTests = test [ > "test idempotent" ~: expect Succ $ test $ test $ test $ ok, > "test list 1" ~: expectList1 3 $ test [assert (), assert "", assert True], > "test list 2" ~: expectList2 [0, 1, 2] $ test [[], [ok], [ok, ok]] > ] HUnit-1.2.5.2/tests/HUnitTestExtended.hs0000644000000000000000000000256412126363552016156 0ustar0000000000000000module HUnitTestExtended ( extendedTests ) where import Test.HUnit import HUnitTestBase -- Notes: -- * Assertion testing is only performed on GHC. If you want this to be enabled -- for other compilers, email the HUnit maintainer. #ifdef __GLASGOW_HASKELL__ import qualified Control.Exception (assert) #ifdef O0 import System.FilePath assertionMessage :: String assertionMessage = concat [ "tests", [pathSeparator], "HUnitTestExtended.hs:27:13-36: Assertion failed\n" ] #endif assertion :: IO () assertion = Control.Exception.assert False (return ()) #endif extendedTests :: Test extendedTests = 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 ())) #ifdef __GLASGOW_HASKELL__ #ifdef O0 -- Run with no optimization (-O0) , "assert" ~: expectError assertionMessage (TestCase assertion) #else -- #ifdef O0 -- Run with optimization (-O1 or -O2) , "assert" ~: TestCase assertion -- #ifdef O0 #endif -- #ifdef __GLASGOW_HASKELL__ #endif ] HUnit-1.2.5.2/tests/HUnitTestOptimize.hs0000644000000000000000000001106612126363552016213 0ustar0000000000000000-- HUnitTestOptimize.hs -- -- The purpose of this file is to test whether certain issues occur with optimization. -- It should be built and run with each level of optimization. I.e., -O0, -O1, -O2 -- -- With some versions and optimization levels of HUnit and GHC, tests were getting -- optimized out. This is a very bad thing and needs to be tested for. module HUnitTestOptimize ( optimizationTests, undefinedSwallowsTests ) where import Control.Applicative import Control.Monad import Test.HUnit -- Used to include the optimization level in the test results optimizationLevel :: String #if defined(O0) optimizationLevel = "-O0" #elif defined(O1) optimizationLevel = "-O1" #elif defined(O2) optimizationLevel = "-O2" #else optimizationLevel = "unknown optimization level" #endif -- A test runner that doesn't print the results of the tests; it only tabulates -- the results of the tests. In this context, it's used to verify that no -- tests were optimized away or otherwise lost. simpleTestRunner :: Test -> IO Counts simpleTestRunner t = do (counts', _) <- runTestText nullAccum t return counts' where nullAccum = PutText (\ _ _ _ -> return ()) () -- Some combinations of HUnit, GHC, and optimization levels cause tests to be -- optimized away. This section verifies that all tests of a type are -- performed. optimizationTests :: IO Bool optimizationTests = do counts2 <- simpleTestRunner $ TestLabel "Basic Optimization Tests" $ TestList [ True ~=? True, False ~=? True, TestCase $ assertEqual "both true" True True, TestCase $ assertEqual "false true" False True, TestCase $ assertEqual "fa" False True, TestCase $ assertEqual "f" False True, TestCase $ (False @?= True), TestCase $ unless (False == True) (assertFailure "f") ] -- Verify results of counts2 -- We can't use HUnit because it's possible that some tests have been -- optimized away, so we'll just do it manually. foldr (&&) True <$> sequence [ caseCount counts2 optimizationLevel, tryCount counts2 optimizationLevel, errorCount counts2 optimizationLevel, failureCount counts2 optimizationLevel ] where caseCount cs ol = if (cases cs == 8) then return True else do putStrLn $ "Failure: Basic Optimization (" ++ ol ++ "): expected 8 test cases; only " ++ (show $ cases cs) ++ " found. Some may have been optimized out." return False tryCount cs ol = if (tried cs == 8) then return True else do putStrLn $ "Failure: Basic Optimization (" ++ ol ++ "): expected to try 8 test cases; only " ++ (show $ tried cs) ++ " tried. Some may have been optimized out." return False errorCount cs ol = if (errors cs == 0) then return True else do putStrLn $ "Failure: Basic Optimization (" ++ ol ++ "): expected 0 errors; " ++ (show $ errors cs) ++ " found." return False failureCount cs ol = if (failures cs == 6) then return True else do putStrLn $ "Failure: Basic Optimization (" ++ ol ++ "): expected 6 failed cases; only " ++ (show $ failures cs) ++ " failed. Some may have been optimized out." return False -- Added in 1.4.2.3 -- When certain errors occur in a list of tests, the subsequent tests in the -- list weren't being run. This test verifies that this does not happen. undefinedSwallowsTests :: Test undefinedSwallowsTests = TestLabel ("Undefined Swallows Tests (" ++ optimizationLevel ++ ")") $ TestList [ TestCase $ do rs <- simpleTestRunner . TestList $ [ -- Added in 1.2.4.3 because the second test case will never be run -- (in prior versions) TestCase $ ('f' : undefined) @?= "bar", TestCase $ "foo" @?= "bar" ] assertEqual "(cases,tried,errors,failures)" (cases rs, tried rs, errors rs, failures rs) (2, 2, 1, 1) ]HUnit-1.2.5.2/tests/HUnitTests.hs0000644000000000000000000000106512126363552014653 0ustar0000000000000000-- 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 HUnitTestOptimize import TerminalTest main :: IO () main = do counts2 <- runTestTT (test [ baseTests, extendedTests, undefinedSwallowsTests, terminalTests ]) oPassed <- optimizationTests if (errors counts2 + failures counts2 == 0 && oPassed) then exitSuccess else exitFailureHUnit-1.2.5.2/tests/TerminalTest.hs0000644000000000000000000000130712126363552015213 0ustar0000000000000000-- 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 ]