Commits

John Lenz committed 4288b1d

Add tests for couchRev

  • Participants
  • Parent commits 4ba886d

Comments (0)

Files changed (2)

File test/Database/CouchDB/Enumerator/Test/Basic.hs

     mapM_ clearObject keys
 
     rev <- forM (zip keys vals1) $ \(k,o) -> couchPut k [] o
-    forM_ (zip3 rev keys vals1) $ \(r,k,o) ->
+
+    forM_ (zip3 rev keys vals1) $ \(r,k,o) -> do
         checkLoad k $ M.insert "_rev" (A.toJSON r) o
+        checkRevision k r
 
     rev2 <- forM (zip3 rev keys vals2) $ \(r,k,o) ->
         couchPut k [] $ M.insert "_rev" (A.toJSON r) o
 
-    forM_ (zip3 rev2 keys vals2) $ \(r,k,o) ->
+    forM_ (zip3 rev2 keys vals2) $ \(r,k,o) -> do
         checkLoad k $ M.insert "_rev" (A.toJSON r) o
+        checkRevision k r
 
     rev3 <- forM (zip3 rev2 keys vals3) $ \(r,k,o) ->
         couchPutRev k r [] o
 
-    forM_ (zip3 rev3 keys vals3) $ \(r,k,o) ->
+    forM_ (zip3 rev3 keys vals3) $ \(r,k,o) -> do
         checkLoad k $ M.insert "_rev" (A.toJSON r) o
+        checkRevision k r
 
 deleteTest :: CouchT IO ()
 deleteTest = do

File test/Database/CouchDB/Enumerator/Test/Util.hs

     , assertObjMember
     , checkError
     , assertRecvError
+    , checkRevision
     , checkLoad
     , clearObject
     , ArbitraryObject(..)
     obj' <- couchGet n []
     lift $ assertBool "returned object does not match" $ isSubmapOf obj obj'
 
+checkRevision :: String -> Revision -> CouchT IO ()
+checkRevision n r = do
+    r' <- couchRev n
+    lift $ assertBool "returned revision does not match" $ r == r'
+
 -- | Delete the given object, useful for the start of a test
 clearObject :: String -> CouchT IO ()
 clearObject n = checkError (Just 404) go