git.iko.soy/servant-quickcheck
on master help sign in
Bump HSpec to 2.4.4 and make tests use safeEvaluateExample to capture failure msg
commitf052dc149b0fcec9eff17ff88bb1b68c9c0e147c authorErik Aker <eraker@gmail.com> dateSat 15 Jul 2017, 15:03 (9 years ago) parente1a9db4
4 files changed+34−27
compare with master
unifiedsplit
servant-quickcheck.cabal+3−2 src/Servant/QuickCheck/Internal/QuickCheck.hs+4−6 stack.yaml+4−3 test/Servant/QuickCheck/InternalSpec.hs+23−16
servant-quickcheck.cabal+3−2
@@ -38,14 +38,15 @@ library
3838 , case-insensitive == 1.2.*
3939 , clock >= 0.7 && < 0.8
4040 , data-default-class >= 0.0 && < 0.2
41− , hspec >= 2.2 && < 2.4
41+ , hspec >= 2.4.4 && < 2.5
42+ , hspec-core >= 2.4.4 && < 2.5
4243 , http-client >= 0.4.30 && < 0.6
4344 , http-media == 0.6.*
4445 , http-types > 0.8 && < 0.10
4546 , mtl > 2.1 && < 2.3
4647 , pretty == 1.1.*
4748 , process >= 1.2 && < 1.5
48− , QuickCheck > 2.7 && < 2.10
49+ , QuickCheck > 2.9 && < 2.11
4950 , servant > 0.6 && < 0.10
5051 , servant-client > 0.6 && < 0.10
5152 , servant-server > 0.6 && < 0.10
src/Servant/QuickCheck/Internal/QuickCheck.hs+4−6
@@ -14,8 +14,7 @@ import Servant (Context (EmptyContext), HasServer,
1414import Servant.Client (BaseUrl (..), Scheme (..))
1515import System.IO.Unsafe (unsafePerformIO)
1616import Test.Hspec (Expectation, expectationFailure)
17−import Test.QuickCheck (Args (..), Result (..),
18− quickCheckWithResult)
17+import Test.QuickCheck (Args (..), Result (..), quickCheckWithResult)
1918import Test.QuickCheck.Monadic (assert, forAllM, monadicIO, monitor,
2019 run)
2120import Test.QuickCheck.Property (counterexample)
@@ -85,11 +84,10 @@ serversEqual api burl1 burl2 args req = do
8584 assert False
8685 case r of
8786 Success {} -> return ()
88− Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $
89− "Failed:\n" ++ show x
87+ Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $ "Failed:\n" ++ show x
9088 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
91− NoExpectedFailure {} -> expectationFailure $ "No expected failure"
92− InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
89+ NoExpectedFailure {} -> expectationFailure "No expected failure"
90+ InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
9391
9492-- | Check that a server satisfies the set of properties specified.
9593--
stack.yaml+4−3
@@ -2,8 +2,9 @@ resolver: lts-8.4
22packages:
33- '.'
44extra-deps:
5−- hspec-2.3.2
6−- hspec-core-2.3.2
7−- hspec-discover-2.3.2
5+- hspec-2.4.4
6+- hspec-core-2.4.4
7+- hspec-discover-2.4.4
8+- quickcheck-io-0.2.0
89flags: {}
910extra-package-dbs: []
test/Servant/QuickCheck/InternalSpec.hs+23−16
@@ -2,6 +2,7 @@
22module Servant.QuickCheck.InternalSpec (spec) where
33
44import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
5+import Control.Exception
56import Control.Monad.IO.Class (liftIO)
67import qualified Data.ByteString as BS
78import qualified Data.ByteString.Char8 as C
@@ -9,8 +10,8 @@ import Prelude.Compat
910import Servant
1011import Test.Hspec (Spec, context, describe, it, shouldBe,
1112 shouldContain)
12−import Test.Hspec.Core.Spec (Arg, Example, Result (..),
13− defaultParams, evaluateExample)
13+import Test.Hspec.Core.Spec (Arg, Example, Result (..), FailureReason (..),
14+ defaultParams, evaluateExample, safeEvaluateExample)
1415import Test.QuickCheck.Gen (unGen)
1516import Test.QuickCheck.Random (mkQCGen)
1617import Network.HTTP.Client (queryString, path)
@@ -46,11 +47,11 @@ serversEqualSpec = describe "serversEqual" $ do
4647
4748 context "when servers are not equal" $ do
4849
49−
5050 it "provides the failing responses in the error message" $ do
51− Fail _ err <- withServantServer api2 server2 $ \burl1 ->
51+ Right (Failure _ err) <- withServantServer api2 server2 $ \burl1 ->
5252 withServantServer api2 server3 $ \burl2 -> do
53− evalExample $ serversEqual api2 burl1 burl2 args bodyEquality
53+ safeEvalExample $ serversEqual api2 burl1 burl2 args bodyEquality
54+ show err `shouldContain` "Server equality failed"
5455 show err `shouldContain` "Body: 1"
5556 show err `shouldContain` "Body: 2"
5657 show err `shouldContain` "Path: /failplz"
@@ -75,20 +76,20 @@ serverSatisfiesSpec = describe "serverSatisfies" $ do
7576 context "when predicates are false" $ do
7677
7778 it "fails with informative error messages" $ do
78− Fail _ err <- withServantServerAndContext api ctx server $ \burl -> do
79− evalExample $ serverSatisfies api burl args (getsHaveCacheControlHeader <%> mempty)
80− err `shouldContain` "getsHaveCacheControlHeader"
81− err `shouldContain` "Headers"
82− err `shouldContain` "Body"
79+ Right (Failure _ err) <- withServantServerAndContext api ctx server $ \burl -> do
80+ safeEvalExample $ serverSatisfies api burl args (getsHaveCacheControlHeader <%> mempty)
81+ show err `shouldContain` "getsHaveCacheControlHeader"
82+ show err `shouldContain` "Headers"
83+ show err `shouldContain` "Body"
8384
8485onlyJsonObjectSpec :: Spec
8586onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
8687
8788 it "fails correctly" $ do
88− Fail _ err <- withServantServerAndContext api ctx server $ \burl -> do
89− evalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
89+ Right (Failure _ err) <- withServantServerAndContext api ctx server $ \burl -> do
90+ safeEvalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
9091 (onlyJsonObjects <%> mempty)
91− err `shouldContain` "onlyJsonObjects"
92+ show err `shouldContain` "onlyJsonObjects"
9293
9394 it "accepts non-JSON endpoints" $ do
9495 withServantServerAndContext octetAPI ctx serverOctetAPI $ \burl ->
@@ -98,10 +99,10 @@ notLongerThanSpec :: Spec
9899notLongerThanSpec = describe "notLongerThan" $ do
99100
100101 it "fails correctly" $ do
101− Fail _ err <- withServantServerAndContext api ctx server $ \burl -> do
102− evalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
102+ Right (Failure _ err) <- withServantServerAndContext api ctx server $ \burl -> do
103+ safeEvalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
103104 (notLongerThan 1 <%> mempty)
104− err `shouldContain` "notLongerThan"
105+ show err `shouldContain` "notLongerThan"
105106
106107 it "succeeds correctly" $ do
107108 withServantServerAndContext api ctx server $ \burl ->
@@ -213,6 +214,12 @@ evalExample e = evaluateExample e defaultParams ($ ()) progCallback
213214 where
214215 progCallback _ = return ()
215216
217+safeEvalExample :: (Example e, Arg e ~ ()) => e -> IO (Either SomeException Result)
218+safeEvalExample e = safeEvaluateExample e defaultParams ($ ()) progCallback
219+ where
220+ progCallback _ = return ()
221+
222+
216223args :: Args
217224args = defaultArgs { maxSuccess = noOfTestCases }
218225