diff --git a/hspec-expectations.cabal b/hspec-expectations.cabal --- a/hspec-expectations.cabal +++ b/hspec-expectations.cabal @@ -1,12 +1,12 @@ --- This file has been generated from package.yaml by hpack version 0.5.4. +-- This file has been generated from package.yaml by hpack version 0.15.0. -- -- see: https://github.com/sol/hpack name: hspec-expectations -version: 0.7.2 +version: 0.8.0 synopsis: Catchy combinators for HUnit -description: Catchy combinators for HUnit: -bug-reports: https://github.com/sol/hspec-expectations/issues +description: Catchy combinators for HUnit: +bug-reports: https://github.com/hspec/hspec-expectations/issues license: MIT license-file: LICENSE copyright: (c) 2011-2015 Simon Hengel @@ -15,11 +15,11 @@ build-type: Simple category: Testing cabal-version: >= 1.10 -homepage: https://github.com/sol/hspec-expectations#readme +homepage: https://github.com/hspec/hspec-expectations#readme source-repository head type: git - location: https://github.com/sol/hspec-expectations + location: https://github.com/hspec/hspec-expectations library hs-source-dirs: @@ -28,9 +28,31 @@ build-depends: base == 4.* , HUnit + , call-stack exposed-modules: Test.Hspec.Expectations Test.Hspec.Expectations.Contrib other-modules: + Test.Hspec.Expectations.Matcher + Paths_hspec_expectations + default-language: Haskell2010 + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test + src + ghc-options: -Wall + build-depends: + base == 4.* + , HUnit + , call-stack + , nanospec + other-modules: + Test.Hspec.Expectations.MatcherSpec + Test.Hspec.ExpectationsSpec + Test.Hspec.Expectations + Test.Hspec.Expectations.Contrib Test.Hspec.Expectations.Matcher default-language: Haskell2010 diff --git a/src/Test/Hspec/Expectations.hs b/src/Test/Hspec/Expectations.hs --- a/src/Test/Hspec/Expectations.hs +++ b/src/Test/Hspec/Expectations.hs @@ -1,14 +1,14 @@ {-# LANGUAGE CPP #-} -#if MIN_VERSION_base(4,8,1) -#define HAS_SOURCE_LOCATIONS +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE KindSignatures #-} {-# LANGUAGE ImplicitParams #-} -#endif -- | -- Introductory documentation: module Test.Hspec.Expectations ( -- * Setting expectations Expectation +, HasCallStack , expectationFailure , shouldBe , shouldSatisfy @@ -58,24 +58,24 @@ import Test.Hspec.Expectations.Matcher -#ifdef HAS_SOURCE_LOCATIONS - -import GHC.Stack - -#define with_loc(NAME, TYPE) NAME :: (?loc :: CallStack) => TYPE - +#if MIN_VERSION_HUnit(1,4,0) +import Data.CallStack (HasCallStack) #else - -#define with_loc(NAME, TYPE) NAME :: TYPE - +#if MIN_VERSION_base(4,8,1) +import qualified GHC.Stack as GHC +type HasCallStack = (?loc :: GHC.CallStack) +#else +import GHC.Exts (Constraint) +type HasCallStack = (() :: Constraint) #endif +#endif type Expectation = Test.HUnit.Assertion -with_loc(expectationFailure, String -> Expectation) +expectationFailure :: HasCallStack => String -> Expectation expectationFailure = Test.HUnit.assertFailure -with_loc(expectTrue, String -> Bool -> Expectation) +expectTrue :: HasCallStack => String -> Bool -> Expectation expectTrue msg b = unless b (expectationFailure msg) infix 1 `shouldBe`, `shouldSatisfy`, `shouldStartWith`, `shouldEndWith`, `shouldContain`, `shouldMatchList`, `shouldReturn`, `shouldThrow` @@ -84,62 +84,62 @@ -- | -- @actual \`shouldBe\` expected@ sets the expectation that @actual@ is equal -- to @expected@. -with_loc(shouldBe, (Show a, Eq a) => a -> a -> Expectation) +shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation actual `shouldBe` expected = expectTrue ("expected: " ++ show expected ++ "\n but got: " ++ show actual) (actual == expected) -- | -- @v \`shouldSatisfy\` p@ sets the expectation that @p v@ is @True@. -with_loc(shouldSatisfy, (Show a) => a -> (a -> Bool) -> Expectation) +shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation v `shouldSatisfy` p = expectTrue ("predicate failed on: " ++ show v) (p v) -with_loc(compareWith, (Show a, Eq a) => (a -> a -> Bool) -> String -> a -> a -> Expectation) +compareWith :: (HasCallStack, Show a) => (a -> a -> Bool) -> String -> a -> a -> Expectation compareWith comparator errorDesc result expected = expectTrue errorMsg (comparator expected result) where errorMsg = show result ++ " " ++ errorDesc ++ " " ++ show expected -- | -- @list \`shouldStartWith\` prefix@ sets the expectation that @list@ starts with @prefix@, -with_loc(shouldStartWith, (Show a, Eq a) => [a] -> [a] -> Expectation) +shouldStartWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation shouldStartWith = compareWith isPrefixOf "does not start with" -- | -- @list \`shouldEndWith\` suffix@ sets the expectation that @list@ ends with @suffix@, -with_loc(shouldEndWith, (Show a, Eq a) => [a] -> [a] -> Expectation) +shouldEndWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation shouldEndWith = compareWith isSuffixOf "does not end with" -- | -- @list \`shouldContain\` sublist@ sets the expectation that @sublist@ is contained, -- wholly and intact, anywhere in @list@. -with_loc(shouldContain, (Show a, Eq a) => [a] -> [a] -> Expectation) +shouldContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation shouldContain = compareWith isInfixOf "does not contain" -- | -- @xs \`shouldMatchList\` ys@ sets the expectation that @xs@ has the same -- elements that @ys@ has, possibly in another order -with_loc(shouldMatchList, (Show a, Eq a) => [a] -> [a] -> Expectation) +shouldMatchList :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation xs `shouldMatchList` ys = maybe (return ()) expectationFailure (matchList xs ys) -- | -- @action \`shouldReturn\` expected@ sets the expectation that @action@ -- returns @expected@. -with_loc(shouldReturn, (Show a, Eq a) => IO a -> a -> Expectation) +shouldReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation action `shouldReturn` expected = action >>= (`shouldBe` expected) -- | -- @actual \`shouldNotBe\` notExpected@ sets the expectation that @actual@ is not -- equal to @notExpected@ -with_loc(shouldNotBe, (Show a, Eq a) => a -> a -> Expectation) +shouldNotBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation actual `shouldNotBe` notExpected = expectTrue ("not expected: " ++ show actual) (actual /= notExpected) -- | -- @v \`shouldNotSatisfy\` p@ sets the expectation that @p v@ is @False@. -with_loc(shouldNotSatisfy, (Show a) => a -> (a -> Bool) -> Expectation) -v `shouldNotSatisfy` p = expectTrue ("predicate succeded on: " ++ show v) ((not . p) v) +shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation +v `shouldNotSatisfy` p = expectTrue ("predicate succeeded on: " ++ show v) ((not . p) v) -- | -- @list \`shouldNotContain\` sublist@ sets the expectation that @sublist@ is not -- contained anywhere in @list@. -with_loc(shouldNotContain, (Show a, Eq a) => [a] -> [a] -> Expectation) +shouldNotContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation list `shouldNotContain` sublist = expectTrue errorMsg ((not . isInfixOf sublist) list) where errorMsg = show list ++ " does contain " ++ show sublist @@ -147,7 +147,7 @@ -- | -- @action \`shouldNotReturn\` notExpected@ sets the expectation that @action@ -- does not return @notExpected@. -with_loc(shouldNotReturn, (Show a, Eq a) => IO a -> a -> Expectation) +shouldNotReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation action `shouldNotReturn` notExpected = action >>= (`shouldNotBe` notExpected) -- | @@ -159,7 +159,7 @@ -- @action \`shouldThrow\` selector@ sets the expectation that @action@ throws -- an exception. The precise nature of the expected exception is described -- with a 'Selector'. -with_loc(shouldThrow, Exception e => IO a -> Selector e -> Expectation) +shouldThrow :: (HasCallStack, Exception e) => IO a -> Selector e -> Expectation action `shouldThrow` p = do r <- try action case r of @@ -183,7 +183,11 @@ anyErrorCall = const True errorCall :: String -> Selector ErrorCall +#if MIN_VERSION_base(4,9,0) +errorCall s (ErrorCallWithLocation msg _) = s == msg +#else errorCall s (ErrorCall msg) = s == msg +#endif anyIOException :: Selector IOException anyIOException = const True diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,14 @@ +module Main where + +import Test.Hspec + +import qualified Test.Hspec.ExpectationsSpec +import qualified Test.Hspec.Expectations.MatcherSpec + +spec :: Spec +spec = do + describe "Test.Hspec.ExpectationsSpec" Test.Hspec.ExpectationsSpec.spec + describe "Test.Hspec.Expectations.MatcherSpec" Test.Hspec.Expectations.MatcherSpec.spec + +main :: IO () +main = hspec spec diff --git a/test/Test/Hspec/Expectations/MatcherSpec.hs b/test/Test/Hspec/Expectations/MatcherSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Hspec/Expectations/MatcherSpec.hs @@ -0,0 +1,34 @@ +module Test.Hspec.Expectations.MatcherSpec (main, spec) where + +import Test.Hspec + +import Test.Hspec.Expectations.Matcher + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "matchList" $ do + it "succeeds if arguments are empty lists" $ do + matchList [] ([] :: [Int]) `shouldBe` Nothing + + it "succeeds if arguments are equal up to permutation" $ do + matchList [1, 2, 2, 3] [3, 2, 1, 2 :: Int] `shouldBe` Nothing + + context "when arguments are not equal up to permutation" $ do + it "shows extra elements" $ do + [1, 2, 2, 3] `matchList` [1, 2, 3 :: Int] `shouldBe` (Just . unlines) [ + "Actual list is not a permutation of expected list!" + , " expected list contains: [1, 2, 3]" + , " actual list contains: [1, 2, 2, 3]" + , " the extra elements are: [2]" + ] + + it "shows missing elements" $ do + [1, 2, 3] `matchList` [1, 2, 2, 3 :: Int] `shouldBe` (Just . unlines) [ + "Actual list is not a permutation of expected list!" + , " expected list contains: [1, 2, 2, 3]" + , " actual list contains: [1, 2, 3]" + , " the missing elements are: [2]" + ] diff --git a/test/Test/Hspec/ExpectationsSpec.hs b/test/Test/Hspec/ExpectationsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/Hspec/ExpectationsSpec.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +module Test.Hspec.ExpectationsSpec (spec) where + +import Control.Exception +import Test.HUnit.Lang +import Test.Hspec (Spec, describe, it) + +import Test.Hspec.Expectations hiding (HasCallStack) +import Data.CallStack + +expectationFailed :: HasCallStack => String -> HUnitFailure -> Bool +expectationFailed msg (HUnitFailure l m) = m == msg && (fmap setColumn l) == (fmap setColumn location) + where + location = case reverse callStack of + [] -> Nothing +#if MIN_VERSION_HUnit(1,4,0) + (_, loc) : _ -> Just loc + location :: Maybe SrcLoc + + setColumn loc_ = loc_{srcLocStartCol = 0, srcLocEndCol = 0} +#else + (_, loc) : _ -> Just $ Location (srcLocFile loc) (srcLocStartLine loc) 0 + location :: Maybe Location + + setColumn loc_ = loc_{locationColumn = 0} +#endif + +spec :: Spec +spec = do + describe "shouldBe" $ do + it "succeeds if arguments are equal" $ do + "foo" `shouldBe` "foo" + + it "fails if arguments are not equal" $ do + ("foo" `shouldBe` "bar") `shouldThrow` expectationFailed "expected: \"bar\"\n but got: \"foo\"" + + describe "shouldSatisfy" $ do + it "succeeds if value satisfies predicate" $ do + "" `shouldSatisfy` null + + it "fails if value does not satisfy predicate" $ do + ("foo" `shouldSatisfy` null) `shouldThrow` expectationFailed "predicate failed on: \"foo\"" + + describe "shouldReturn" $ do + it "succeeds if arguments represent equal values" $ do + return "foo" `shouldReturn` "foo" + + it "fails if arguments do not represent equal values" $ do + (return "foo" `shouldReturn` "bar") `shouldThrow` expectationFailed "expected: \"bar\"\n but got: \"foo\"" + + describe "shouldStartWith" $ do + it "succeeds if second is prefix of first" $ do + "hello world" `shouldStartWith` "hello" + + it "fails if second is not prefix of first" $ do + ("hello world" `shouldStartWith` "world") `shouldThrow` expectationFailed "\"hello world\" does not start with \"world\"" + + describe "shouldEndWith" $ do + it "succeeds if second is suffix of first" $ do + "hello world" `shouldEndWith` "world" + + it "fails if second is not suffix of first" $ do + ("hello world" `shouldEndWith` "hello") `shouldThrow` expectationFailed "\"hello world\" does not end with \"hello\"" + + describe "shouldContain" $ do + it "succeeds if second argument is contained in the first" $ do + "I'm an hello world message" `shouldContain` "an hello" + + it "fails if first argument does not contain the second" $ do + ("foo" `shouldContain` "bar") `shouldThrow` expectationFailed "\"foo\" does not contain \"bar\"" + + describe "shouldNotBe" $ do + it "succeeds if arguments are not equal" $ do + "foo" `shouldNotBe` "bar" + + it "fails if arguments are equal" $ do + ("foo" `shouldNotBe` "foo") `shouldThrow` expectationFailed "not expected: \"foo\"" + + describe "shouldNotSatisfy" $ do + it "succeeds if value does not satisfy predicate" $ do + "bar" `shouldNotSatisfy` null + + it "fails if the value does satisfy predicate" $ do + ("" `shouldNotSatisfy` null) `shouldThrow` expectationFailed "predicate succeeded on: \"\"" + + describe "shouldNotReturn" $ do + it "succeeds if arguments does not represent equal values" $ do + return "foo" `shouldNotReturn` "bar" + + it "fails if arguments do represent equal values" $ do + (return "foo" `shouldNotReturn` "foo") `shouldThrow` expectationFailed "not expected: \"foo\"" + + describe "shouldNotContain" $ do + it "succeeds if second argument is not contained in the first" $ do + "I'm an hello world message" `shouldNotContain` "test" + + it "fails if first argument does contain the second" $ do + ("foo abc def" `shouldNotContain` "def") `shouldThrow` expectationFailed "\"foo abc def\" does contain \"def\"" + + describe "shouldThrow" $ do + it "can be used to require a specific exception" $ do + throwIO DivideByZero `shouldThrow` (== DivideByZero) + + it "can be used to require any exception" $ do + error "foobar" `shouldThrow` anyException + + it "can be used to require an exception of a specific type" $ do + error "foobar" `shouldThrow` anyErrorCall + + it "can be used to require a specific exception" $ do + error "foobar" `shouldThrow` errorCall "foobar" + + it "fails, if a required specific exception is not thrown" $ do + (throwIO Overflow `shouldThrow` (== DivideByZero)) `shouldThrow` expectationFailed "predicate failed on expected exception: ArithException (arithmetic overflow)" + + it "fails, if any exception is required, but no exception is thrown" $ do + (return () `shouldThrow` anyException) `shouldThrow` expectationFailed "did not get expected exception: SomeException" + + it "fails, if an exception of a specific type is required, but no exception is thrown" $ do + (return () `shouldThrow` anyErrorCall) `shouldThrow` expectationFailed "did not get expected exception: ErrorCall"