Commits

John Lenz committed 9a66717

Convert quickcheck tests to use hunit instead since there were problems (see Ticket #2)

  • Participants
  • Parent commits 4288b1d

Comments (0)

Files changed (3)

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

       testGroup "DB" [
           testCouchCase "basic connection"        connectTest
         , testCouchCase "basic error"             missingObjectTest
-        , testCouchProperty "single insert" (1,7) insertTest
+        --, testCouchProperty "single insert" (1,7) insertTest
+        , testCouchCase "insert"                  insertTestCase
         , testCouchCase "basic delete"            deleteTest
         , testCase "Delete noexistent"            case_deleteNoexistentDb
 
 missingObjectTest :: CouchT IO ()
 missingObjectTest = assertRecvError (Just 404) $ couchGet "jaosihaweoghaweiouhawef" []
 
-insertTest :: [(Int,ArbitraryObject,ArbitraryObject)] -> CouchT IO ()
+insertTestCase :: CouchT IO ()
+insertTestCase = replicateM_ 20 $ do
+    objs <- lift $ sample' arbitrary
+    insertTest objs
+
+insertTest :: [(Int,ArbitraryObject,ArbitraryObject,ArbitraryObject)] -> CouchT IO ()
 insertTest objs = do
-    let objs' = nubBy (\(a,_,_) (b,_,_) -> a == b) objs
-    let keys  = map (("otest"++) . show . (\(a,_,_) -> a)) objs'
-    let vals1 = map (\(_,ArbitraryObject a,_) -> a) objs'
-    let vals2 = map (\(_,_,ArbitraryObject a) -> a) objs'
-    let vals3 = map (\(_,_,ArbitraryObject a) -> a) objs'
+    let objs' = nubBy (\(a,_,_,_) (b,_,_,_) -> a == b) objs
+    let keys  = map (("otest"++) . show . (\(a,_,_,_) -> a)) objs'
+    let vals1 = map (\(_,ArbitraryObject a,_,_) -> a) objs'
+    let vals2 = map (\(_,_,ArbitraryObject a,_) -> a) objs'
+    let vals3 = map (\(_,_,_,ArbitraryObject a) -> a) objs'
 
     mapM_ clearObject keys
 
-    rev <- forM (zip keys vals1) $ \(k,o) -> couchPut k [] o
+    rev <- forM (zip keys vals1) $ \(k,o) ->
+        couchPut k [] o
 
     forM_ (zip3 rev keys vals1) $ \(r,k,o) -> do
         checkLoad k $ M.insert "_rev" (A.toJSON r) o
 
 -- | A test with an empty db
 case_deleteNoexistentDb :: Assertion
-case_deleteNoexistentDb = runCouch "server" 5984 "" $ 
+case_deleteNoexistentDb = runCouch "localhost" 5984 "" $ 
     checkError (Just 404) $ couchDeleteDb "cdbe_noexistent"

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

 type CouchT m a = ReaderT CouchConnection m a
 
 testCouch :: CouchT IO a -> IO ()
-testCouch c = withCouchConnection "server" 5984 "testcouchenum" (runReaderT c) >> return ()
+testCouch c = withCouchConnection "localhost" 5984 "testcouchenum" (runReaderT c) >> return ()
 
 testCouchCase :: String -> CouchT IO a -> Test
 testCouchCase s c = testCase s $ testCouch c
 -- | Delete the given object, useful for the start of a test
 clearObject :: String -> CouchT IO ()
 clearObject n = checkError (Just 404) go
-  where go = do obj <- couchGet n []
-                unless (member "_rev" obj) $ fail "_rev is missing"
-                let (A.String rev) = fromJust $ M.lookup "_rev" obj
+  where go = do rev <- couchRev n
                 couchDelete n rev
 
 newtype ArbitraryObject = ArbitraryObject { unArbObject :: A.Object }

test/Database/CouchDB/Enumerator/Test/View.hs

 ) where
 
 import           Control.Monad
-import           Control.Monad.IO.Class (MonadIO)
+import           Control.Monad.IO.Class (MonadIO, liftIO)
 import           Control.Monad.Trans.Reader
 import           Data.Aeson ((.=))
 import qualified Data.Aeson as A
 import qualified Data.Text as T
 
 import Test.Framework (Test, testGroup)
+import Test.QuickCheck (sample', arbitrary)
 
 import Database.CouchDB.Enumerator
 import Database.CouchDB.Enumerator.Test.Util
 
 tests :: Test
 tests = testGroup "Views" [
-      testCouchProperty "basic" (12,13) views
+      --testCouchProperty "basic" (12,13) views
+      testCouchCase "basic" viewCase
     ]
 
 checkEqual :: (Monad m) => [A.Object] -> [A.Object] -> Iteratee a m ()
                   , (BU8.fromString "endkey"  , Just $ BU8.fromString ekey)
                   ]
 
+viewCase :: CouchT IO ()
+viewCase = replicateM_ 20 $ do
+    objs <- liftIO $ sample' arbitrary
+    views objs
+
 views :: [ArbitraryObject] -> CouchT IO ()
 views lst = do
     let (group1,x1) = splitAt 3 lst