module Main where
import Test.HUnit hiding (path)
import TestUtil
import System.Directory
import Database.TokyoCabinet.TDB
dbname :: String
dbname = "foo.tct"
withOpenedTDB :: String -> (TDB -> IO a) -> IO ()
withOpenedTDB name action = do
h <- new
open h name [OWRITER, OCREAT]
action h
close h
return ()
test_ecode =
withoutFile dbname $ \fn -> do
h <- new
open h fn [OREADER]
ecode h >>= (ENOFILE @=?)
test_new_delete = do
tdb <- new
delete tdb
test_open_close =
withoutFile dbname $ \fn -> do
tdb <- new
not `fmap` open tdb fn [OREADER] @? "file does not exist"
open tdb fn [OWRITER, OCREAT] @? "open"
close tdb @? "close"
not `fmap` close tdb @? "cannot close closed file"
test_util =
withoutFile dbname $ \fn -> do
tdb <- new
setcache tdb 10000 4096 512 @? "setcache"
setxmsiz tdb 67108864 @? "setxmsiz"
tune tdb 100000 (-1) (-1) [TLARGE, TBZIP] @? "tune"
open tdb fn [OWRITER, OCREAT] @? "open"
path tdb >>= (Just fn @=?)
rnum tdb >>= (0 @=?)
((> 0) `fmap` fsiz tdb) @? "fsiz"
sync tdb @? "sync"
optimize tdb 0 0 0 [] @? "optimize"
close tdb
samples :: [ (String, AssocList String String) ]
samples = [ ("1", AssocList [("foo", "1"), ("bar", "2")])
, ("2", AssocList [("foo", "1"), ("bar", "3")])
, ("3", AssocList [("foo", "2"), ("bar", "1")]) ]
samples' :: [(String, String)]
samples' = [ ("1", "foo\0" ++ "1\0bar\0" ++ "2")
, ("2", "foo\0" ++ "1\0bar\0" ++ "3")
, ("3", "foo\0" ++ "2\0bar\0" ++ "1") ]
test_put =
withoutFile dbname $ \fn -> do
withOpenedTDB fn $ \tdb ->
do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"
get tdb "1" >>= (hd @=?)
putkeep tdb "4" (AssocList [("foo", "10"), ("bar", "20")]) @? "putkeep"
putkeep tdb "1" (AssocList [("foo", "10"), ("bar", "20")])
get tdb "1" >>= (hd @=?)
putcat tdb "1" (AssocList [("baz", "3")]) @? "putcat"
get tdb "1" >>= (AssocList [("foo", "1"), ("bar", "2"), ("baz", "3")] @=?)
where
hd = snd (head samples)
test_put' =
withoutFile dbname $ \fn -> do
withOpenedTDB fn $ \tdb ->
do all id `fmap` mapM (uncurry $ put' tdb) samples' @? "put'"
get' tdb "1" >>= (Just hd @=?)
putkeep' tdb "4" ("foo\0" ++ "10\0bar\0" ++ "20") @? "putkeep'"
putkeep' tdb "1" ("foo\0" ++ "10\0bar\0" ++ "20")
get' tdb "1" >>= (Just hd @=?)
putcat' tdb "1" ("baz\0" ++ "3") @? "putcat'"
get' tdb "1" >>= (Just ("foo\0" ++ "1\0bar\0" ++ "2\0baz\0" ++ "3") @=?)
where
hd = snd (head samples')
test_out =
withoutFile dbname $ \fn -> do
withOpenedTDB fn $ \tdb ->
do put tdb "1" (AssocList [("foo", "100"), ("bar", "200")]) @? "put"
get tdb "1" >>= (AssocList [("foo", "100"), ("bar", "200")] @=?)
out tdb "1" @? "out"
get tdb "1" >>= (AssocList ([] :: [(String, String)]) @=?)
test_txn =
withoutFile dbname $ \fn ->
withOpenedTDB fn $ \tdb -> do
let sample = AssocList [("foo", "100"), ("bar", "200")]
empty = AssocList [] :: AssocList String String
tranbegin tdb
put tdb "1" sample
get tdb "1" >>= (sample @=?)
tranabort tdb
get tdb "1" >>= (empty @=?)
tranbegin tdb
put tdb "1" sample
get tdb "1" >>= (sample @=?)
trancommit tdb
get tdb "1" >>= (sample @=?)
test_iter =
withoutFile dbname $ \fn ->
withOpenedTDB fn $ \tdb ->
do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"
iterinit tdb @? "iterinit"
iternext tdb >>= (Just "1" @=?)
iternext tdb >>= (Just "2" @=?)
iternext tdb >>= (Just "3" @=?)
iternext tdb >>= ((Nothing :: Maybe String) @=?)
test_vanish =
withoutFile dbname $ \fn ->
withOpenedTDB fn $ \tdb ->
do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"
get tdb "1" >>= (snd (head samples) @=?)
vanish tdb
get tdb "1" >>= ((AssocList [] :: AssocList String String) @=?)
test_copy =
withoutFile dbname $ \fns ->
withoutFile "bar.tcb" $ \fnd ->
withOpenedTDB fns $ \tdb ->
do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"
copy tdb fnd @? "copy"
close tdb
open tdb fnd [OREADER]
get tdb "1" >>= (snd (head samples) @=?)
test_vsiz =
withoutFile dbname $ \fn ->
withOpenedTDB fn $ \tdb ->
do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"
vsiz tdb "1" >>= (Just 12 @=?)
vsiz tdb "10" >>= (Nothing @=?)
test_add =
withoutFile dbname $ \fn ->
withOpenedTDB fn $ \tdb ->
do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"
addint tdb "1" 1 >>= (Just 1 @=?)
addint tdb "1" 1 >>= (Just 2 @=?)
v <- get tdb "1"
lookup "_num" (unAssocList v) @?= Just "2"
adddouble tdb "2" 1.2 >>= (Just 1.2 @=?)
adddouble tdb "2" 1.2 >>= (Just 2.4 @=?)
v <- get tdb "2"
lookup "_num" (unAssocList v) @?= Just "2.4"
test_fwmkeys =
withoutFile dbname $ \fn ->
withOpenedTDB fn $ \tdb ->
do put tdb "foo" (AssocList [("foo", "100")])
put tdb "bar" (AssocList [("foo", "100")])
put tdb "baz" (AssocList [("foo", "100")])
fwmkeys tdb "ba" 10 >>= (["bar", "baz"] @=?)
fwmkeys tdb "bak" 10 >>= (([] :: [String]) @=?)
fwmkeys tdb "" 2 >>= (["foo", "bar"] @=?)
test_genuid =
withoutFile dbname $ \fn -> do
tdb <- new
genuid tdb >>= (Nothing @=?)
open tdb fn [OWRITER, OCREAT]
genuid tdb >>= (Just 1 @=?)
close tdb
test_setindex =
withoutFile dbname $ \fn ->
withOpenedTDB fn $ \tdb ->
do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"
withoutFile (dbname ++ ".idx.foo.dec") $ \ifn -> do
setindex tdb "foo" ITDECIMAL
doesFileExist ifn @? "index"
tests = test [
"new delete" ~: test_new_delete
, "ecode" ~: test_ecode
, "open close" ~: test_open_close
, "util" ~: test_util
, "put" ~: test_put
, "put'" ~: test_put'
, "out" ~: test_out
, "transaction" ~: test_txn
, "iterate" ~: test_iter
, "vanish" ~: test_vanish
, "copy" ~: test_copy
, "vsiz" ~: test_vsiz
, "add" ~: test_add
, "fwmkeys" ~: test_fwmkeys
, "genuid" ~: test_genuid
, "setindex" ~: test_setindex
]
main = runTestTT tests