HUnit 1.2.5.2 → 1.3.0.0

raw patch · 17 files changed

+486/−815 lines, 17 filesdep +HUnitdep +filepathdep ~basedep ~deepseqsetup-changednew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, filepath

Dependency ranges changed: base, deepseq

API changes (from Hackage documentation)

Files

• HUnit.cabal +24/−31
• HUnit.cabal.hugs +0/−20
• HUnit.cabal.tests +0/−122
• README +0/−12
• README.md +24/−0
• Setup.hs +0/−2
• Setup.hs.hugs +0/−7
• Setup.lhs +3/−0
• Test/HUnit.hs +80/−80
• Test/HUnit/Base.hs +79/−52
• Test/HUnit/Lang.hs +92/−149
• Test/HUnit/Terminal.hs +42/−42
• Test/HUnit/Text.hs +131/−128
• tests/HUnitTestBase.lhs +8/−12
• tests/HUnitTestExtended.hs +1/−40
• tests/HUnitTestOptimize.hs +0/−113
• tests/HUnitTests.hs +2/−5

@@ -1,10 +1,10 @@ Name:                   HUnit-Version:                1.2.5.2+Version:                1.3.0.0 Cabal-Version:          >= 1.8 License:                BSD3 License-File:           LICENSE Author:                 Dean Herington-Maintainer:             hunit@richardg.name+Maintainer:             Simon Hengel <sol@typeful.net> Stability:              stable Homepage:               http://hunit.sourceforge.net/ Category:               Testing@@ -12,48 +12,41 @@ Description:     HUnit is a unit testing framework for Haskell, inspired by the     JUnit tool for Java, see: <http://www.junit.org>.-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+    README.md  source-repository head-    type:     darcs-    location: http://code.haskell.org/HUnit/--flag base4+    type:     git+    location: https://github.com/hspec/HUnit  Library-    Build-Depends: -        base < 5,+    Build-Depends:+        base == 4.*,         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+    GHC-Options: -Wall++Test-Suite tests+    Type:               exitcode-stdio-1.0+    Main-Is:            HUnitTests.hs+    HS-Source-Dirs:     tests+    Build-Depends:+        base == 4.*,+        deepseq,+        filepath,+        HUnit+    Other-Modules:+        HUnitTests+        HUnitTestBase+        HUnitTestExtended+        TerminalTest+    GHC-Options:        -Wall

@@ -1,20 +0,0 @@-Name:                   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: <http://www.junit.org>.-Exposed-Modules:-    Test.HUnit.Base,-    Test.HUnit.Lang,-    Test.HUnit.Terminal,-    Test.HUnit.Text,-    Test.HUnit-Extensions:             CPP-Hugs-Options:           -98

@@ -1,122 +0,0 @@--- 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: <http://www.junit.org>.-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-        

@@ -1,12 +0,0 @@-HUnit is a unit testing framework for Haskell, inspired by the JUnit-tool for Java.  HUnit is free software; see its "License" file for-details.  HUnit is available at <http://hunit.sourceforge.net>.--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.

