1module S = Set.Make(struct type t = int let compare (x:t) y = compare x y end)
2
3let testvals = [0;1;2;3;4;5;6;7;8;9]
4
5let check msg cond =
6  if not (List.for_all cond testvals) then
7    Printf.printf "Test %s FAILED\n%!" msg
8
9let checkbool msg b =
10  if not b then
11    Printf.printf "Test %s FAILED\n%!" msg
12
13let normalize_cmp c =
14  if c = 0 then 0 else if c > 0 then 1 else -1
15
16let test x s1 s2 =
17
18  checkbool "is_empty"
19    (S.is_empty s1 = List.for_all (fun i -> not (S.mem i s1)) testvals);
20
21  check "add"
22    (let s = S.add x s1 in
23     fun i -> S.mem i s = (S.mem i s1 || i = x));
24
25  check "singleton"
26    (let s = S.singleton x in
27     fun i -> S.mem i s = (i = x));
28
29  check "remove"
30    (let s = S.remove x s1 in
31     fun i -> S.mem i s = (S.mem i s1 && i <> x));
32
33  check "union"
34    (let s = S.union s1 s2 in
35     fun i -> S.mem i s = (S.mem i s1 || S.mem i s2));
36
37  check "inter"
38    (let s = S.inter s1 s2 in
39     fun i -> S.mem i s = (S.mem i s1 && S.mem i s2));
40
41  check "diff"
42    (let s = S.diff s1 s2 in
43     fun i -> S.mem i s = (S.mem i s1 && not (S.mem i s2)));
44
45  checkbool "elements"
46    (S.elements s1 = List.filter (fun i -> S.mem i s1) testvals);
47
48  checkbool "compare"
49    (normalize_cmp (S.compare s1 s2)
50     = normalize_cmp (compare (S.elements s1) (S.elements s2)));
51
52  checkbool "equal"
53    (S.equal s1 s2 = (S.elements s1 = S.elements s2));
54
55  check "subset"
56    (let b = S.subset s1 s2 in
57     fun i -> if b && S.mem i s1 then S.mem i s2 else true);
58
59  checkbool "subset2"
60    (let b = S.subset s1 s2 in
61     b || not (S.is_empty (S.diff s1 s2)));
62
63  checkbool "map"
64    (S.elements (S.map succ s1) = List.map succ (S.elements s1));
65
66  checkbool "map2"
67    (S.map (fun x -> x) s1 == s1);
68
69  checkbool "map3"
70    ((* check that the traversal is made in increasing element order *)
71     let last = ref min_int in
72     S.map (fun x -> assert (!last <= x); last := x; x) s1 == s1);
73
74  checkbool "for_all"
75    (let p x = x mod 2 = 0 in
76     S.for_all p s1 = List.for_all p (S.elements s1));
77
78  checkbool "exists"
79    (let p x = x mod 3 = 0 in
80     S.exists p s1 = List.exists p (S.elements s1));
81
82  checkbool "filter"
83    (let p x = x >= 3 && x <= 6 in
84     S.elements(S.filter p s1) = List.filter p (S.elements s1));
85
86  checkbool "partition"
87    (let p x = x >= 3 && x <= 6 in
88     let (st,sf) = S.partition p s1
89     and (lt,lf) = List.partition p (S.elements s1) in
90     S.elements st = lt && S.elements sf = lf);
91
92  checkbool "cardinal"
93    (S.cardinal s1 = List.length (S.elements s1));
94
95  checkbool "min_elt"
96    (try
97       let m = S.min_elt s1 in
98       S.mem m s1 && S.for_all (fun i -> m <= i) s1
99     with Not_found ->
100       S.is_empty s1);
101
102  checkbool "max_elt"
103    (try
104       let m = S.max_elt s1 in
105       S.mem m s1 && S.for_all (fun i -> m >= i) s1
106     with Not_found ->
107       S.is_empty s1);
108
109  checkbool "choose"
110    (try
111       let x = S.choose s1 in S.mem x s1
112     with Not_found ->
113       S.is_empty s1);
114
115  checkbool "find_first"
116    (let (l, p, r) = S.split x s1 in
117    if not p && S.is_empty r then
118      try
119        let _ = S.find_first (fun k -> k >= x) s1 in
120        false
121      with Not_found ->
122        true
123    else
124      let e = S.find_first (fun k -> k >= x) s1 in
125      if p then
126        e = x
127      else
128        e = S.min_elt r);
129
130  checkbool "find_first_opt"
131    (let (l, p, r) = S.split x s1 in
132    if not p && S.is_empty r then
133      match S.find_first_opt (fun k -> k >= x) s1 with
134        None -> true
135      | _ -> false
136    else
137      let Some e = S.find_first_opt (fun k -> k >= x) s1 in
138      if p then
139        e = x
140      else
141        e = S.min_elt r);
142
143  checkbool "find_last"
144    (let (l, p, r) = S.split x s1 in
145    if not p && S.is_empty l then
146      try
147        let _ = S.find_last (fun k -> k <= x) s1 in
148        false
149      with Not_found ->
150        true
151    else
152      let e = S.find_last (fun k -> k <= x) s1 in
153      if p then
154        e = x
155      else
156        e = S.max_elt l);
157
158  checkbool "find_last_opt"
159    (let (l, p, r) = S.split x s1 in
160    if not p && S.is_empty l then
161      match S.find_last_opt (fun k -> k <= x) s1 with
162        None -> true
163      | _ -> false
164    else
165      let Some e = S.find_last_opt (fun k -> k <= x) s1 in
166      if p then
167        e = x
168      else
169        e = S.max_elt l);
170
171  check "split"
172    (let (l, p, r) = S.split x s1 in
173     fun i ->
174       if i < x then S.mem i l = S.mem i s1
175       else if i > x then S.mem i r = S.mem i s1
176       else p = S.mem i s1)
177
178let relt() = Random.int 10
179
180let rset() =
181  let s = ref S.empty in
182  for i = 1 to Random.int 10 do s := S.add (relt()) !s done;
183  !s
184
185let _ =
186  Random.init 42;
187  for i = 1 to 10000 do test (relt()) (rset()) (rset()) done
188
189let () =
190  (* #6645: check that adding an element to set that already contains
191     it doesn't allocate and return the original set. *)
192  let s1 = ref S.empty in
193  for i = 1 to 10 do s1 := S.add i !s1 done;
194  let s2 = ref !s1 in
195
196  let a0 = Gc.allocated_bytes () in
197  let a1 = Gc.allocated_bytes () in
198  for i = 1 to 10 do s2 := S.add i !s2 done;
199  let a2 = Gc.allocated_bytes () in
200
201  assert (!s2 == !s1);
202  assert(a2 -. a1 = a1 -. a0)
203
204let () =
205  (* check that removing an element from a set that is not present in this set
206     (1) doesn't allocate and (2) return the original set *)
207  let s1 = ref S.empty in
208  for i = 1 to 10 do s1 := S.add i !s1 done;
209  let s2 = ref !s1 in
210
211  let a0 = Gc.allocated_bytes () in
212  let a1 = Gc.allocated_bytes () in
213  for i = 11 to 30 do s2 := S.remove i !s2 done;
214  let a2 = Gc.allocated_bytes () in
215
216  assert (!s2 == !s1);
217  assert(a2 -. a1 = a1 -. a0)
218
219let () =
220  (* check that filtering a set where all elements are satisfied by
221     the given predicate return the original set *)
222  let s1 = ref S.empty in
223  for i = 1 to 10 do s1 := S.add i !s1 done;
224  let s2 = S.filter (fun e -> e >= 0) !s1 in
225  assert (s2 == !s1)
226
227let valid_structure s =
228  (* this test should return 'true' for all set,
229     but it can detect sets that are ill-structured,
230     for example incorrectly ordered, as the S.mem
231     function will make assumptions about the set ordering.
232
233     (This trick was used to exhibit the bug in PR#7403)
234  *)
235  List.for_all (fun n -> S.mem n s) (S.elements s)
236
237let () =
238  (* PR#7403: map buggily orders elements according to the input
239     set order, not the output set order. Mapping functions that
240     change the value ordering thus break the set structure. *)
241  let test = S.of_list [1; 3; 5] in
242  let f = function 3 -> 8 | n -> n in
243  assert (valid_structure (S.map f test))
244