File: testset.ml

package info (click to toggle)
js-of-ocaml 5.9.1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 32,020 kB
  • sloc: ml: 91,250; javascript: 57,289; ansic: 315; makefile: 271; lisp: 23; sh: 6; perl: 4
file content (285 lines) | stat: -rw-r--r-- 7,736 bytes parent folder | download | duplicates (2)
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
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
(* TEST
*)

module S = Set.Make(struct type t = int let compare (x:t) y = compare x y end)

let testvals = [0;1;2;3;4;5;6;7;8;9]

let check msg cond =
  if not (List.for_all cond testvals) then
    Printf.printf "Test %s FAILED\n%!" msg

let checkbool msg b =
  if not b then
    Printf.printf "Test %s FAILED\n%!" msg

let normalize_cmp c =
  if c = 0 then 0 else if c > 0 then 1 else -1

let test x s1 s2 =

  checkbool "is_empty"
    (S.is_empty s1 = List.for_all (fun i -> not (S.mem i s1)) testvals);

  check "add"
    (let s = S.add x s1 in
     fun i -> S.mem i s = (S.mem i s1 || i = x));

  check "singleton"
    (let s = S.singleton x in
     fun i -> S.mem i s = (i = x));

  check "remove"
    (let s = S.remove x s1 in
     fun i -> S.mem i s = (S.mem i s1 && i <> x));

  check "union"
    (let s = S.union s1 s2 in
     fun i -> S.mem i s = (S.mem i s1 || S.mem i s2));

  check "inter"
    (let s = S.inter s1 s2 in
     fun i -> S.mem i s = (S.mem i s1 && S.mem i s2));

  checkbool "disjoint"
    (S.is_empty (S.inter s1 s2) = S.disjoint s1 s2);

  check "diff"
    (let s = S.diff s1 s2 in
     fun i -> S.mem i s = (S.mem i s1 && not (S.mem i s2)));

  checkbool "elements"
    (S.elements s1 = List.filter (fun i -> S.mem i s1) testvals);

  checkbool "compare"
    (normalize_cmp (S.compare s1 s2)
     = normalize_cmp (compare (S.elements s1) (S.elements s2)));

  checkbool "equal"
    (S.equal s1 s2 = (S.elements s1 = S.elements s2));

  check "subset"
    (let b = S.subset s1 s2 in
     fun i -> if b && S.mem i s1 then S.mem i s2 else true);

  checkbool "subset2"
    (let b = S.subset s1 s2 in
     b || not (S.is_empty (S.diff s1 s2)));

  checkbool "map"
    (S.elements (S.map succ s1) = List.map succ (S.elements s1));

  checkbool "map2"
    (S.map (fun x -> x) s1 == s1);

  checkbool "map3"
    ((* check that the traversal is made in increasing element order *)
     let last = ref min_int in
     S.map (fun x -> assert (!last <= x); last := x; x) s1 == s1);

  checkbool "for_all"
    (let p x = x mod 2 = 0 in
     S.for_all p s1 = List.for_all p (S.elements s1));

  checkbool "exists"
    (let p x = x mod 3 = 0 in
     S.exists p s1 = List.exists p (S.elements s1));

  checkbool "filter"
    (let p x = x >= 3 && x <= 6 in
     S.elements(S.filter p s1) = List.filter p (S.elements s1));

  checkbool "filter_map"
    (let f x = if x >= 3 && x <= 6 then Some (2 * x) else None in
     S.elements(S.filter_map f s1) = List.filter_map f (S.elements s1));

  checkbool "filter_map(==)"
    (let f x = Some x in
     S.filter_map f s1 == s1);

  checkbool "partition"
    (let p x = x >= 3 && x <= 6 in
     let (st,sf) = S.partition p s1
     and (lt,lf) = List.partition p (S.elements s1) in
     S.elements st = lt && S.elements sf = lf);

  checkbool "cardinal"
    (S.cardinal s1 = List.length (S.elements s1));

  checkbool "min_elt"
    (try
       let m = S.min_elt s1 in
       S.mem m s1 && S.for_all (fun i -> m <= i) s1
     with Not_found ->
       S.is_empty s1);

  checkbool "max_elt"
    (try
       let m = S.max_elt s1 in
       S.mem m s1 && S.for_all (fun i -> m >= i) s1
     with Not_found ->
       S.is_empty s1);

  checkbool "choose"
    (try
       let x = S.choose s1 in S.mem x s1
     with Not_found ->
       S.is_empty s1);

  checkbool "find_first"
    (let (l, p, r) = S.split x s1 in
    if not p && S.is_empty r then
      try
        let _ = S.find_first (fun k -> k >= x) s1 in
        false
      with Not_found ->
        true
    else
      let e = S.find_first (fun k -> k >= x) s1 in
      if p then
        e = x
      else
        e = S.min_elt r);

  checkbool "find_first_opt"
    (let (l, p, r) = S.split x s1 in
    let find_first_opt_result = S.find_first_opt (fun k -> k >= x) s1 in
    if not p && S.is_empty r then
      match find_first_opt_result with
        None -> true
      | _ -> false
    else
      (match find_first_opt_result with
      | None -> false
      | Some e -> if p then e = x else e = S.min_elt r));

  checkbool "find_last"
    (let (l, p, r) = S.split x s1 in
    if not p && S.is_empty l then
      try
        let _ = S.find_last (fun k -> k <= x) s1 in
        false
      with Not_found ->
        true
    else
      let e = S.find_last (fun k -> k <= x) s1 in
      if p then
        e = x
      else
        e = S.max_elt l);

  checkbool "find_last_opt"
    (let (l, p, r) = S.split x s1 in
    let find_last_opt_result = S.find_last_opt (fun k -> k <= x) s1 in
    if not p && S.is_empty l then
      match find_last_opt_result with
        None -> true
      | _ -> false
    else
      (match find_last_opt_result with
      | None -> false
      | Some e -> if p then e = x else e = S.max_elt l));

  check "split"
    (let (l, p, r) = S.split x s1 in
     fun i ->
       if i < x then S.mem i l = S.mem i s1
       else if i > x then S.mem i r = S.mem i s1
       else p = S.mem i s1);

  checkbool "to_seq_of_seq"
    (S.equal s1 (S.of_seq @@ S.to_seq s1));

  checkbool "to_seq_of_seq"
    (S.equal s1 (S.of_seq @@ S.to_rev_seq s1));

  checkbool "to_seq_from"
    (let seq = S.to_seq_from x s1 in
     let ok1 = List.of_seq seq |> List.for_all (fun y -> y >= x) in
     let ok2 =
       (S.elements s1 |> List.filter (fun y -> y >= x))
       =
       (List.of_seq seq)
     in
     ok1 && ok2);

  checkbool "to_seq_increasing"
    (let seq = S.to_seq s1 in
     let last = ref min_int in
     Seq.iter (fun x -> assert (!last <= x); last := x) seq;
     true);

  checkbool "to_rev_seq_decreasing"
    (let seq = S.to_rev_seq s1 in
     let last = ref max_int in
     Seq.iter (fun x -> assert (x <= !last); last := x) seq;
     true);

  ()