@@ -0,0 +1,24 @@+# HUnit++HUnit is a unit testing framework for Haskell, inspired by the JUnit+tool for Java.  HUnit is free software; see its "License" file for+details.  HUnit is available at <http://hunit.sourceforge.net>.++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.md       -- 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.++## Changes++### 1.3.0.0++- removed support for old compilers++- add source locations for failing assertions (GHC >= 7.10.2 only)

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,7 +0,0 @@-#!/usr/bin/env runghc-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -1,80 +1,80 @@--- | HUnit is a unit testing framework for Haskell, inspired by the JUnit tool 
--- for Java. This guide describes how to use HUnit, assuming you are familiar 
--- with Haskell, though not necessarily with JUnit.
---
--- In the Haskell module where your tests will reside, import module 
--- @Test.HUnit@:
---
--- @
---    import Test.HUnit
--- @
---
---  Define test cases as appropriate:
--- 
--- @
---    test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3))
---    test2 = TestCase (do (x,y) <- partA 3
---                         assertEqual "for the first result of partA," 5 x
---                         b <- partB y
---                         assertBool ("(partB " ++ show y ++ ") failed") b)
--- @
---
--- Name the test cases and group them together:
---
--- @
---    tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]
--- @
---
--- Run the tests as a group. At a Haskell interpreter prompt, apply the function
--- @runTestTT@ to the collected tests. (The /TT/ suggests /T/ext orientation 
--- with output to the /T/erminal.)
---
--- @
---    \> runTestTT tests
---    Cases: 2  Tried: 2  Errors: 0  Failures: 0
---    \>
--- @
---
--- If the tests are proving their worth, you might see:
---
--- @
---    \> runTestTT tests
---    ### Failure in: 0:test1
---    for (foo 3),
---    expected: (1,2)
---     but got: (1,3)
---    Cases: 2  Tried: 2  Errors: 0  Failures: 1
---    \>
--- @
---
--- You can specify tests even more succinctly using operators and overloaded 
--- functions that HUnit provides:
---
--- @
---    tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3),
---                   "test2" ~: do (x, y) <- partA 3
---                                 assertEqual "for the first result of partA," 5 x
---                                 partB y \@? "(partB " ++ show y ++ ") failed" ]
--- @
---
--- Assuming the same test failures as before, you would see:
---
--- @
---    \> runTestTT tests
---    ### Failure in: 0:test1:(foo 3)
---    expected: (1,2)
---     but got: (1,3)
---    Cases: 2  Tried: 2  Errors: 0  Failures: 1
---    \>
--- @
-
-module Test.HUnit
-(
-  module Test.HUnit.Base,
-  module Test.HUnit.Text
-)
-where
-
-import Test.HUnit.Base
-import Test.HUnit.Text
-
+-- | 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+

