git.iko.soy/servant-quickcheck
on master help sign in
Better failure tests
c85d41aJulian K. Arni
src/Servant/QuickCheck/Internal/QuickCheck.hs+14
compare with master
unifiedsplit
@@ -93,6 +93,20 @@ serverSatisfies api burl args preds = do
93 InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
93 InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
94
94
95
95
96+serverDoesntSatisfy :: (HasGenRequest a) =>
97+ Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation
98+serverDoesntSatisfy api burl args preds = do
99+ let reqs = ($ burl) <$> genRequest api
100+ r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
101+ v <- run $ finishPredicates preds (noCheckStatus req) defManager
102+ assert $ not $ null v
103+ case r of
104+ Success {} -> return ()
105+ GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
106+ Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
107+ NoExpectedFailure {} -> expectationFailure $ "No expected failure"
108+ InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
109+
96noCheckStatus :: Request -> Request
110noCheckStatus :: Request -> Request
97noCheckStatus r = r { checkStatus = \_ _ _ -> Nothing}
111noCheckStatus r = r { checkStatus = \_ _ _ -> Nothing}
98
112
test/Servant/QuickCheck/InternalSpec.hs+6−5
@@ -12,7 +12,7 @@ import Servant.API.Internal.Test.ComprehensiveAPI
12
12
13import Servant.QuickCheck
13import Servant.QuickCheck
14
14
15−import Servant.QuickCheck.Internal (genRequest)
15+import Servant.QuickCheck.Internal (genRequest, serverDoesntSatisfy)
16
16
17spec :: Spec
17spec :: Spec
18spec = do
18spec = do
@@ -40,10 +40,11 @@ serverSatisfiesSpec = describe "serverSatisfies" $ do
40
40
41 it "fails for false predicates" $ do
41 it "fails for false predicates" $ do
42 withServantServerAndContext api ctx server $ \burl -> do
42 withServantServerAndContext api ctx server $ \burl -> do
43− -- Since this is the negation, and we want to check that all of the
44− -- predicates fail rather than one or more, we need to separate them out
45− serverSatisfies api burl args ((not <$> onlyJsonObjects) <%> mempty)
43+ serverDoesntSatisfy api burl args (onlyJsonObjects
46− serverSatisfies api burl args ((not <$> getsHaveCacheControlHeader) <%> mempty)
44+ <%> getsHaveCacheControlHeader
45+ <%> headsHaveCacheControlHeader
46+ <%> notAllowedContainsAllowHeader
47+ <%> mempty)
47
48
48isComprehensiveSpec :: Spec
49isComprehensiveSpec :: Spec
49isComprehensiveSpec = describe "HasGenRequest" $ do
50isComprehensiveSpec = describe "HasGenRequest" $ do