let relt() = Random.int 10

let rset() =
  let s = ref S.empty in
  for i = 1 to Random.int 10 do s := S.add (relt()) !s done;
  !s

let _ =
  Random.init 42;
  for i = 1 to 10000 do test (relt()) (rset()) (rset()) done

let () =
  (* #6645: check that adding an element to set that already contains
     it doesn't allocate and return the original set. *)
  let s1 = ref S.empty in
  for i = 1 to 10 do s1 := S.add i !s1 done;
  let s2 = ref !s1 in

  let a0 = Gc.allocated_bytes () in
  let a1 = Gc.allocated_bytes () in
  for i = 1 to 10 do s2 := S.add i !s2 done;
  let a2 = Gc.allocated_bytes () in

  assert (!s2 == !s1);
  assert(a2 -. a1 = a1 -. a0)

let () =
  (* check that removing an element from a set that is not present in this set
     (1) doesn't allocate and (2) return the original set *)
  let s1 = ref S.empty in
  for i = 1 to 10 do s1 := S.add i !s1 done;
  let s2 = ref !s1 in

  let a0 = Gc.allocated_bytes () in
  let a1 = Gc.allocated_bytes () in
  for i = 11 to 30 do s2 := S.remove i !s2 done;
  let a2 = Gc.allocated_bytes () in

  assert (!s2 == !s1);
  assert(a2 -. a1 = a1 -. a0)

let () =
  (* check that filtering a set where all elements are satisfied by
     the given predicate return the original set *)
  let s1 = ref S.empty in
  for i = 1 to 10 do s1 := S.add i !s1 done;
  let s2 = S.filter (fun e -> e >= 0) !s1 in
  assert (s2 == !s1)

let valid_structure s =
  (* this test should return 'true' for all set,
     but it can detect sets that are ill-structured,
     for example incorrectly ordered, as the S.mem
     function will make assumptions about the set ordering.

     (This trick was used to exhibit the bug in PR#7403)
  *)
  List.for_all (fun n -> S.mem n s) (S.elements s)

let () =
  (* PR#7403: map buggily orders elements according to the input
     set order, not the output set order. Mapping functions that
     change the value ordering thus break the set structure. *)
  let test = S.of_list [1; 3; 5] in
  let f = function 3 -> 8 | n -> n in
  assert (valid_structure (S.map f test))