@@ -1,11 +1,17 @@+{-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,8,1)+#define HAS_SOURCE_LOCATIONS+{-# LANGUAGE ImplicitParams #-}+#endif+ -- | Basic definitions for the HUnit library. -- --   This module contains what you need to create assertions and test cases and---   combine them into test suites. +--   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 +--   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@@ -13,10 +19,10 @@   -- ** Declaring tests   Test(..),   (~=?), (~?=), (~:), (~?),-  +   -- ** Making assertions   assertFailure, {- from Test.HUnit.Lang: -}-  assertBool, assertEqual, assertString, +  assertBool, assertEqual, assertString,   Assertion, {- from Test.HUnit.Lang: -}   (@=?), (@?=), (@?), @@ -27,15 +33,23 @@    -- ** Test execution   -- $testExecutionNote-  State(..), Counts(..), -  Path, Node(..), +  State(..), Counts(..),+  Path, Node(..),   testCasePaths,   testCaseCount,+  Location (..),   ReportStart, ReportProblem,   performTest ) where +#ifdef HAS_SOURCE_LOCATIONS+import           GHC.Stack+#define with_loc (?loc :: CallStack) =>+#else+#define with_loc+#endif+ import Control.Monad (unless, foldM)  @@ -49,25 +63,28 @@ -- -------------------------------  -- | Asserts that the specified condition holds.-assertBool :: String    -- ^ The message that is displayed if the assertion fails+assertBool :: with_loc+              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 +assertString :: with_loc+                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 +-- 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 +assertEqual :: with_loc (Eq a, Show a)+                              => String -- ^ The message prefix+                              -> a      -- ^ The expected value                               -> a      -- ^ The actual value                               -> Assertion assertEqual preface expected actual =@@ -81,16 +98,16 @@  -- | Allows the extension of the assertion mechanism. ----- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions, +-- 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 +-- 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+ where assert :: with_loc t -> Assertion  instance Assertable ()  where assert = return@@ -106,7 +123,7 @@  -- | A specialized form of 'Assertable' to handle lists. class ListAssertable t- where listAssert :: [t] -> Assertion+ where listAssert :: with_loc [t] -> Assertion  instance ListAssertable Char  where listAssert = assertString@@ -133,13 +150,13 @@ -- 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 +-- | Used to signify that a data type can be converted to an assertion -- predicate. class AssertionPredicable t  where assertionPredicate :: t -> AssertionPredicate@@ -158,21 +175,24 @@  -- | Asserts that the condition obtained from the specified --   'AssertionPredicable' holds.-(@?) :: (AssertionPredicable t) => t          -- ^ A value of which the asserted condition is predicated+(@?) :: with_loc (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+(@=?) :: with_loc (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+(@?=) :: with_loc (Eq a, Show a)+                        => a -- ^ The actual value                         -> a -- ^ The expected value                         -> Assertion actual @?= expected = assertEqual "" expected actual@@ -186,7 +206,7 @@ data Test     -- | A single, independent test case composed.     = TestCase Assertion-    -- | A set of @Test@s sharing the same level in the hierarchy. +    -- | 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@@ -202,7 +222,7 @@  -- | Provides a way to convert data into a @Test@ or set of @Test@. class Testable t- where test :: t -> Test+ where test :: with_loc t -> Test  instance Testable Test  where test = id@@ -220,35 +240,38 @@ infix  1 ~?, ~=?, ~?= infixr 0 ~: --- | Creates a test case resulting from asserting the condition obtained +-- | 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+(~?) :: with_loc (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 +-- | 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 +(~=?) :: with_loc (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 +-- | 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 +(~?=) :: with_loc (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 +-- | 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+-- a 'TestLabel' to one or more tests.+(~:) :: with_loc (Testable t) => String -> t -> Test label ~: t = TestLabel label (test t)  @@ -257,9 +280,9 @@ -- ==============  -- $testExecutionNote--- Note: the rest of the functionality in this module is intended for +-- 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 +-- 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@@ -278,7 +301,7 @@  -- | 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+type ReportProblem us = Maybe Location -> String -> State -> us -> IO us  -- | Uniquely describes the location of a test within a test hierarchy. -- Node order is from test case to root.@@ -302,13 +325,13 @@ testCaseCount (TestList ts)   = sum (map testCaseCount ts) testCaseCount (TestLabel _ t) = testCaseCount t --- | Performs a test run with the specified report generators.  +-- | 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).  +-- 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@@ -316,11 +339,11 @@ -- 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 +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 +            -> us+            -> Test             -- ^ the test to be executed             -> IO (Counts, us) performTest reportStart reportError reportFailure initialUs initialT = do   (ss', us') <- pt initState initialUs initialT@@ -334,11 +357,15 @@   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)+    case r of+      Success -> do+        return (ss', us')+      Failure loc m -> do+        usF <- reportFailure loc m ssF us'+        return (ssF, usF)+      Error loc m -> do+        usE <- reportError loc m ssE us'+        return (ssE, usE)    where c@Counts{ tried = n } = counts ss          ss' = ss{ counts = c{ tried = n + 1 } }          ssF = ss{ counts = c{ tried = n + 1, failures = failures c + 1 } }

