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
|
type _ key =
| I : int key
| S : string key
let pp_m : type a . Format.formatter -> a key -> a -> unit = fun ppf k v ->
match k, v with
| I, x -> Fmt.pf ppf "I %d" x
| S, s -> Fmt.pf ppf "S %s" s
let eq_m : type a. a key -> a -> a -> bool = fun k v v' ->
match k, v, v' with
| I, x, y -> x = y
| S, s, t -> String.equal s t
module K = struct
type 'a t = 'a key
let compare : type a b. a t -> b t -> (a, b) Gmap.Order.t = fun t t' ->
let open Gmap.Order in
match t, t' with
| I, I -> Eq | I, _ -> Lt | _, I -> Gt
| S, S -> Eq
end
module M = Gmap.Make(K)
let m_check =
let module M = struct
type t = M.t
let pp ppf m = M.iter (fun (M.B (k, v)) -> pp_m ppf k v) m
let equal a b = M.equal { f = eq_m } a b
end in
(module M: Alcotest.TESTABLE with type t = M.t)
let b_check =
let module M = struct
type t = M.b
let pp ppf (M.B (k, v)) = pp_m ppf k v
let equal (M.B (k, v)) (M.B (k', v')) = match K.compare k k' with
| Gmap.Order.Eq -> eq_m k v v'
| _ -> false
end in
(module M: Alcotest.TESTABLE with type t = M.t)
let empty () =
Alcotest.(check bool "empty map is empty" true (M.is_empty M.empty));
Alcotest.(check bool "mem on empty map doesn't have A" false (M.mem I M.empty));
Alcotest.(check (option int) "find on empty map doesn't have A" None
(M.find I M.empty));
Alcotest.(check (option string) "find on empty map doesn't have B" None
(M.find S M.empty));
Alcotest.(check (option b_check) "min binding is none" None
(M.min_binding M.empty));
Alcotest.(check (option b_check) "max binding is none" None
(M.max_binding M.empty));
Alcotest.(check (option b_check) "any binding is none" None
(M.any_binding M.empty));
Alcotest.(check (list b_check) "bindings is empty" []
(M.bindings M.empty))
let basic () =
let m = M.singleton I 5 in
Alcotest.(check bool "non-empty map is not empty" false (M.is_empty m));
Alcotest.(check int "non-empty map has cardinal 1" 1 (M.cardinal m));
Alcotest.(check bool "non-empty map has member I" true (M.mem I m));
Alcotest.(check (option int) "non-empty map finds I" (Some 5) (M.find I m));
Alcotest.check m_check "singleton and add are equivalent" m (M.add I 5 M.empty);
Alcotest.(check bool "removing I from map makes it empty" true
(M.is_empty (M.remove I m)));
Alcotest.(check bool "removing S from map makes it not empty" false
(M.is_empty (M.remove S m)));
Alcotest.check m_check "add overwrites" (M.singleton I 10) (M.add I 10 m);
Alcotest.(check (option m_check) "add_unless_bound does not overwrite" None
(M.add_unless_bound I 10 m));
Alcotest.check m_check "update updates" (M.singleton I 20)
(M.update I (fun _ -> Some 20) m);
Alcotest.(check (option b_check) "min_binding is I 5" (Some (M.B (I, 5)))
(M.min_binding m));
Alcotest.(check (option b_check) "max_binding is I 5" (Some (M.B (I, 5)))
(M.max_binding m));
Alcotest.(check (option b_check) "any_binding is I 5" (Some (M.B (I, 5)))
(M.any_binding m));
Alcotest.(check (list b_check) "bindings is [ I 5 ]" [ M.B (I, 5) ]
(M.bindings m))
let bad_eq_false : type a. a key -> a -> a -> bool = fun _ _ _ -> false
let bad_eq_true : type a. a key -> a -> a -> bool = fun _ _ _ -> true
let eq () =
let m = M.singleton I 5 in
Alcotest.(check bool "m equal is ok" true (M.equal { f = eq_m } m m));
Alcotest.(check bool "m equal is ok with singleton" true
(M.equal { f = eq_m } m (M.singleton I 5)));
Alcotest.(check bool "m equal is false" false
(M.equal { f = eq_m } m M.empty));
Alcotest.(check bool "m equal is false" false
(M.equal { f = eq_m } m (M.singleton S "foo")));
Alcotest.(check bool "m equal is false" false
(M.equal { f = eq_m } m (M.singleton I 10)));
Alcotest.(check bool "m equal is false" false
(M.equal { f = eq_m } m (M.add S "foo" (M.singleton I 10))));
Alcotest.(check bool "m bad equal is always false" false
(M.equal { f = bad_eq_false } m m));
Alcotest.(check bool "m bad equal is always true" true
(M.equal { f = bad_eq_true } m m))
let preds () =
let m = M.singleton I 5 in
let m' = M.add S "foobar" m in
let m'' = M.singleton I 10 in
let p (M.B (k, v)) = match k with I -> v = 5 | _ -> false in
Alcotest.(check bool "for_all works" true (M.for_all p m));
Alcotest.(check bool "for_all works m'" false (M.for_all p m'));
Alcotest.(check bool "for_all works m''" false (M.for_all p m''));
Alcotest.(check bool "exists works" true (M.exists p m));
Alcotest.(check bool "exists works m'" true (M.exists p m'));
Alcotest.(check bool "exists works m''" false (M.exists p m''));
Alcotest.check m_check "filter works" m (M.filter p m);
Alcotest.check m_check "filter works m'" m (M.filter p m');
Alcotest.check m_check "filter works m''" M.empty (M.filter p m'')
let map () =
let m = M.singleton I 5 in
let map : type a . a key -> a -> a = fun k _v ->
match k with
| I -> 100
| S -> "Foo"
in
Alcotest.check m_check "mapped m is equal as expected"
(M.singleton I 100) (M.map { f = map } m);
Alcotest.check m_check "mapped m is equal as expected"
(M.add S "Foo" (M.singleton I 100))
(M.map { f = map } (M.add S "barf" m))
let l_wins : type a . a key -> a -> a -> a option = fun _ v _ -> Some v
let r_wins : type a . a key -> a -> a -> a option = fun _ _ v' -> Some v'
let no_wins : type a . a key -> a -> a -> a option = fun _ _ _ -> None
let union () =
let m = M.add I 100 (M.singleton S "foo") in
Alcotest.check m_check "union map left wins is good" m
(M.union { f = l_wins } m (M.singleton S "bar"));
Alcotest.check m_check "union map right wins is good"
(M.add I 100 (M.singleton S "bar"))
(M.union { f = r_wins } m (M.singleton S "bar"));
Alcotest.check m_check "union map right wins is good"
(M.singleton I 100)
(M.union { f = no_wins } m (M.singleton S "bar"))
let tests = [
"empty gmap", `Quick, empty ;
"basic gmap", `Quick, basic ;
"equality", `Quick, eq ;
"predicates", `Quick, preds ;
"map", `Quick, map ;
"union", `Quick, union ;
]
let () = Alcotest.run "gmap tests" [ "gmap suite", tests ]
|
