(* 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))