~singpolyma/tokyocabinet-haskell

ref: e9f3640cc37d0d23d4bac890f419f760f3b3c810 tokyocabinet-haskell/tests/ADBTest.hs -rw-r--r-- 5.3 KiB
e9f3640c — tom.lpsd Added tests for ADB 11 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
module Main where

import Test.HUnit hiding (path)
import TestUtil
import Database.TokyoCabinet.ADB

import Data.Maybe (catMaybes)
import Data.List (sort)
import Control.Monad

dbname :: String
dbname = "+"

withOpenedADB :: String -> (ADB -> IO a) -> IO a
withOpenedADB name action = do
  a <- new
  open a name
  res <- action a
  close a
  return res

test_new_delete = new >>= delete

test_open_close =
    do adb <- new
       not `fmap` open adb "foo.tch#mode=r" @? "file does not exist"
       open adb "+" @? "open"
       close adb @? "close"
       not `fmap` close adb @? "cannot close closed file"

test_putxx =
    do withOpenedADB dbname $ \adb -> do
         put adb "foo" "bar"
         get adb "foo" >>= (Just "bar" @=?)
         putkeep adb "foo" "baz"
         get adb "foo" >>= (Just "bar" @=?)
         putcat adb "foo" "baz"
         get adb "foo" >>= (Just "barbaz" @=?)

test_out =
    do withOpenedADB dbname $ \adb -> do
         put adb "foo" "bar"
         get adb "foo" >>= (Just "bar" @=?)
         out adb "foo" @? "out succeeded"
         get adb "foo" >>= ((Nothing :: Maybe String) @=?)

test_put_get =
    do withOpenedADB dbname $ \adb -> do
         put adb "1" "foo"
         put adb "2" "bar"
         put adb "3" "baz"
         get adb "1" >>= (Just "foo" @=?)
         get adb "2" >>= (Just "bar" @=?)
         get adb "3" >>= (Just "baz" @=?)

test_vsiz =
    do withOpenedADB dbname $ \adb -> do
         put adb "foo" "bar"
         vsiz adb "foo" >>= (Just 3 @=?)
         vsiz adb "bar" >>= ((Nothing :: Maybe Int) @=?)

test_iterate =
    do withOpenedADB dbname $ \adb -> do
         let keys = [1, 2, 3] :: [Int]
             vals = ["foo", "bar", "baz"]
         zipWithM_ (put adb) keys vals
         iterinit adb
         keys' <- sequence $ replicate (length keys) (iternext adb)
         (sort $ catMaybes keys') @?= (sort keys)

test_fwmkeys =
    do withOpenedADB dbname $ \adb -> do
         mapM_ (uncurry (put adb)) ([ ("foo", 100)
                                    , ("bar", 200)
                                    , ("baz", 201)
                                    , ("jkl", 300)] :: [(String, Int)])
         fwmkeys adb "ba" 10 >>= (["bar", "baz"] @=?) . sort
         fwmkeys adb "ba" 1 >>= (["bar"] @=?)
         fwmkeys adb "" 10 >>= (["bar", "baz", "foo", "jkl"] @=?) . sort

test_addint =
    do withOpenedADB dbname $ \adb -> do
         let ini = 32 :: Int
         put adb "foo" ini
         get adb "foo" >>= (Just ini @=?)
         addint adb "foo" 3
         get adb "foo" >>= (Just (ini+3) @=?)
         addint adb "bar" 1 >>= (Just 1 @=?)
         put adb "bar" "foo"
         addint adb "bar" 1 >>= (Nothing @=?)

test_adddouble =
    do withOpenedADB dbname $ \adb -> do
         let ini = 0.003 :: Double
         put adb "foo" ini
         get adb "foo" >>= (Just ini @=?)
         adddouble adb "foo" 0.3
         (get adb "foo" >>= (isIn (ini+0.3))) @? "isIn"
         adddouble adb "bar" 0.5 >>= (Just 0.5 @=?)
         put adb "bar" "foo"
         adddouble adb "bar" 1.2 >>= (Nothing @=?)
    where
      margin = 1e-30
      isIn :: Double -> (Maybe Double) -> IO Bool
      isIn expected (Just actual) =
          let diff = expected - actual
          in return $ abs diff <= margin

test_vanish =
    withOpenedADB dbname $ \adb -> do
      put adb "foo" "111"
      put adb "bar" "222"
      put adb "baz" "333"
      rnum adb >>= (3 @=?)
      vanish adb
      rnum adb >>= (0 @=?)

test_copy =
   withoutFile "bar.tch" $ \fnd ->
        withOpenedADB dbname $ \adb -> do
          put adb "foo" "bar"
          copy adb fnd
          close adb
          open adb fnd
          get adb "foo" >>= (Just "bar" @=?)

test_txn =
    withoutFile "foo.tcb" $ \fn ->
        withOpenedADB fn $ \adb -> do
          tranbegin adb @? "tranbegin"
          put adb "foo" "bar"
          get adb "foo" >>= (Just "bar" @=?)
          tranabort adb @? "tranabort"
          get adb "foo" >>= ((Nothing :: Maybe String) @=?)
          tranbegin adb @? "tranbegin2"
          put adb "foo" "baz"
          get adb "foo" >>= (Just "baz" @=?)
          trancommit adb @? "trancommit"
          get adb "foo" >>= (Just "baz" @=?)

test_path =
    withOpenedADB dbname $ \adb ->
        path adb >>= (Just dbname @=?)

test_util =
    do adb <- new
       open adb dbname
       put adb "foo" "bar"
       path adb >>= (Just dbname @=?)
       rnum adb >>= (1 @=?)
       ((> 0) `fmap` size adb) @? "size"
       sync adb @? "sync"
       optimize adb "capnum=1000" @? "optimize"
       close adb

test_misc =
    withoutFile "foo.tct" $ \fn ->
        withOpenedADB fn $ \adb -> do
          misc adb "put" ["1", "foo", "100", "bar", "200"] >>= (([] :: String) @=?)
          misc adb "get" ["1"] >>= (["foo", "100", "bar", "200"] @=?)

tests = test [
          "new delete" ~: test_new_delete
        , "open close"  ~: test_open_close
        , "put get" ~: test_put_get
        , "out" ~: test_out
        , "putxx" ~: test_putxx
        , "copy" ~: test_copy
        , "transaction" ~: test_txn
        , "fwmkeys" ~: test_fwmkeys
        , "path" ~: test_path
        , "addint" ~: test_addint
        , "adddouble" ~: test_adddouble
        , "util" ~: test_util
        , "vsiz" ~: test_vsiz
        , "vanish" ~: test_vanish
        , "iterate" ~: test_iterate
        , "misc" ~: test_misc
        ]

main = runTestTT tests