diff --git a/.travis.yml b/.travis.yml index 4bccc91..beab343 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,7 +3,7 @@ sudo: false env: - CABALVER=1.18 GHCVER=7.6.3 - CABALVER=1.18 GHCVER=7.8.4 - - CABALVER=1.22 GHCVER=7.10.2 + - CABALVER=1.22 GHCVER=7.10.3 - CABALVER=1.24 GHCVER=8.0.1 addons: @@ -13,7 +13,7 @@ addons: packages: - ghc-7.6.3 - ghc-7.8.4 - - ghc-7.10.2 + - ghc-7.10.3 - ghc-8.0.1 - cabal-install-1.18 - cabal-install-1.22 diff --git a/src/Test/Hspec/Expectations.hs b/src/Test/Hspec/Expectations.hs index 2fd326c..a6f1753 100644 --- a/src/Test/Hspec/Expectations.hs +++ b/src/Test/Hspec/Expectations.hs @@ -11,6 +11,7 @@ module Test.Hspec.Expectations ( Expectation , expectationFailure , shouldBe +, shouldBeNear , shouldSatisfy , shouldStartWith , shouldEndWith @@ -78,7 +79,7 @@ expectationFailure = Test.HUnit.assertFailure with_loc(expectTrue, String -> Bool -> Expectation) expectTrue msg b = unless b (expectationFailure msg) -infix 1 `shouldBe`, `shouldSatisfy`, `shouldStartWith`, `shouldEndWith`, `shouldContain`, `shouldMatchList`, `shouldReturn`, `shouldThrow` +infix 1 `shouldBe`, `shouldBeNear`, `shouldSatisfy`, `shouldStartWith`, `shouldEndWith`, `shouldContain`, `shouldMatchList`, `shouldReturn`, `shouldThrow` infix 1 `shouldNotBe`, `shouldNotSatisfy`, `shouldNotContain`, `shouldNotReturn` -- | @@ -87,6 +88,24 @@ infix 1 `shouldNotBe`, `shouldNotSatisfy`, `shouldNotContain`, `shouldNotReturn` with_loc(shouldBe, (Show a, Eq a) => a -> a -> Expectation) actual `shouldBe` expected = expectTrue ("expected: " ++ show expected ++ "\n but got: " ++ show actual) (actual == expected) +-- | +-- @actual \`shouldBeNear\` expected@ sets the expectation that @actual@ be a +-- floating point value near @expected@. If either value is zero we check that +-- the absolute difference is less than epsilon (1e-15) otherwise we check if +-- the relative difference is less than epsilon. +with_loc(shouldBeNear, (Show a, Ord a, Floating a) => a -> a -> Expectation) +actual `shouldBeNear` expected + -- Short circuit if they are actually equal. + | actual == expected = reportFail (actual == expected) + | actual == 0 || expected == 0 = reportFail (absoluteDifference < epsilon) + | otherwise = reportFail (relativeDifference < epsilon) + where + epsilon = 1e-15 + absoluteDifference = abs (expected - actual) + relativeDifference = absoluteDifference / (abs actual + abs expected) + reportFail = + expectTrue ("expected: " ++ show expected ++ "\n but got: " ++ show actual) + -- | -- @v \`shouldSatisfy\` p@ sets the expectation that @p v@ is @True@. with_loc(shouldSatisfy, (Show a) => a -> (a -> Bool) -> Expectation) diff --git a/test/Test/Hspec/ExpectationsSpec.hs b/test/Test/Hspec/ExpectationsSpec.hs index 7162eea..d95ef66 100644 --- a/test/Test/Hspec/ExpectationsSpec.hs +++ b/test/Test/Hspec/ExpectationsSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} + #if MIN_VERSION_base(4,8,1) #define HAS_SOURCE_LOCATIONS {-# LANGUAGE ImplicitParams #-} @@ -43,6 +44,31 @@ spec = do it "fails if arguments are not equal" $ do ("foo" `shouldBe` "bar") `shouldThrow` expectationFailed "expected: \"bar\"\n but got: \"foo\"" + describe "shouldBeNear" $ do + it "succeeds if arguments are equal" $ do + 1.23456789 `shouldBeNear` (1.23456789 :: Float) + + it "fails if arguments are not equal" $ do + (1.0 `shouldBe` (2.0 :: Float)) `shouldThrow` expectationFailed "expected: 2.0\n but got: 1.0" + + it "succeeds if one argument is zero and the other less than epsilon" $ do + 0.0 `shouldBeNear` (-1e-16 :: Float) + + it "succeeds for large values near one another" $ do + 1e20 `shouldBeNear` (1e20 + 1 :: Float) + + it "succeeds for a small number near zero" $ do + 1e-300 `shouldBeNear` (0.0 :: Double) + +#if __GLASGOW_HASKELL__ != 710 + -- For some reason this fails with ghc-7.10.2 and 7.10.3. + it "fails for large values not near each other" $ do + (1.1e20 `shouldBeNear` (2.1e20 :: Double)) `shouldThrow` expectationFailed "expected: 2.1e20\n but got: 1.1e20" + + it "fails for two small numbers that are not near each other" $ do + (1.1e-300 `shouldBeNear` (1e-300 :: Double)) `shouldThrow` expectationFailed "expected: 1.0e-300\n but got: 1.1e-300" +#endif + describe "shouldSatisfy" $ do it "succeeds if value satisfies predicate" $ do "" `shouldSatisfy` null