mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-08-16 22:00:32 +03:00
Bump HSpec to 2.4.4 and make tests use safeEvaluateExample to capture failure msg
This commit is contained in:
parent
e1a9db4924
commit
f052dc149b
@ -38,14 +38,15 @@ library
|
||||
, case-insensitive == 1.2.*
|
||||
, clock >= 0.7 && < 0.8
|
||||
, data-default-class >= 0.0 && < 0.2
|
||||
, hspec >= 2.2 && < 2.4
|
||||
, hspec >= 2.4.4 && < 2.5
|
||||
, hspec-core >= 2.4.4 && < 2.5
|
||||
, http-client >= 0.4.30 && < 0.6
|
||||
, http-media == 0.6.*
|
||||
, http-types > 0.8 && < 0.10
|
||||
, mtl > 2.1 && < 2.3
|
||||
, pretty == 1.1.*
|
||||
, process >= 1.2 && < 1.5
|
||||
, QuickCheck > 2.7 && < 2.10
|
||||
, QuickCheck > 2.9 && < 2.11
|
||||
, servant > 0.6 && < 0.10
|
||||
, servant-client > 0.6 && < 0.10
|
||||
, servant-server > 0.6 && < 0.10
|
||||
|
@ -14,8 +14,7 @@ import Servant (Context (EmptyContext), HasServer,
|
||||
import Servant.Client (BaseUrl (..), Scheme (..))
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Test.Hspec (Expectation, expectationFailure)
|
||||
import Test.QuickCheck (Args (..), Result (..),
|
||||
quickCheckWithResult)
|
||||
import Test.QuickCheck (Args (..), Result (..), quickCheckWithResult)
|
||||
import Test.QuickCheck.Monadic (assert, forAllM, monadicIO, monitor,
|
||||
run)
|
||||
import Test.QuickCheck.Property (counterexample)
|
||||
@ -85,11 +84,10 @@ serversEqual api burl1 burl2 args req = do
|
||||
assert False
|
||||
case r of
|
||||
Success {} -> return ()
|
||||
Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $
|
||||
"Failed:\n" ++ show x
|
||||
Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $ "Failed:\n" ++ show x
|
||||
GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
|
||||
NoExpectedFailure {} -> expectationFailure $ "No expected failure"
|
||||
InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
|
||||
NoExpectedFailure {} -> expectationFailure "No expected failure"
|
||||
InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
|
||||
|
||||
-- | Check that a server satisfies the set of properties specified.
|
||||
--
|
||||
|
@ -2,8 +2,9 @@ resolver: lts-8.4
|
||||
packages:
|
||||
- '.'
|
||||
extra-deps:
|
||||
- hspec-2.3.2
|
||||
- hspec-core-2.3.2
|
||||
- hspec-discover-2.3.2
|
||||
- hspec-2.4.4
|
||||
- hspec-core-2.4.4
|
||||
- hspec-discover-2.4.4
|
||||
- quickcheck-io-0.2.0
|
||||
flags: {}
|
||||
extra-package-dbs: []
|
||||
|
@ -2,6 +2,7 @@
|
||||
module Servant.QuickCheck.InternalSpec (spec) where
|
||||
|
||||
import Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
|
||||
import Control.Exception
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
@ -9,8 +10,8 @@ import Prelude.Compat
|
||||
import Servant
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe,
|
||||
shouldContain)
|
||||
import Test.Hspec.Core.Spec (Arg, Example, Result (..),
|
||||
defaultParams, evaluateExample)
|
||||
import Test.Hspec.Core.Spec (Arg, Example, Result (..), FailureReason (..),
|
||||
defaultParams, evaluateExample, safeEvaluateExample)
|
||||
import Test.QuickCheck.Gen (unGen)
|
||||
import Test.QuickCheck.Random (mkQCGen)
|
||||
import Network.HTTP.Client (queryString, path)
|
||||
@ -46,11 +47,11 @@ serversEqualSpec = describe "serversEqual" $ do
|
||||
|
||||
context "when servers are not equal" $ do
|
||||
|
||||
|
||||
it "provides the failing responses in the error message" $ do
|
||||
Fail _ err <- withServantServer api2 server2 $ \burl1 ->
|
||||
Right (Failure _ err) <- withServantServer api2 server2 $ \burl1 ->
|
||||
withServantServer api2 server3 $ \burl2 -> do
|
||||
evalExample $ serversEqual api2 burl1 burl2 args bodyEquality
|
||||
safeEvalExample $ serversEqual api2 burl1 burl2 args bodyEquality
|
||||
show err `shouldContain` "Server equality failed"
|
||||
show err `shouldContain` "Body: 1"
|
||||
show err `shouldContain` "Body: 2"
|
||||
show err `shouldContain` "Path: /failplz"
|
||||
@ -75,20 +76,20 @@ serverSatisfiesSpec = describe "serverSatisfies" $ do
|
||||
context "when predicates are false" $ do
|
||||
|
||||
it "fails with informative error messages" $ do
|
||||
Fail _ err <- withServantServerAndContext api ctx server $ \burl -> do
|
||||
evalExample $ serverSatisfies api burl args (getsHaveCacheControlHeader <%> mempty)
|
||||
err `shouldContain` "getsHaveCacheControlHeader"
|
||||
err `shouldContain` "Headers"
|
||||
err `shouldContain` "Body"
|
||||
Right (Failure _ err) <- withServantServerAndContext api ctx server $ \burl -> do
|
||||
safeEvalExample $ serverSatisfies api burl args (getsHaveCacheControlHeader <%> mempty)
|
||||
show err `shouldContain` "getsHaveCacheControlHeader"
|
||||
show err `shouldContain` "Headers"
|
||||
show err `shouldContain` "Body"
|
||||
|
||||
onlyJsonObjectSpec :: Spec
|
||||
onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
|
||||
|
||||
it "fails correctly" $ do
|
||||
Fail _ err <- withServantServerAndContext api ctx server $ \burl -> do
|
||||
evalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
|
||||
Right (Failure _ err) <- withServantServerAndContext api ctx server $ \burl -> do
|
||||
safeEvalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
|
||||
(onlyJsonObjects <%> mempty)
|
||||
err `shouldContain` "onlyJsonObjects"
|
||||
show err `shouldContain` "onlyJsonObjects"
|
||||
|
||||
it "accepts non-JSON endpoints" $ do
|
||||
withServantServerAndContext octetAPI ctx serverOctetAPI $ \burl ->
|
||||
@ -98,10 +99,10 @@ notLongerThanSpec :: Spec
|
||||
notLongerThanSpec = describe "notLongerThan" $ do
|
||||
|
||||
it "fails correctly" $ do
|
||||
Fail _ err <- withServantServerAndContext api ctx server $ \burl -> do
|
||||
evalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
|
||||
Right (Failure _ err) <- withServantServerAndContext api ctx server $ \burl -> do
|
||||
safeEvalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
|
||||
(notLongerThan 1 <%> mempty)
|
||||
err `shouldContain` "notLongerThan"
|
||||
show err `shouldContain` "notLongerThan"
|
||||
|
||||
it "succeeds correctly" $ do
|
||||
withServantServerAndContext api ctx server $ \burl ->
|
||||
@ -213,6 +214,12 @@ evalExample e = evaluateExample e defaultParams ($ ()) progCallback
|
||||
where
|
||||
progCallback _ = return ()
|
||||
|
||||
safeEvalExample :: (Example e, Arg e ~ ()) => e -> IO (Either SomeException Result)
|
||||
safeEvalExample e = safeEvaluateExample e defaultParams ($ ()) progCallback
|
||||
where
|
||||
progCallback _ = return ()
|
||||
|
||||
|
||||
args :: Args
|
||||
args = defaultArgs { maxSuccess = noOfTestCases }
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user