@@ -1,149 +1,92 @@--- | 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
+{-# LANGUAGE DeriveDataTypeable #-}++{-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,8,1)+#define HAS_SOURCE_LOCATIONS+{-# LANGUAGE ImplicitParams #-}+#endif++module Test.HUnit.Lang (+  Assertion,+  assertFailure,++  Location (..),+  Result (..),+  performTestCase,+-- * Internals+-- |+-- /Note:/ This is not part of the public API!  It is exposed so that you can+-- tinker with the internals of HUnit, but do not expect it to be stable!+  HUnitFailure (..)+) where++import           Control.DeepSeq+import           Control.Exception as E+import           Data.Typeable++#ifdef HAS_SOURCE_LOCATIONS+import           GHC.SrcLoc+import           GHC.Stack+#endif++-- | When an assertion is evaluated, it will output a message if and only if the+-- assertion fails.+--+-- Test cases are composed of a sequence of one or more assertions.+type Assertion = IO ()++data Location = Location {+  locationFile :: FilePath+, locationLine :: Int+, locationColumn :: Int+} deriving (Eq, Ord, Show)++data HUnitFailure = HUnitFailure (Maybe Location) String+    deriving (Eq, Ord, Show, Typeable)++instance Exception HUnitFailure++-- | Unconditionally signals that a failure has occured.  All+-- other assertions can be expressed with the form:+--+-- @+--    if conditionIsMet+--        then IO ()+--        else assertFailure msg+-- @+assertFailure ::+#ifdef HAS_SOURCE_LOCATIONS+     (?loc :: CallStack) =>+#endif+     String -- ^ A message that is displayed with the assertion failure+  -> Assertion+assertFailure msg = msg `deepseq` E.throwIO (HUnitFailure location msg)+  where+    location :: Maybe Location+#ifdef HAS_SOURCE_LOCATIONS+    location = case reverse (getCallStack ?loc) of+      (_, loc) : _ -> Just $ Location (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc)+      [] -> Nothing+#else+    location = Nothing+#endif++data Result = Success | Failure (Maybe Location) String | Error (Maybe Location) String+  deriving (Eq, Ord, Show)++-- | Performs a single test case.+performTestCase :: Assertion -- ^ an assertion to be made during the test case run+                -> IO Result+performTestCase action =+  (action >> return Success)+     `E.catches`+      [E.Handler (\(HUnitFailure loc msg) -> return $ Failure loc 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 $ Error Nothing $ show (e :: E.SomeException))]

@@ -1,42 +1,42 @@--- | This module handles the complexities of writing information to the
--- terminal, including modifying text in place.
-
-module Test.HUnit.Terminal (
-        terminalAppearance
-    ) where
-
-import Data.Char (isPrint)
-
-
--- | Simplifies the input string by interpreting @\\r@ and @\\b@ characters
--- specially so that the result string has the same final (or /terminal/,
--- pun intended) appearance as would the input string when written to a
--- terminal that overwrites character positions following carriage
--- returns and backspaces.
-
-terminalAppearance :: String -> String
-terminalAppearance str = ta id "" "" str
-
--- | The helper function @ta@ takes an accumulating @ShowS@-style function
--- that holds /committed/ lines of text, a (reversed) list of characters
--- on the current line /before/ the cursor, a (normal) list of characters
--- on the current line /after/ the cursor, and the remaining input.
-
-ta 
-    :: ([Char] -> t) -- ^ An accumulating @ShowS@-style function
-                     -- that holds /committed/ lines of text
-    -> [Char] -- ^ A (reversed) list of characters
-              -- on the current line /before/ the cursor
-    -> [Char] -- ^ A (normal) list of characters
-              -- on the current line /after/ the cursor
-    -> [Char] -- ^ The remaining input
-    -> t
-ta f    bs  as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs
-ta f    bs  as ('\r':cs) = ta f "" (reverse bs ++ as) cs
-ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs
-ta _    ""   _ ('\b': _) = error "'\\b' at beginning of line"
-ta f    bs  as (c:cs) 
-    | not (isPrint c)    = error "invalid nonprinting character"
-    | null as            = ta f (c:bs) ""        cs
-    | otherwise          = ta f (c:bs) (tail as) cs
-ta f    bs  as       ""  = f (reverse bs ++ as)
+-- | 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)

@@ -1,128 +1,131 @@--- | 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'
+-- | 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 loc msg ss us = put line True us+   where line  = "### " ++ kind ++ path' ++ "\n" ++ formatLocation loc ++ msg+         kind  = if null path' then p0 else p1+         path' = showPath (path ss)++formatLocation :: Maybe Location -> String+formatLocation Nothing = ""+formatLocation (Just loc) = locationFile loc ++ ":" ++ show (locationLine loc) ++ "\n"++-- | Converts test execution counts to a string.++showCounts :: Counts -> String+showCounts Counts{ cases = cases', tried = tried',+                   errors = errors', failures = failures' } =+  "Cases: " ++ show cases' ++ "  Tried: " ++ show tried' +++  "  Errors: " ++ show errors' ++ "  Failures: " ++ show failures'+++-- | Converts a test case path to a string, separating adjacent elements by+--   the colon (\':\'). An element of the path is quoted (as with 'show') when+--   there is potential ambiguity.++showPath :: Path -> String+showPath [] = ""+showPath nodes = foldl1 f (map showNode nodes)+ where f b a = a ++ ":" ++ b+       showNode (ListItem n) = show n+       showNode (Label label) = safe label (show label)+       safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s+++-- | Provides the \"standard\" text-based test controller. Reporting is made to+--   standard error, and progress reports are included. For possible+--   programmatic use, the final counts are returned.+--+--   The \"TT\" in the name suggests \"Text-based reporting to the Terminal\".++runTestTT :: Test -> IO Counts+runTestTT t = do (counts', 0) <- runTestText (putTextToHandle stderr True) t+                 return counts'

