summaryrefslogtreecommitdiff
path: root/test/Test/Data/HashTable/ST/Swiss.hs
blob: 65dfe34cd6abd42a3cab08649e399cfb02fe087a (plain)
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
module Test.Data.HashTable.ST.Swiss where

import           Prelude                  hiding (lookup)

import           Control.Monad
import           Data.HashTable.IO.Swiss  hiding (foldM, mapM_)
import qualified Data.HashTable.IO.Swiss  as S
import           Test.Tasty
import           Test.Tasty.HUnit

import           Control.Monad.ST         (stToIO)
import           Data.List                (sort)
import           Data.Primitive.Array     as A
import           Data.Primitive.PrimArray
import           Test.QuickCheck          (Gen, generate, vector)


unit_insertAndLookup :: IO ()
unit_insertAndLookup = do
  let ks = ["A", "Z", "C", "Y", "E", "X", "G", "W"]
  ref <- new
  mapM_ (\k -> insert ref k k) ks
  forM_ ks $ \k -> do
    h <- lookup ref k
    Just k @=? h

unit_insertAndLookup_rand :: IO ()
unit_insertAndLookup_rand = do
  ks <- generate (vector 1000 :: Gen [Int])
  ref <- new
  mapM_ (\k -> insert ref k k) ks
  forM_ ks $ \k -> do
    h <- lookup ref k
    Just k @=? h

unit_insert_conflict :: IO ()
unit_insert_conflict = do
  let ks = ["head", "Z", "C", "last"]
  t <- newSized 8
  mapM_ (\x -> insert' h t x x) ks
  forM_ ks $ \k -> do
    h <- lookup' h t k
    Just k @=? h
 where
   h = const 0

unit_insert_right_overflow :: IO ()
unit_insert_right_overflow = do
  let ks = ["head", "Z", "C", "last"]
  t <- newSized 8
  mapM_ (\x -> insert' h t x x) ks
  forM_ ks $ \k -> do
    h <- lookup' h t k
    Just k @=? h
 where
   h = const 7

-- 一旦deleteでごまかす
-- vのswapできるようにすべき
unit_update :: IO ()
unit_update = do
  let ks = replicate 5 "A"
  t <- newSized 4
  mapM_ (\x -> insert t x x) ks
  s <- getSize t
  4 @=? s

unit_lookup_nothing_conflict :: IO ()
unit_lookup_nothing_conflict = do
  let ks = ["A", "B", "C", "D"]
  t <- new
  mapM_ (\x -> insert' h t x x) ks
  h <- lookup' h t "X"
  h @=? Nothing
 where
   h = const 7

unit_lookup_nothing :: IO ()
unit_lookup_nothing = do
  let ks = ["A", "B", "C", "D"]
  t <- new
  mapM_ (\x -> insert t x x) ks
  h <- lookup t "X"
  h @=? Nothing

unit_grow_rehash :: IO ()
unit_grow_rehash = do
  let ks = ["A","Z", "C", "Y", "E", "X", "G", "W", "ab", "cd", "ef", "gh", "xx"]
  t <- newSized 8
  mapM_ (\k -> insert t k k) ks
  forM_ ks $ \k -> do
    h <- lookup t k
    Just k @=? h

unit_grow_rehash2 :: IO ()
unit_grow_rehash2 = do
  let ks = [0..99::Int]
  t <- newSized 8
  mapM_ (\k -> insert t k k) ks
  forM_ ks $ \k -> do
    h <- lookup t k
    Just k @=? h

unit_delete :: IO ()
unit_delete = do
  let ks = ["A","B", "C"]
  t <- new
  mapM_ (\k -> insert t k k) ks
  delete t "B"
  h <- lookup t "B"
  h @=? Nothing
  h <- lookup t "C"
  h @=? Just "C"

unit_foldM :: IO ()
unit_foldM = do
  let ks = ["A","B", "C"]
  t <- new
  mapM_ (\k -> insert t k k) ks
  x <- S.foldM (\acc (k, _) -> pure (acc ++ k)) "" t
  sort "ABC" @=? sort x

unit_mutate :: IO ()
unit_mutate = do
  let ks = ["A","B", "C"]
  t <- new
  mapM_ (\k -> insert t k k) ks
  mutate t "A" (\(Just v) -> (Just (v ++ "!"), ()))
  mutate t "B" (const (Nothing, ()))
  a <- lookup t "A"
  Just "A!" @=? a
  a <- lookup t "B"
  Nothing @=? a