upstream: https://github.com/stedolan/crowbar
1open Crowbar
2
3module Map = Map.Make (struct
4 type t = int
5 let compare (i : int) (j : int) = compare i j
6end)
7
8type t = ((int * int) list * int Map.t)
9
10let check_map ((list, map) : t) =
11 let rec dedup k = function
12 | [] -> []
13 | (k', v') :: rest when k = k' -> dedup k rest
14 | (k', v') :: rest ->
15 (k', v') :: dedup k' rest in
16 let list = match List.stable_sort (fun a b -> compare (fst a) (fst b)) list with
17 | [] -> []
18 | (k, v) :: rest -> (k, v) :: dedup k rest in
19 List.for_all (fun (k, v) -> Map.find k map = v) list &&
20 list = Map.bindings map
21
22let map_gen : t gen = fix (fun map_gen -> choose [
23 const ([], Map.empty);
24 map [uint8; uint8; map_gen] (fun k v (l, m) ->
25 (k, v) :: l, Map.add k v m);
26 map [uint8; uint8] (fun k v ->
27 [k, v], Map.singleton k v);
28 map [uint8; map_gen] (fun k (l, m) ->
29 let rec rem_all k l =
30 let l' = List.remove_assoc k l in
31 if l = l' then l else rem_all k l' in
32 rem_all k l, Map.remove k m);
33 (* merge? *)
34 map [map_gen; map_gen] (fun (l, m) (l', m') ->
35 l @ l', Map.union (fun k a b -> Some a) m m');
36 map [uint8; map_gen] (fun k (list, map) ->
37 let (l, v, r) = Map.split k map in
38 let (l', vr') = List.partition (fun (kx,vx) -> kx < k) list in
39 let r' = List.filter (fun (kx, vx) -> kx <> k) vr' in
40 let v' = match List.assoc k vr' with n -> Some n | exception Not_found -> None in
41 assert (v = v');
42 (l' @ List.map (fun (k,v) -> k,v+42) r',
43 Map.union (fun k a b -> assert false) l (Map.map (fun v -> v + 42) r)))])
44
45let suite =
46 ("map",
47 [
48 test_case "map" [map_gen] @@ fun m ->
49 check (check_map m);
50 ])
51
52let () = run "crowbar" [ suite ]