@@ -1,7 +1,9 @@ HUnitTestBase.lhs  --  test support and basic tests (Haskell 98 compliant) +> {-# LANGUAGE CPP #-} > module HUnitTestBase where +> import Data.List > import Test.HUnit > import Test.HUnit.Terminal (terminalAppearance) > import System.IO (IOMode(..), openFile, hClose)@@ -26,8 +28,8 @@ > expectReports :: [Report] -> Counts -> Test -> Test > expectReports reports1 counts1 t = TestCase $ do >   (counts2, reports2) <- performTest (\  ss us -> return (Start     ss : us))->                                      (\m ss us -> return (Error   m ss : us))->                                      (\m ss us -> return (Failure m ss : us))+>                                      (\_loc m ss us -> return (Error   m ss : us))+>                                      (\_loc m ss us -> return (Failure m ss : us)) >                                      [] t >   assertEqual "for the reports from a test," reports1 (reverse reports2) >   assertEqual "for the counts from a test," counts1 counts2@@ -88,11 +90,7 @@ >   "null" ~: expectSuccess ok,  >   "userError" ~:-#if defined(__GLASGOW_HASKELL__) >     expectError "user error (error)" (TestCase (ioError (userError "error"))),-#else->     expectError "error" (TestCase (ioError (userError "error"))),-#endif  >   "IO error (file missing)" ~: >     expectUnspecifiedError@@ -257,12 +255,14 @@ > reportTests :: Test > reportTests = "reports" ~: expectReports suiteReports suiteCounts suite +> removeLocation :: String -> String+> removeLocation = unlines . filter (not . isInfixOf __FILE__) . lines  > expectText :: Counts -> String -> Test -> Test > expectText counts1 text1 t = TestCase $ do >   (counts2, text2) <- runTestText putTextToShowS t >   assertEqual "for the final counts," counts1 counts2->   assertEqual "for the failure text output," text1 (text2 "")+>   assertEqual "for the failure text output," text1 (removeLocation $ text2 "")   > textTests :: Test@@ -270,11 +270,7 @@  >   "lone error" ~: >     expectText (Counts 1 1 1 0)-#if defined(__GLASGOW_HASKELL__) >         "### Error:\nuser error (xyz)\nCases: 1  Tried: 1  Errors: 1  Failures: 0\n"-#else->         "### Error:\nxyz\nCases: 1  Tried: 1  Errors: 1  Failures: 0\n"-#endif >         (test (do _ <- ioError (userError "xyz"); return ())),  >   "lone failure" ~:@@ -295,7 +291,7 @@ >           hClose handle >           assertEqual "for the final counts," suiteCounts counts' >           text <- readFile filename->           let text' = if flag then trim (terminalAppearance text) else text+>           let text' = removeLocation $ if flag then trim (terminalAppearance text) else text >           assertEqual "for the failure text output," suiteOutput text' >       | flag <- [False, True] ] 

@@ -5,34 +5,11 @@ 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 ())), @@ -44,20 +21,4 @@      "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     ]

@@ -1,113 +0,0 @@--- 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)-        ]

@@ -9,18 +9,15 @@ import Test.HUnit import HUnitTestBase import HUnitTestExtended-import HUnitTestOptimize import TerminalTest  main :: IO () main = do     counts2 <- runTestTT (test [-            baseTests, +            baseTests,             extendedTests,-            undefinedSwallowsTests,             terminalTests             ])-    oPassed <- optimizationTests-    if (errors counts2 + failures counts2 == 0 && oPassed) +    if (errors counts2 + failures counts2 == 0)         then exitSuccess         else exitFailure