diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2011-2024 Simon Hengel +Copyright (c) 2011-2025 Simon Hengel Copyright (c) 2011-2012 Trystan Spangler Copyright (c) 2011-2011 Greg Weber diff --git a/hspec-core.cabal b/hspec-core.cabal --- a/hspec-core.cabal +++ b/hspec-core.cabal @@ -1,14 +1,14 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0. +-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack name: hspec-core -version: 2.11.10 +version: 2.11.11 license: MIT license-file: LICENSE -copyright: (c) 2011-2024 Simon Hengel, +copyright: (c) 2011-2025 Simon Hengel, (c) 2011-2012 Trystan Spangler, (c) 2011 Greg Weber maintainer: Simon Hengel @@ -140,7 +140,7 @@ , filepath , haskell-lexer , hspec-expectations ==0.8.4.* - , hspec-meta ==2.11.10 + , hspec-meta ==2.11.11 , process , quickcheck-io >=0.2.0 , random diff --git a/src/Test/Hspec/Core/Example/Location.hs b/src/Test/Hspec/Core/Example/Location.hs --- a/src/Test/Hspec/Core/Example/Location.hs +++ b/src/Test/Hspec/Core/Example/Location.hs @@ -1,9 +1,11 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} module Test.Hspec.Core.Example.Location ( Location(..) , extractLocation #ifdef TEST +, parseBacktraces , parseAssertionFailed , parseCallStack , parseLocation @@ -19,6 +21,10 @@ import Data.Char import GHC.IO.Exception +#if MIN_VERSION_base(4,21,0) +import Control.Exception.Context +#endif + #ifdef mingw32_HOST_OS import System.FilePath #endif @@ -37,8 +43,27 @@ <|> locationFromRecConError e <|> locationFromIOException e <|> locationFromNoMethodError e +#if !MIN_VERSION_base(4,21,0) <|> locationFromAssertionFailed e +#else + <|> locationFromSomeException e +locationFromSomeException :: SomeException -> Maybe Location +locationFromSomeException = someExceptionContext >>> locationFromExceptionContext + +locationFromExceptionContext :: ExceptionContext -> Maybe Location +locationFromExceptionContext = displayExceptionContext >>> parseBacktraces +#endif + +_ignoreUnusedWarning = (parseBacktraces, locationFromAssertionFailed) + +parseBacktraces :: String -> Maybe Location +parseBacktraces = + lines + >>> dropWhile (/= "HasCallStack backtrace:") >>> drop 1 + >>> takeWhile (isPrefixOf " ") + >>> parseCallStack + locationFromNoMethodError :: SomeException -> Maybe Location locationFromNoMethodError e = case fromException e of Just (NoMethodError s) -> listToMaybe (words s) >>= parseSourceSpan @@ -50,13 +75,17 @@ Nothing -> Nothing parseAssertionFailed :: String -> Maybe Location -parseAssertionFailed loc = parseCallStack loc <|> parseSourceSpan loc +parseAssertionFailed loc = parseCallStack (lines loc) <|> parseSourceSpan loc locationFromErrorCall :: SomeException -> Maybe Location locationFromErrorCall e = case fromException e of +#if MIN_VERSION_base(4,21,0) + Just (ErrorCall _) -> Nothing +#else Just (ErrorCallWithLocation err loc) -> - parseCallStack loc <|> + parseCallStack (lines loc) <|> fromPatternMatchFailureInDoExpression err +#endif Nothing -> Nothing locationFromPatternMatchFail :: SomeException -> Maybe Location @@ -83,8 +112,8 @@ stripPrefix "Pattern match failure in do expression at " input >>= parseSourceSpan #endif -parseCallStack :: String -> Maybe Location -parseCallStack input = case reverse (lines input) of +parseCallStack :: [String] -> Maybe Location +parseCallStack input = case reverse input of [] -> Nothing line : _ -> findLocation line where diff --git a/test/Test/Hspec/Core/CompatSpec.hs b/test/Test/Hspec/Core/CompatSpec.hs --- a/test/Test/Hspec/Core/CompatSpec.hs +++ b/test/Test/Hspec/Core/CompatSpec.hs @@ -7,7 +7,6 @@ import System.Environment data SomeType = SomeType - deriving Typeable spec :: Spec spec = do diff --git a/test/Test/Hspec/Core/Example/LocationSpec.hs b/test/Test/Hspec/Core/Example/LocationSpec.hs --- a/test/Test/Hspec/Core/Example/LocationSpec.hs +++ b/test/Test/Hspec/Core/Example/LocationSpec.hs @@ -14,7 +14,7 @@ import Test.Hspec.Core.Example.Location class SomeClass a where - someMethod :: a -> IO () + someMethod :: a -> IO () instance SomeClass () where @@ -96,9 +96,31 @@ Left e <- try . evaluate $ assert False () extractLocation e `shouldBe` location + describe "parseBacktraces" $ do + it "parses Location from Backtraces" $ do + let + input :: String + input = unlines [ + "Cost-centre stack backtrace:" + , " ..." + , "IPE backtrace:" + , " ..." + , "HasCallStack backtrace:" + , " foo, called at Foo.hs:23:7 in main:Foo" + , " bar, called at Foo.hs:42:7 in main:Foo" + , " baz, called at Foo.hs:65:9 in main:Foo" + , "..." + , " ..." + ] + parseBacktraces input `shouldBe` Just Location { + locationFile = "Foo.hs" + , locationLine = 65 + , locationColumn = 9 + } + describe "parseCallStack" $ do it "parses Location from call stack" $ do - let input = unlines [ + let input = [ "CallStack (from HasCallStack):" , " error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err" , " undefined, called at test/Test/Hspec.hs:13:32 in main:Test.Hspec" diff --git a/test/Test/Hspec/Core/RunnerSpec.hs b/test/Test/Hspec/Core/RunnerSpec.hs --- a/test/Test/Hspec/Core/RunnerSpec.hs +++ b/test/Test/Hspec/Core/RunnerSpec.hs @@ -598,7 +598,7 @@ , " 1) foo" , " uncaught exception: MyException" , " my exception" -#if MIN_VERSION_base(4,20,0) +#if MIN_VERSION_base(4,20,0) && !MIN_VERSION_base(4,21,0) , " HasCallStack backtrace:" , " " #endif diff --git a/version.yaml b/version.yaml --- a/version.yaml +++ b/version.yaml @@ -1,4 +1,4 @@ -version: &version 2.11.10 +version: &version 2.11.11 synopsis: A Testing Framework for Haskell author: Simon Hengel maintainer: Simon Hengel