Depend on call-stack

.ghci

@@ -1 +1,2 @@
-:set -optP-includedist/build/autogen/cabal_macros.h -i. -itests
+:set -isrc -itest
+:set -optP-includedist/build/autogen/cabal_macros.h

.travis.yml

@@ -1,10 +1,4 @@
 env:
-  - CABALVER=1.16 GHCVER=7.0.1
-  - CABALVER=1.16 GHCVER=7.0.2
-  - CABALVER=1.16 GHCVER=7.0.3
-  - CABALVER=1.16 GHCVER=7.0.4
-  - CABALVER=1.16 GHCVER=7.2.1
-  - CABALVER=1.16 GHCVER=7.2.2
   - CABALVER=1.16 GHCVER=7.4.1
   - CABALVER=1.16 GHCVER=7.4.2
   - CABALVER=1.16 GHCVER=7.6.1

CHANGELOG.md

@@ -1,5 +1,9 @@
 ## Changes
 
+#### 1.4.0.0
+
+- Depend on `call-stack`
+
 #### 1.3.1.2
 
 - Fixes the test suite on GHC 8

HUnit.cabal

@@ -31,7 +31,8 @@ library
     src
   build-depends:
     base == 4.*,
-    deepseq
+    deepseq,
+    call-stack
   exposed-modules:
     Test.HUnit.Base
     Test.HUnit.Lang
@@ -52,6 +53,7 @@ test-suite tests
   build-depends:
     base == 4.*,
     deepseq,
+    call-stack,
     filepath,
     HUnit
   other-modules:

package.yaml

@@ -18,6 +18,7 @@ extra-source-files:
 dependencies:
   - base == 4.*
   - deepseq
+  - call-stack
 
 ghc-options: -Wall
 

src/Test/HUnit/Base.hs

@@ -1,9 +1,5 @@
-{-# LANGUAGE CPP #-}
-#if MIN_VERSION_base(4,8,1)
-#define HAS_SOURCE_LOCATIONS
-{-# LANGUAGE ImplicitParams #-}
-{-# LANGUAGE ConstrainedClassMethods #-}
-#endif
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 -- | Basic definitions for the HUnit library.
 --
@@ -38,20 +34,12 @@ module Test.HUnit.Base
   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
+) where
 
 import Control.Monad (unless, foldM)
+import Data.CallStack
 
 
 -- Assertion Definition
@@ -64,16 +52,16 @@ import Test.HUnit.Lang
 -- -------------------------------
 
 -- | Asserts that the specified condition holds.
-assertBool :: with_loc
-              String    -- ^ The message that is displayed if the assertion fails
+assertBool :: HasCallStack
+           => String    -- ^ The message that is displayed if the assertion fails
            -> Bool      -- ^ The condition
            -> Assertion
 assertBool msg b = unless b (assertFailure msg)
 
 -- | Signals an assertion failure if a non-empty message (i.e., a message
 -- other than @\"\"@) is passed.
-assertString :: with_loc
-                String    -- ^ The message that is displayed with the assertion failure
+assertString :: HasCallStack
+             => String    -- ^ The message that is displayed with the assertion failure
              -> Assertion
 assertString s = unless (null s) (assertFailure s)
 
@@ -83,7 +71,7 @@ assertString s = unless (null s) (assertFailure s)
 --
 -- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted
 -- and only the expected and actual values are output.
-assertEqual :: with_loc (Eq a, Show a)
+assertEqual :: (HasCallStack, Eq a, Show a)
                               => String -- ^ The message prefix
                               -> a      -- ^ The expected value
                               -> a      -- ^ The actual value
@@ -108,7 +96,7 @@ assertEqual preface expected actual =
 -- If more complex arrangements of assertions are needed, 'Test's and
 -- 'Testable' should be used.
 class Assertable t
- where assert :: with_loc t -> Assertion
+ where assert :: HasCallStack => t -> Assertion
 
 instance Assertable ()
  where assert = return
@@ -124,7 +112,7 @@ instance (Assertable t) => Assertable (IO t)
 
 -- | A specialized form of 'Assertable' to handle lists.
 class ListAssertable t
- where listAssert :: with_loc [t] -> Assertion
+ where listAssert :: HasCallStack => [t] -> Assertion
 
 instance ListAssertable Char
  where listAssert = assertString
@@ -176,23 +164,23 @@ infix  1 @?, @=?, @?=
 
 -- | Asserts that the condition obtained from the specified
 --   'AssertionPredicable' holds.
-(@?) :: with_loc (AssertionPredicable t)
+(@?) :: (HasCallStack, AssertionPredicable t)
                                 => t          -- ^ A value of which the asserted condition is predicated
                                 -> String     -- ^ A message that is displayed if the assertion fails
                                 -> Assertion
 predi @? msg = assertionPredicate predi >>= assertBool msg
 
 -- | Asserts that the specified actual value is equal to the expected value
 --   (with the expected value on the left-hand side).
-(@=?) :: with_loc (Eq a, Show a)
+(@=?) :: (HasCallStack, Eq a, Show a)
                         => a -- ^ The expected value
                         -> a -- ^ The actual value
                         -> Assertion
 expected @=? actual = assertEqual "" expected actual
 
 -- | Asserts that the specified actual value is equal to the expected value
 --   (with the actual value on the left-hand side).
-(@?=) :: with_loc (Eq a, Show a)
+(@?=) :: (HasCallStack, Eq a, Show a)
                         => a -- ^ The actual value
                         -> a -- ^ The expected value
                         -> Assertion
@@ -223,7 +211,7 @@ instance Show Test where
 
 -- | Provides a way to convert data into a @Test@ or set of @Test@.
 class Testable t
- where test :: with_loc t -> Test
+ where test :: HasCallStack => t -> Test
 
 instance Testable Test
  where test = id
@@ -243,7 +231,7 @@ infixr 0 ~:
 
 -- | Creates a test case resulting from asserting the condition obtained
 --   from the specified 'AssertionPredicable'.
-(~?) :: with_loc (AssertionPredicable t)
+(~?) :: (HasCallStack, AssertionPredicable t)
                                 => t       -- ^ A value of which the asserted condition is predicated
                                 -> String  -- ^ A message that is displayed on test failure
                                 -> Test
@@ -252,7 +240,7 @@ 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).
-(~=?) :: with_loc (Eq a, Show a)
+(~=?) :: (HasCallStack, Eq a, Show a)
                         => a     -- ^ The expected value
                         -> a     -- ^ The actual value
                         -> Test
@@ -261,7 +249,7 @@ 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).
-(~?=) :: with_loc (Eq a, Show a)
+(~?=) :: (HasCallStack, Eq a, Show a)
                         => a     -- ^ The actual value
                         -> a     -- ^ The expected value
                         -> Test
@@ -272,7 +260,7 @@ actual ~?= expected = TestCase (actual @?= expected)
 --
 -- Since 'Test' is @Testable@, this can be used as a shorthand way of attaching
 -- a 'TestLabel' to one or more tests.
-(~:) :: with_loc (Testable t) => String -> t -> Test
+(~:) :: (HasCallStack, Testable t) => String -> t -> Test
 label ~: t = TestLabel label (test t)
 
 
@@ -302,7 +290,7 @@ type ReportStart us = State -> us -> IO us
 
 -- | Report generator for reporting problems that have occurred during
 --   a test run. Problems may be errors or assertion failures.
-type ReportProblem us = Maybe Location -> String -> State -> us -> IO us
+type ReportProblem us = Maybe SrcLoc -> String -> State -> us -> IO us
 
 -- | Uniquely describes the location of a test within a test hierarchy.
 -- Node order is from test case to root.

src/Test/HUnit/Lang.hs

@@ -1,16 +1,11 @@
 {-# LANGUAGE DeriveDataTypeable #-}
-
-{-# LANGUAGE CPP #-}
-#if MIN_VERSION_base(4,8,1)
-#define HAS_SOURCE_LOCATIONS
-{-# LANGUAGE ImplicitParams #-}
-#endif
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Test.HUnit.Lang (
   Assertion,
   assertFailure,
 
-  Location (..),
   Result (..),
   performTestCase,
 -- * Internals
@@ -23,28 +18,16 @@ module Test.HUnit.Lang (
 import           Control.DeepSeq
 import           Control.Exception as E
 import           Data.Typeable
-
-#ifdef HAS_SOURCE_LOCATIONS
-#if !(MIN_VERSION_base(4,9,0))
-import           GHC.SrcLoc
-#endif
-import           GHC.Stack
-#endif
+import           Data.CallStack
 
 -- | When an assertion is evaluated, it will output a message if and only if the
 -- assertion fails.
 --
 -- Test cases are composed of a sequence of one or more assertions.
 type Assertion = IO ()
 
-data Location = Location {
-  locationFile :: FilePath
-, locationLine :: Int
-, locationColumn :: Int
-} deriving (Eq, Ord, Show)
-
-data HUnitFailure = HUnitFailure (Maybe Location) String
-    deriving (Eq, Ord, Show, Typeable)
+data HUnitFailure = HUnitFailure (Maybe SrcLoc) String
+    deriving (Eq, Show, Typeable)
 
 instance Exception HUnitFailure
 
@@ -57,24 +40,18 @@ instance Exception HUnitFailure
 --        else assertFailure msg
 -- @
 assertFailure ::
-#ifdef HAS_SOURCE_LOCATIONS
-     (?loc :: CallStack) =>
-#endif
+     HasCallStack =>
      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)
+    location :: Maybe SrcLoc
+    location = case reverse callStack of
+      (_, loc) : _ -> Just loc
       [] -> Nothing
-#else
-    location = Nothing
-#endif
 
-data Result = Success | Failure (Maybe Location) String | Error (Maybe Location) String
-  deriving (Eq, Ord, Show)
+data Result = Success | Failure (Maybe SrcLoc) String | Error (Maybe SrcLoc) String
+  deriving (Eq, Show)
 
 -- | Performs a single test case.
 performTestCase :: Assertion -- ^ an assertion to be made during the test case run

src/Test/HUnit/Text.hs

@@ -13,6 +13,7 @@ where
 
 import Test.HUnit.Base
 
+import Data.CallStack
 import Control.Monad (when)
 import System.IO (Handle, stderr, hPutStr, hPutStrLn)
 
@@ -94,9 +95,9 @@ runTestText (PutText put us0) t = do
          kind  = if null path' then p0 else p1
          path' = showPath (path ss)
 
-formatLocation :: Maybe Location -> String
+formatLocation :: Maybe SrcLoc -> String
 formatLocation Nothing = ""
-formatLocation (Just loc) = locationFile loc ++ ":" ++ show (locationLine loc) ++ "\n"
+formatLocation (Just loc) = srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ "\n"
 
 -- | Converts test execution counts to a string.