1579 lines
47 KiB
OCaml
1579 lines
47 KiB
OCaml
(** Comprehensive testing of [Base.Map].
|
|
|
|
This file tests all exports of [Base.Map]. Every time a new export is added, we have
|
|
to add a new definition somewhere here. Every time we add a definition, we should add
|
|
a test unless the definition is untestable (e.g., a module type) or trivial (e.g., a
|
|
module containing only ppx-derived definitions). We should document categories of
|
|
untested definitions, mark them as untested, and keep them separate from definitions
|
|
that need tests. *)
|
|
|
|
open! Base
|
|
open Base_quickcheck
|
|
open Expect_test_helpers_base
|
|
include Functor_intf.Definitions
|
|
|
|
open struct
|
|
(** quickcheck configuration *)
|
|
|
|
let quickcheck_config =
|
|
let test_count =
|
|
(* In js_of_ocaml, quickcheck is slow due to 64-bit arithmetic, and some map
|
|
operations are especially slow due to use of exceptions and exception handlers.
|
|
So on "other" backends, we turn the test count down. *)
|
|
match Sys.backend_type with
|
|
| Native | Bytecode -> 10_000
|
|
| Other _ -> 1_000
|
|
in
|
|
{ Base_quickcheck.Test.default_config with test_count }
|
|
;;
|
|
|
|
let quickcheck_m here m ~f = quickcheck_m here m ~f ~config:quickcheck_config
|
|
end
|
|
|
|
module Instance (Cmp : sig
|
|
type comparator_witness
|
|
|
|
val comparator : (int, comparator_witness) Comparator.t
|
|
end) =
|
|
struct
|
|
module Key = struct
|
|
type t = int [@@deriving quickcheck, sexp_of]
|
|
type comparator_witness = Cmp.comparator_witness
|
|
|
|
let comparator = Cmp.comparator
|
|
let compare = comparator.compare
|
|
let equal = [%compare.equal: t]
|
|
let quickcheck_generator = Base_quickcheck.Generator.small_strictly_positive_int
|
|
|
|
include Comparable.Infix (struct
|
|
type nonrec t = t
|
|
|
|
let compare = compare
|
|
end)
|
|
end
|
|
|
|
type 'a t = 'a Map.M(Key).t [@@deriving equal, sexp_of]
|
|
|
|
let key x = x
|
|
let int x = x
|
|
let tree x = x
|
|
|
|
let quickcheck_generator gen =
|
|
Base_quickcheck.Generator.map_t_m
|
|
(module Key)
|
|
Base_quickcheck.Generator.small_strictly_positive_int
|
|
gen
|
|
;;
|
|
|
|
let quickcheck_observer obs =
|
|
Base_quickcheck.Observer.map_t Base_quickcheck.Observer.int obs
|
|
;;
|
|
|
|
let quickcheck_shrinker shr =
|
|
Base_quickcheck.Shrinker.map_t Base_quickcheck.Shrinker.int shr
|
|
;;
|
|
end
|
|
|
|
(** A functor like [Instance], but for tree types. *)
|
|
module Instance_tree (Cmp : sig
|
|
type comparator_witness
|
|
|
|
val comparator : (int, comparator_witness) Comparator.t
|
|
end) =
|
|
struct
|
|
module M = Instance (Cmp)
|
|
include M
|
|
|
|
type 'a t = (int, 'a, Cmp.comparator_witness) Map.Using_comparator.Tree.t
|
|
|
|
let of_tree tree = Map.Using_comparator.of_tree ~comparator:Cmp.comparator tree
|
|
let to_tree t = Map.Using_comparator.to_tree t
|
|
|
|
let quickcheck_generator gen =
|
|
Base_quickcheck.Generator.map (M.quickcheck_generator gen) ~f:to_tree
|
|
;;
|
|
|
|
let quickcheck_observer obs =
|
|
Base_quickcheck.Observer.unmap (M.quickcheck_observer obs) ~f:of_tree
|
|
;;
|
|
|
|
let quickcheck_shrinker shr =
|
|
Base_quickcheck.Shrinker.map (M.quickcheck_shrinker shr) ~f:to_tree ~f_inverse:of_tree
|
|
;;
|
|
|
|
let equal equal_a = Map.Using_comparator.Tree.equal ~comparator:Cmp.comparator equal_a
|
|
let sexp_of_t sexp_of_a t = M.sexp_of_t sexp_of_a (of_tree t)
|
|
end
|
|
|
|
(** Functor for [List.t] *)
|
|
module Lst (T : sig
|
|
type t [@@deriving equal, sexp_of]
|
|
end) =
|
|
struct
|
|
type t = T.t list [@@deriving equal, sexp_of]
|
|
end
|
|
|
|
(** Functor for [Or_error], ignoring error contents when comparing. *)
|
|
module Ok (T : sig
|
|
type t [@@deriving equal, sexp_of]
|
|
end) =
|
|
struct
|
|
type t = (T.t, (Error.t[@equal.ignore])) Result.t [@@deriving equal, sexp_of]
|
|
end
|
|
|
|
(** Functor for [Option.t] *)
|
|
module Opt (T : sig
|
|
type t [@@deriving equal, sexp_of]
|
|
end) =
|
|
struct
|
|
type t = T.t option [@@deriving equal, sexp_of]
|
|
end
|
|
|
|
(** Functor for pairs of a single type. Random generation frequently generates pairs of
|
|
identical values. *)
|
|
module Pair (T : sig
|
|
type t [@@deriving equal, quickcheck, sexp_of]
|
|
end) =
|
|
struct
|
|
type t = T.t * T.t [@@deriving equal, quickcheck, sexp_of]
|
|
|
|
let quickcheck_generator =
|
|
let open Base_quickcheck.Generator.Let_syntax in
|
|
match%bind Base_quickcheck.Generator.bool with
|
|
| true -> [%generator: t]
|
|
| false ->
|
|
let%map x = [%generator: T.t] in
|
|
x, x
|
|
;;
|
|
end
|
|
|
|
(* Used in [test__*.ml]. *)
|
|
module Test_creators_and_accessors
|
|
(Types : Types)
|
|
(Impl : S with module Types := Types)
|
|
(Instance : Instance with module Types := Types) : S with module Types := Types = struct
|
|
open Instance
|
|
open Impl
|
|
|
|
open struct
|
|
(** Test helpers, not to be exported. *)
|
|
|
|
module Alist = struct
|
|
type t = (Key.t * int) list [@@deriving compare, equal, quickcheck, sexp_of]
|
|
end
|
|
|
|
module Alist_merge = struct
|
|
type t = (Key.t * (int, int) Map.Merge_element.t) list [@@deriving equal, sexp_of]
|
|
end
|
|
|
|
module Alist_multi = struct
|
|
type t = (Key.t * int list) list [@@deriving equal, quickcheck, sexp_of]
|
|
end
|
|
|
|
module Diff = struct
|
|
type t = (Key.t, int) Map.Symmetric_diff_element.t list [@@deriving equal, sexp_of]
|
|
end
|
|
|
|
module Inst = struct
|
|
type t = int Instance.t [@@deriving equal, quickcheck, sexp_of]
|
|
end
|
|
|
|
module Inst_and_key = struct
|
|
type t = Inst.t * Key.t [@@deriving quickcheck, sexp_of]
|
|
end
|
|
|
|
module Inst_and_key_and_data = struct
|
|
type t = Inst.t * Key.t * int [@@deriving quickcheck, sexp_of]
|
|
end
|
|
|
|
module Inst_inst = struct
|
|
type t = Inst.t Instance.t [@@deriving equal, quickcheck, sexp_of]
|
|
end
|
|
|
|
module Inst_pair = struct
|
|
type t = (int * int) Instance.t [@@deriving equal, quickcheck, sexp_of]
|
|
end
|
|
|
|
module Inst_multi = struct
|
|
type t = int list Instance.t [@@deriving equal, quickcheck, sexp_of]
|
|
end
|
|
|
|
module Key_and_data = struct
|
|
type t = Key.t * int [@@deriving equal, sexp_of]
|
|
end
|
|
|
|
module Key_and_data_inst = struct
|
|
type t = (Key.t * int) Instance.t [@@deriving equal, sexp_of]
|
|
end
|
|
|
|
module Key_and_data_inst_multi = struct
|
|
type t = (Key.t * int) list Instance.t [@@deriving equal, sexp_of]
|
|
end
|
|
|
|
module Maybe_bound = struct
|
|
include Maybe_bound
|
|
|
|
type 'a t = 'a Maybe_bound.t =
|
|
| Incl of 'a
|
|
| Excl of 'a
|
|
| Unbounded
|
|
[@@deriving quickcheck, sexp_of]
|
|
end
|
|
|
|
let ok_or_duplicate_key = function
|
|
| `Ok x -> Ok x
|
|
| `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)]
|
|
;;
|
|
end
|
|
|
|
(** creators *)
|
|
|
|
let empty = empty
|
|
let () = require_equal [%here] (module Sexp) [%sexp (create empty : int t)] [%sexp []]
|
|
let singleton = singleton
|
|
|
|
let () =
|
|
require_equal
|
|
[%here]
|
|
(module Sexp)
|
|
[%sexp (create singleton (key 1) 2 : int t)]
|
|
[%sexp [ [ 1; 2 ] ]]
|
|
;;
|
|
|
|
let of_alist = of_alist
|
|
let of_alist_or_error = of_alist_or_error
|
|
let of_alist_exn = of_alist_exn
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun alist ->
|
|
let t_or_error = create of_alist_or_error alist in
|
|
let t_exn = Or_error.try_with (fun () -> create of_alist_exn alist) in
|
|
let t_or_duplicate =
|
|
match create of_alist alist with
|
|
| `Ok t -> Ok t
|
|
| `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)]
|
|
in
|
|
require_equal
|
|
[%here]
|
|
(module Ok (Alist))
|
|
(Or_error.map t_or_error ~f:to_alist)
|
|
(let compare a b = Comparable.lift Key.compare ~f:fst a b in
|
|
if List.contains_dup alist ~compare
|
|
then Or_error.error_string "duplicate"
|
|
else Ok (List.sort alist ~compare));
|
|
require_equal [%here] (module Ok (Inst)) t_exn t_or_error;
|
|
require_equal [%here] (module Ok (Inst)) t_or_duplicate t_or_error)
|
|
;;
|
|
|
|
let of_alist_multi = of_alist_multi
|
|
let of_alist_fold = of_alist_fold
|
|
let of_alist_reduce = of_alist_reduce
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun alist ->
|
|
let t_multi = create of_alist_multi alist in
|
|
let t_fold =
|
|
create of_alist_fold alist ~init:[] ~f:(fun xs x -> x :: xs) |> map ~f:List.rev
|
|
in
|
|
let t_reduce =
|
|
create of_alist_reduce (List.Assoc.map alist ~f:List.return) ~f:(fun x y ->
|
|
x @ y)
|
|
in
|
|
require_equal
|
|
[%here]
|
|
(module Alist_multi)
|
|
(to_alist t_multi)
|
|
(List.Assoc.sort_and_group alist ~compare:Key.compare);
|
|
require_equal [%here] (module Inst_multi) t_fold t_multi;
|
|
require_equal [%here] (module Inst_multi) t_reduce t_multi)
|
|
;;
|
|
|
|
let of_sequence = of_sequence
|
|
let of_sequence_or_error = of_sequence_or_error
|
|
let of_sequence_exn = of_sequence_exn
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun alist ->
|
|
let seq = Sequence.of_list alist in
|
|
let t_or_error = create of_sequence_or_error seq in
|
|
let t_exn = Or_error.try_with (fun () -> create of_sequence_exn seq) in
|
|
let t_or_duplicate =
|
|
match create of_sequence seq with
|
|
| `Ok t -> Ok t
|
|
| `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)]
|
|
in
|
|
let expect = create of_alist_or_error alist in
|
|
require_equal [%here] (module Ok (Inst)) t_or_error expect;
|
|
require_equal [%here] (module Ok (Inst)) t_exn expect;
|
|
require_equal [%here] (module Ok (Inst)) t_or_duplicate expect)
|
|
;;
|
|
|
|
let of_sequence_multi = of_sequence_multi
|
|
let of_sequence_fold = of_sequence_fold
|
|
let of_sequence_reduce = of_sequence_reduce
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun alist ->
|
|
let seq = Sequence.of_list alist in
|
|
let t_multi = create of_sequence_multi seq in
|
|
let t_fold =
|
|
create of_sequence_fold seq ~init:[] ~f:(fun xs x -> x :: xs) |> map ~f:List.rev
|
|
in
|
|
let t_reduce =
|
|
create
|
|
of_sequence_reduce
|
|
(alist |> List.Assoc.map ~f:List.return |> Sequence.of_list)
|
|
~f:(fun x y -> x @ y)
|
|
in
|
|
let expect = create of_alist_multi alist in
|
|
require_equal [%here] (module Inst_multi) t_multi expect;
|
|
require_equal [%here] (module Inst_multi) t_fold expect;
|
|
require_equal [%here] (module Inst_multi) t_reduce expect)
|
|
;;
|
|
|
|
let of_list_with_key = of_list_with_key
|
|
let of_list_with_key_or_error = of_list_with_key_or_error
|
|
let of_list_with_key_exn = of_list_with_key_exn
|
|
let of_list_with_key_multi = of_list_with_key_multi
|
|
let of_list_with_key_fold = of_list_with_key_fold
|
|
let of_list_with_key_reduce = of_list_with_key_reduce
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun list ->
|
|
let alist = List.map list ~f:(fun (key, data) -> key, (key, data)) in
|
|
require_equal
|
|
[%here]
|
|
(module Ok (Key_and_data_inst))
|
|
(create of_list_with_key list ~get_key:fst |> ok_or_duplicate_key)
|
|
(create of_alist alist |> ok_or_duplicate_key);
|
|
require_equal
|
|
[%here]
|
|
(module Ok (Key_and_data_inst))
|
|
(create of_list_with_key_or_error list ~get_key:fst)
|
|
(create of_alist_or_error alist);
|
|
require_equal
|
|
[%here]
|
|
(module Ok (Key_and_data_inst))
|
|
(Or_error.try_with (fun () -> create of_list_with_key_exn list ~get_key:fst))
|
|
(Or_error.try_with (fun () -> create of_alist_exn alist));
|
|
require_equal
|
|
[%here]
|
|
(module Key_and_data_inst_multi)
|
|
(create of_list_with_key_multi list ~get_key:fst)
|
|
(create of_alist_multi alist);
|
|
require_equal
|
|
[%here]
|
|
(module Key_and_data_inst_multi)
|
|
(create of_list_with_key_fold list ~get_key:fst ~init:[] ~f:(fun acc x ->
|
|
x :: acc)
|
|
|> map ~f:List.rev)
|
|
(create of_alist_multi alist);
|
|
require_equal
|
|
[%here]
|
|
(module Key_and_data_inst_multi)
|
|
(create
|
|
of_list_with_key_reduce
|
|
(List.map list ~f:List.return)
|
|
~get_key:(fun x -> x |> List.hd_exn |> fst)
|
|
~f:(fun x y -> x @ y))
|
|
(create of_alist_multi alist))
|
|
;;
|
|
|
|
let of_increasing_sequence = of_increasing_sequence
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun alist ->
|
|
let seq = Sequence.of_list alist in
|
|
let actual = create of_increasing_sequence seq in
|
|
let expect =
|
|
if List.is_sorted alist ~compare:(fun a b ->
|
|
Comparable.lift Key.compare ~f:fst a b)
|
|
then create of_alist_or_error alist
|
|
else Or_error.error_string "decreasing keys"
|
|
in
|
|
require_equal [%here] (module Ok (Inst)) actual expect)
|
|
;;
|
|
|
|
let of_sorted_array = of_sorted_array
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun alist ->
|
|
let actual = create of_sorted_array (Array.of_list alist) in
|
|
let expect =
|
|
let compare a b = Comparable.lift Key.compare ~f:fst a b in
|
|
if List.is_sorted_strictly ~compare alist
|
|
|| List.is_sorted_strictly ~compare (List.rev alist)
|
|
then create of_alist_or_error alist
|
|
else Or_error.error_string "unsorted"
|
|
in
|
|
require_equal [%here] (module Ok (Inst)) actual expect)
|
|
;;
|
|
|
|
let of_sorted_array_unchecked = of_sorted_array_unchecked
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun alist ->
|
|
let alist =
|
|
List.dedup_and_sort alist ~compare:(fun a b ->
|
|
Comparable.lift Key.compare ~f:fst a b)
|
|
in
|
|
let actual_fwd = create of_sorted_array_unchecked (Array.of_list alist) in
|
|
let actual_rev = create of_sorted_array_unchecked (Array.of_list_rev alist) in
|
|
let expect = create of_alist_exn alist in
|
|
require_equal [%here] (module Inst) actual_fwd expect;
|
|
require_equal [%here] (module Inst) actual_rev expect)
|
|
;;
|
|
|
|
let of_increasing_iterator_unchecked = of_increasing_iterator_unchecked
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun alist ->
|
|
let alist =
|
|
List.dedup_and_sort alist ~compare:(fun a b ->
|
|
Comparable.lift Key.compare ~f:fst a b)
|
|
in
|
|
let actual =
|
|
let array = Array.of_list alist in
|
|
create
|
|
of_increasing_iterator_unchecked
|
|
~len:(Array.length array)
|
|
~f:(Array.get array)
|
|
in
|
|
let expect = create of_alist_exn alist in
|
|
require_equal [%here] (module Inst) actual expect)
|
|
;;
|
|
|
|
let of_iteri = of_iteri
|
|
let of_iteri_exn = of_iteri_exn
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Alist)
|
|
~f:(fun alist ->
|
|
let iteri ~f = List.iter alist ~f:(fun (key, data) -> f ~key ~data) [@nontail] in
|
|
let actual_or_duplicate =
|
|
match create of_iteri ~iteri with
|
|
| `Ok t -> Ok t
|
|
| `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)]
|
|
in
|
|
let actual_exn = Or_error.try_with (fun () -> create of_iteri_exn ~iteri) in
|
|
let expect = create of_alist_or_error alist in
|
|
require_equal [%here] (module Ok (Inst)) actual_or_duplicate expect;
|
|
require_equal [%here] (module Ok (Inst)) actual_exn expect)
|
|
;;
|
|
|
|
let map_keys = map_keys
|
|
let map_keys_exn = map_keys_exn
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, k) ->
|
|
let f key = Comparable.min Key.compare k key in
|
|
let actual_or_duplicate =
|
|
match create map_keys t ~f with
|
|
| `Ok t -> Ok t
|
|
| `Duplicate_key key -> Or_error.error_s [%sexp (key : Key.t)]
|
|
in
|
|
let actual_exn = Or_error.try_with (fun () -> create map_keys_exn t ~f) in
|
|
let expect =
|
|
to_alist t
|
|
|> List.map ~f:(fun (key, data) -> f key, data)
|
|
|> create of_alist_or_error
|
|
in
|
|
require_equal [%here] (module Ok (Inst)) actual_or_duplicate expect;
|
|
require_equal [%here] (module Ok (Inst)) actual_exn expect)
|
|
;;
|
|
|
|
let transpose_keys = transpose_keys
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_inst)
|
|
~f:(fun t ->
|
|
let transpose_keys = create (access transpose_keys) in
|
|
let transposed = transpose_keys t in
|
|
require [%here] (access invariants transposed);
|
|
let round_trip = transpose_keys transposed in
|
|
require_equal
|
|
[%here]
|
|
(module Inst_inst)
|
|
(filter t ~f:(Fn.non is_empty))
|
|
round_trip)
|
|
;;
|
|
|
|
(** accessors *)
|
|
|
|
let invariants = invariants
|
|
|
|
let () =
|
|
quickcheck_m [%here] (module Inst) ~f:(fun t -> require [%here] (access invariants t))
|
|
;;
|
|
|
|
let is_empty = is_empty
|
|
let length = length
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst)
|
|
~f:(fun t ->
|
|
let len = length t in
|
|
require_equal [%here] (module Bool) (is_empty t) (len = 0);
|
|
require_equal [%here] (module Int) len (List.length (to_alist t)))
|
|
;;
|
|
|
|
let mem = mem
|
|
let find = find
|
|
let find_exn = find_exn
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, key) ->
|
|
let expect = List.Assoc.find (to_alist t) key ~equal:Key.equal in
|
|
require_equal [%here] (module Bool) (access mem t key) (Option.is_some expect);
|
|
require_equal [%here] (module Opt (Int)) (access find t key) expect;
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Int))
|
|
(Option.try_with (fun () -> access find_exn t key))
|
|
expect)
|
|
;;
|
|
|
|
let set = set
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key_and_data)
|
|
~f:(fun (t, key, data) ->
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(to_alist (access set t ~key ~data))
|
|
(List.sort
|
|
~compare:(fun a b -> Comparable.lift Key.compare ~f:fst a b)
|
|
((key, data) :: List.Assoc.remove (to_alist t) key ~equal:Key.equal)))
|
|
;;
|
|
|
|
let add = add
|
|
let add_exn = add_exn
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key_and_data)
|
|
~f:(fun (t, key, data) ->
|
|
let t_add =
|
|
match access add t ~key ~data with
|
|
| `Ok t -> Ok t
|
|
| `Duplicate -> Or_error.error_string "duplicate"
|
|
in
|
|
let t_add_exn = Or_error.try_with (fun () -> access add_exn t ~key ~data) in
|
|
let expect =
|
|
if access mem t key
|
|
then Or_error.error_string "duplicate"
|
|
else Ok (access set t ~key ~data)
|
|
in
|
|
require_equal [%here] (module Ok (Inst)) t_add expect;
|
|
require_equal [%here] (module Ok (Inst)) t_add_exn expect)
|
|
;;
|
|
|
|
let remove = remove
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, key) ->
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(to_alist (access remove t key))
|
|
(List.Assoc.remove (to_alist t) key ~equal:Key.equal))
|
|
;;
|
|
|
|
let change = change
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module struct
|
|
type t = Inst.t * Key.t * int option [@@deriving quickcheck, sexp_of]
|
|
end)
|
|
~f:(fun (t, key, maybe_data) ->
|
|
let actual =
|
|
access change t key ~f:(fun previous ->
|
|
require_equal [%here] (module Opt (Int)) previous (access find t key);
|
|
maybe_data)
|
|
in
|
|
let expect =
|
|
match maybe_data with
|
|
| None -> access remove t key
|
|
| Some data -> access set t ~key ~data
|
|
in
|
|
require_equal [%here] (module Inst) actual expect)
|
|
;;
|
|
|
|
let update = update
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key_and_data)
|
|
~f:(fun (t, key, data) ->
|
|
let actual =
|
|
access update t key ~f:(fun previous ->
|
|
require_equal [%here] (module Opt (Int)) previous (access find t key);
|
|
data)
|
|
in
|
|
let expect = access set t ~key ~data in
|
|
require_equal [%here] (module Inst) actual expect)
|
|
;;
|
|
|
|
let find_multi = find_multi
|
|
let add_multi = add_multi
|
|
let remove_multi = remove_multi
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module struct
|
|
type t = Inst_multi.t * Key.t * int [@@deriving quickcheck, sexp_of]
|
|
end)
|
|
~f:(fun (t, key, data) ->
|
|
require_equal
|
|
[%here]
|
|
(module Lst (Int))
|
|
(access find_multi t key)
|
|
(access find t key |> Option.value ~default:[]);
|
|
require_equal
|
|
[%here]
|
|
(module Inst_multi)
|
|
(access add_multi t ~key ~data)
|
|
(access update t key ~f:(fun option -> data :: Option.value option ~default:[]));
|
|
require_equal
|
|
[%here]
|
|
(module Inst_multi)
|
|
(access remove_multi t key)
|
|
(access change t key ~f:(function
|
|
| None | Some ([] | [ _ ]) -> None
|
|
| Some (_ :: (_ :: _ as rest)) -> Some rest)))
|
|
;;
|
|
|
|
let iter_keys = iter_keys
|
|
let iter = iter
|
|
let iteri = iteri
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst)
|
|
~f:(fun t ->
|
|
let actuali =
|
|
let q = Queue.create () in
|
|
iteri t ~f:(fun ~key ~data -> Queue.enqueue q (key, data));
|
|
Queue.to_list q
|
|
in
|
|
let actual_keys =
|
|
let q = Queue.create () in
|
|
iter_keys t ~f:(Queue.enqueue q);
|
|
Queue.to_list q
|
|
in
|
|
let actual =
|
|
let q = Queue.create () in
|
|
iter t ~f:(Queue.enqueue q);
|
|
Queue.to_list q
|
|
in
|
|
require_equal [%here] (module Alist) actuali (to_alist t);
|
|
require_equal [%here] (module Lst (Key)) actual_keys (keys t);
|
|
require_equal [%here] (module Lst (Int)) actual (data t))
|
|
;;
|
|
|
|
let map = map
|
|
let mapi = mapi
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst)
|
|
~f:(fun t ->
|
|
require_equal
|
|
[%here]
|
|
(module Inst)
|
|
(map t ~f:Int.succ)
|
|
(t |> to_alist |> List.Assoc.map ~f:Int.succ |> create of_alist_exn);
|
|
require_equal
|
|
[%here]
|
|
(module struct
|
|
type t = (Key.t * int) Instance.t [@@deriving equal, sexp_of]
|
|
end)
|
|
(mapi t ~f:(fun ~key ~data -> key, data))
|
|
(t |> to_alist |> List.map ~f:(fun (k, v) -> k, (k, v)) |> create of_alist_exn))
|
|
;;
|
|
|
|
let filter_keys = filter_keys
|
|
let filter = filter
|
|
let filteri = filteri
|
|
|
|
module Physical_equality (T : sig
|
|
type t [@@deriving sexp_of]
|
|
end) =
|
|
struct
|
|
type t = T.t [@@deriving sexp_of]
|
|
|
|
let equal a b = phys_equal a b
|
|
end
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key_and_data)
|
|
~f:(fun (t, k, d) ->
|
|
require_equal
|
|
[%here]
|
|
(module Physical_equality (Inst))
|
|
(filter ~f:(fun _ -> true) t)
|
|
t;
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(to_alist (filter_keys t ~f:(fun key -> Key.( <= ) key k)))
|
|
(List.filter (to_alist t) ~f:(fun (key, _) -> Key.( <= ) key k));
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(to_alist (filter t ~f:(fun data -> data <= d)))
|
|
(List.filter (to_alist t) ~f:(fun (_, data) -> data <= d));
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(to_alist (filteri t ~f:(fun ~key ~data -> Key.( <= ) key k && data <= d)))
|
|
(List.filter (to_alist t) ~f:(fun (key, data) -> Key.( <= ) key k && data <= d)))
|
|
;;
|
|
|
|
let filter_map = filter_map
|
|
let filter_mapi = filter_mapi
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key_and_data)
|
|
~f:(fun (t, k, d) ->
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(to_alist (filter_map t ~f:(fun data -> Option.some_if (data >= d) (data - d))))
|
|
(List.filter_map (to_alist t) ~f:(fun (key, data) ->
|
|
Option.some_if (data >= d) (key, data - d)));
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(to_alist
|
|
(filter_mapi t ~f:(fun ~key ~data ->
|
|
Option.some_if (Key.( <= ) key k && data >= d) (data - d))))
|
|
(List.filter_map (to_alist t) ~f:(fun (key, data) ->
|
|
Option.some_if (Key.( <= ) key k && data >= d) (key, data - d))))
|
|
;;
|
|
|
|
let partition_mapi = partition_mapi
|
|
let partition_map = partition_map
|
|
let partitioni_tf = partitioni_tf
|
|
let partition_tf = partition_tf
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key_and_data)
|
|
~f:(fun (t, k, d) ->
|
|
require_equal
|
|
[%here]
|
|
(module Physical_equality (Inst))
|
|
(fst (partition_tf ~f:(fun _ -> true) t))
|
|
t;
|
|
require_equal
|
|
[%here]
|
|
(module Pair (Alist))
|
|
(let a, b = partition_tf t ~f:(fun data -> data <= d) in
|
|
to_alist a, to_alist b)
|
|
(List.partition_tf (to_alist t) ~f:(fun (_, data) -> data <= d));
|
|
require_equal
|
|
[%here]
|
|
(module Pair (Alist))
|
|
(let a, b =
|
|
partitioni_tf t ~f:(fun ~key ~data -> Key.( <= ) key k && data <= d)
|
|
in
|
|
to_alist a, to_alist b)
|
|
(List.partition_tf (to_alist t) ~f:(fun (key, data) ->
|
|
Key.( <= ) key k && data <= d));
|
|
require_equal
|
|
[%here]
|
|
(module Pair (Alist))
|
|
(let a, b =
|
|
partition_map t ~f:(fun data ->
|
|
if data >= d then First (data - d) else Second d)
|
|
in
|
|
to_alist a, to_alist b)
|
|
(List.partition_map (to_alist t) ~f:(fun (key, data) ->
|
|
if data >= d then First (key, data - d) else Second (key, d)));
|
|
require_equal
|
|
[%here]
|
|
(module Pair (Alist))
|
|
(let a, b =
|
|
partition_mapi t ~f:(fun ~key ~data ->
|
|
if Key.( <= ) key k && data >= d then First (data - d) else Second d)
|
|
in
|
|
to_alist a, to_alist b)
|
|
(List.partition_map (to_alist t) ~f:(fun (key, data) ->
|
|
if Key.( <= ) key k && data >= d
|
|
then First (key, data - d)
|
|
else Second (key, d))))
|
|
;;
|
|
|
|
let fold = fold
|
|
let fold_right = fold_right
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst)
|
|
~f:(fun t ->
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(fold t ~init:[] ~f:(fun ~key ~data list -> (key, data) :: list))
|
|
(List.rev (to_alist t));
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(fold_right t ~init:[] ~f:(fun ~key ~data list -> (key, data) :: list))
|
|
(to_alist t))
|
|
;;
|
|
|
|
let fold_until = fold_until
|
|
let iteri_until = iteri_until
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, threshold) ->
|
|
require_equal
|
|
[%here]
|
|
(module struct
|
|
type t = int list * Base.Map.Finished_or_unfinished.t
|
|
[@@deriving equal, sexp_of]
|
|
end)
|
|
(let q = Queue.create () in
|
|
let status =
|
|
iteri_until t ~f:(fun ~key ~data ->
|
|
if Key.( >= ) key threshold
|
|
then Stop
|
|
else (
|
|
Queue.enqueue q data;
|
|
Continue))
|
|
in
|
|
Queue.to_list q, status)
|
|
(let list =
|
|
to_alist t
|
|
|> List.take_while ~f:(fun (key, _) -> Key.( < ) key threshold)
|
|
|> List.map ~f:snd
|
|
in
|
|
list, if List.length list = length t then Finished else Unfinished))
|
|
;;
|
|
|
|
let combine_errors = combine_errors
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, threshold) ->
|
|
let t =
|
|
mapi t ~f:(fun ~key ~data ->
|
|
if Key.( <= ) key threshold then Ok data else Or_error.error_string "too big")
|
|
in
|
|
require_equal
|
|
[%here]
|
|
(module Ok (Inst))
|
|
(access combine_errors t)
|
|
(to_alist t
|
|
|> List.map ~f:(fun (key, result) ->
|
|
Or_error.map result ~f:(fun data -> key, data))
|
|
|> Or_error.combine_errors
|
|
|> Or_error.map ~f:(create of_alist_exn)))
|
|
;;
|
|
|
|
let unzip = unzip
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_pair)
|
|
~f:(fun t ->
|
|
require_equal
|
|
[%here]
|
|
(module Pair (Alist))
|
|
(let a, b = unzip t in
|
|
to_alist a, to_alist b)
|
|
(to_alist t
|
|
|> List.map ~f:(fun (key, (a, b)) -> (key, a), (key, b))
|
|
|> List.unzip))
|
|
;;
|
|
|
|
let equal = equal
|
|
let compare_direct = compare_direct
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Pair (Inst))
|
|
~f:(fun (a, b) ->
|
|
require_equal
|
|
[%here]
|
|
(module Ordering)
|
|
(Ordering.of_int (access compare_direct Int.compare a b))
|
|
(Ordering.of_int (Alist.compare (to_alist a) (to_alist b)));
|
|
require_equal
|
|
[%here]
|
|
(module Bool)
|
|
(access compare_direct Int.compare a b = 0)
|
|
(access equal Int.equal a b))
|
|
;;
|
|
|
|
let keys = keys
|
|
let data = data
|
|
let to_alist = to_alist
|
|
let to_sequence = to_sequence
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst)
|
|
~f:(fun t ->
|
|
let alist = to_alist t in
|
|
require_equal [%here] (module Inst) (create of_alist_exn alist) t;
|
|
require_equal [%here] (module Lst (Key)) (keys t) (List.map alist ~f:fst);
|
|
require_equal [%here] (module Lst (Int)) (data t) (List.map alist ~f:snd);
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(Sequence.to_list ((access to_sequence) t))
|
|
alist)
|
|
;;
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module struct
|
|
type t = Inst.t * [ `Decreasing | `Increasing ] [@@deriving quickcheck, sexp_of]
|
|
end)
|
|
~f:(fun (t, key_order) ->
|
|
let alist = to_alist t ~key_order in
|
|
require_equal
|
|
[%here]
|
|
(module Lst (Key_and_data))
|
|
alist
|
|
(match key_order with
|
|
| `Increasing -> to_alist t
|
|
| `Decreasing -> List.rev (to_alist t));
|
|
require_equal
|
|
[%here]
|
|
(module Lst (Key_and_data))
|
|
alist
|
|
(Sequence.to_list
|
|
((access to_sequence)
|
|
t
|
|
~order:
|
|
(match key_order with
|
|
| `Decreasing -> `Decreasing_key
|
|
| `Increasing -> `Increasing_key))))
|
|
;;
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module struct
|
|
type t = Inst.t * [ `Decreasing_key | `Increasing_key ] * Key.t * Key.t
|
|
[@@deriving quickcheck, sexp_of]
|
|
end)
|
|
~f:(fun (t, order, keys_greater_or_equal_to, keys_less_or_equal_to) ->
|
|
let alist =
|
|
Sequence.to_list
|
|
((access to_sequence)
|
|
t
|
|
~order
|
|
~keys_greater_or_equal_to
|
|
~keys_less_or_equal_to)
|
|
in
|
|
require_equal
|
|
[%here]
|
|
(module Lst (Key_and_data))
|
|
alist
|
|
(List.filter
|
|
(match order with
|
|
| `Decreasing_key -> List.rev (to_alist t)
|
|
| `Increasing_key -> to_alist t)
|
|
~f:(fun (key, _) ->
|
|
Key.( <= ) keys_greater_or_equal_to key
|
|
&& Key.( <= ) key keys_less_or_equal_to)))
|
|
;;
|
|
|
|
let merge = merge
|
|
let iter2 = iter2
|
|
let fold2 = fold2
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module struct
|
|
module Inst2 = Pair (Inst)
|
|
|
|
type t = Inst2.t * Key.t [@@deriving quickcheck, sexp_of]
|
|
end)
|
|
~f:(fun ((a, b), k) ->
|
|
let merge_alist =
|
|
access merge a b ~f:(fun ~key elt ->
|
|
Option.some_if (Key.( > ) key k) (key, elt))
|
|
|> data
|
|
in
|
|
let iter2_alist =
|
|
let q = Queue.create () in
|
|
access iter2 a b ~f:(fun ~key ~data:elt ->
|
|
if Key.( > ) key k then Queue.enqueue q (key, elt));
|
|
Queue.to_list q
|
|
in
|
|
let fold2_alist =
|
|
access fold2 a b ~init:[] ~f:(fun ~key ~data:elt acc ->
|
|
if Key.( > ) key k then (key, elt) :: acc else acc)
|
|
|> List.rev
|
|
in
|
|
let expect =
|
|
[ map a ~f:Either.first; map b ~f:Either.second ]
|
|
|> List.concat_map ~f:to_alist
|
|
|> List.Assoc.sort_and_group ~compare:Key.compare
|
|
|> List.filter_map ~f:(fun (key, list) ->
|
|
let elt =
|
|
match (list : _ Either.t list) with
|
|
| [ First x ] -> `Left x
|
|
| [ Second y ] -> `Right y
|
|
| [ First x; Second y ] -> `Both (x, y)
|
|
| _ -> assert false
|
|
in
|
|
Option.some_if (Key.( > ) key k) (key, elt))
|
|
in
|
|
require_equal [%here] (module Alist_merge) merge_alist expect;
|
|
require_equal [%here] (module Alist_merge) iter2_alist expect;
|
|
require_equal [%here] (module Alist_merge) fold2_alist expect)
|
|
;;
|
|
|
|
let merge_disjoint_exn = merge_disjoint_exn
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Pair (Inst))
|
|
~f:(fun (a, b) ->
|
|
let actual = Option.try_with (fun () -> access merge_disjoint_exn a b) in
|
|
let expect =
|
|
if existsi a ~f:(fun ~key ~data:_ -> access mem b key)
|
|
then None
|
|
else
|
|
Some
|
|
(access merge a b ~f:(fun ~key:_ elt ->
|
|
match elt with
|
|
| `Left x | `Right x -> Some x
|
|
| `Both _ -> assert false))
|
|
in
|
|
require_equal [%here] (module Opt (Inst)) actual expect)
|
|
;;
|
|
|
|
let merge_skewed = merge_skewed
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Pair (Inst))
|
|
~f:(fun (a, b) ->
|
|
let actual = access merge_skewed a b ~combine:(fun ~key a b -> int key + a + b) in
|
|
let expect =
|
|
access merge a b ~f:(fun ~key elt ->
|
|
match elt with
|
|
| `Left a -> Some a
|
|
| `Right b -> Some b
|
|
| `Both (a, b) -> Some (int key + a + b))
|
|
in
|
|
require_equal [%here] (module Inst) actual expect)
|
|
;;
|
|
|
|
let symmetric_diff = symmetric_diff
|
|
let fold_symmetric_diff = fold_symmetric_diff
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Pair (Inst))
|
|
~f:(fun (a, b) ->
|
|
let diff_alist =
|
|
access symmetric_diff a b ~data_equal:Int.equal |> Sequence.to_list
|
|
in
|
|
let fold_alist =
|
|
access
|
|
fold_symmetric_diff
|
|
a
|
|
b
|
|
~data_equal:(fun x y -> Int.equal x y)
|
|
~init:[]
|
|
~f:(fun acc pair -> pair :: acc)
|
|
|> List.rev
|
|
in
|
|
let expect =
|
|
access merge a b ~f:(fun ~key:_ elt ->
|
|
match elt with
|
|
| `Left x -> Some (`Left x)
|
|
| `Right y -> Some (`Right y)
|
|
| `Both (x, y) -> if x = y then None else Some (`Unequal (x, y)))
|
|
|> to_alist
|
|
in
|
|
require_equal [%here] (module Diff) diff_alist expect;
|
|
require_equal [%here] (module Diff) fold_alist expect)
|
|
;;
|
|
|
|
let min_elt = min_elt
|
|
let max_elt = max_elt
|
|
let min_elt_exn = min_elt_exn
|
|
let max_elt_exn = max_elt_exn
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst)
|
|
~f:(fun t ->
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(min_elt t)
|
|
(List.hd (to_alist t));
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(max_elt t)
|
|
(List.last (to_alist t));
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(Option.try_with (fun () -> min_elt_exn t))
|
|
(List.hd (to_alist t));
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(Option.try_with (fun () -> max_elt_exn t))
|
|
(List.last (to_alist t)))
|
|
;;
|
|
|
|
let for_all = for_all
|
|
let for_alli = for_alli
|
|
let exists = exists
|
|
let existsi = existsi
|
|
let count = count
|
|
let counti = counti
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key_and_data)
|
|
~f:(fun (t, k, d) ->
|
|
let f data = data <= d in
|
|
let fi ~key ~data = Key.( <= ) key k && data <= d in
|
|
let fp (key, data) = fi ~key ~data in
|
|
let data = data t in
|
|
let alist = to_alist t in
|
|
require_equal [%here] (module Bool) (for_all t ~f) (List.for_all data ~f);
|
|
require_equal [%here] (module Bool) (for_alli t ~f:fi) (List.for_all alist ~f:fp);
|
|
require_equal [%here] (module Bool) (exists t ~f) (List.exists data ~f);
|
|
require_equal [%here] (module Bool) (existsi t ~f:fi) (List.exists alist ~f:fp);
|
|
require_equal [%here] (module Int) (count t ~f) (List.count data ~f);
|
|
require_equal [%here] (module Int) (counti t ~f:fi) (List.count alist ~f:fp))
|
|
;;
|
|
|
|
let sum = sum
|
|
let sumi = sumi
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst)
|
|
~f:(fun t ->
|
|
let f data = data * 2 in
|
|
let fi ~key ~data = (Instance.int key * 2) + (data * 3) in
|
|
let fp (key, data) = fi ~key ~data in
|
|
let m = (module Int : Container.Summable with type t = int) in
|
|
let data = data t in
|
|
let alist = to_alist t in
|
|
require_equal [%here] (module Int) (sum m t ~f) (List.sum m data ~f);
|
|
require_equal [%here] (module Int) (sumi m t ~f:fi) (List.sum m alist ~f:fp))
|
|
;;
|
|
|
|
let split = split
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, k) ->
|
|
require_equal
|
|
[%here]
|
|
(module struct
|
|
type t = Inst.t * (Key.t * int) option * Inst.t [@@deriving equal, sexp_of]
|
|
end)
|
|
(access split t k)
|
|
(let before, equal, after =
|
|
List.partition3_map (to_alist t) ~f:(fun (key, data) ->
|
|
match Ordering.of_int (Key.compare key k) with
|
|
| Less -> `Fst (key, data)
|
|
| Equal -> `Snd (key, data)
|
|
| Greater -> `Trd (key, data))
|
|
in
|
|
create of_alist_exn before, List.hd equal, create of_alist_exn after))
|
|
;;
|
|
|
|
let split_le_gt = split_le_gt
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, k) ->
|
|
require_equal
|
|
[%here]
|
|
(module struct
|
|
type t = Inst.t * Inst.t [@@deriving equal, sexp_of]
|
|
end)
|
|
(access split_le_gt t k)
|
|
(let before, after =
|
|
List.partition_tf (to_alist t) ~f:(fun (key, _) -> Key.( <= ) key k)
|
|
in
|
|
create of_alist_exn before, create of_alist_exn after))
|
|
;;
|
|
|
|
let split_lt_ge = split_lt_ge
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, k) ->
|
|
require_equal
|
|
[%here]
|
|
(module struct
|
|
type t = Inst.t * Inst.t [@@deriving equal, sexp_of]
|
|
end)
|
|
(access split_lt_ge t k)
|
|
(let before, after =
|
|
List.partition_tf (to_alist t) ~f:(fun (key, _) -> Key.( < ) key k)
|
|
in
|
|
create of_alist_exn before, create of_alist_exn after))
|
|
;;
|
|
|
|
let append = append
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Pair (Inst))
|
|
~f:(fun (a, b) ->
|
|
require_equal
|
|
[%here]
|
|
(module Ok (Inst))
|
|
(match access append ~lower_part:a ~upper_part:b with
|
|
| `Ok t -> Ok t
|
|
| `Overlapping_key_ranges -> Or_error.error_string "overlap")
|
|
(match max_elt a, min_elt b with
|
|
| Some (x, _), Some (y, _) when Key.( >= ) x y ->
|
|
Or_error.error_string "overlap"
|
|
| _ -> Ok (create of_alist_exn (to_alist a @ to_alist b)));
|
|
let a' =
|
|
(* we rely on the fact that the [Inst] generator uses positive keys *)
|
|
create map_keys_exn a ~f:(fun k -> key (-int k))
|
|
in
|
|
require_equal
|
|
[%here]
|
|
(module Ok (Inst))
|
|
(match access append ~lower_part:a' ~upper_part:b with
|
|
| `Ok t -> Ok t
|
|
| `Overlapping_key_ranges -> Or_error.error_string "overlap")
|
|
(Ok (create of_alist_exn (to_alist a' @ to_alist b))))
|
|
;;
|
|
|
|
let subrange = subrange
|
|
let fold_range_inclusive = fold_range_inclusive
|
|
let range_to_alist = range_to_alist
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module struct
|
|
type t = Inst.t * Key.t Maybe_bound.t * Key.t Maybe_bound.t
|
|
[@@deriving quickcheck, sexp_of]
|
|
end)
|
|
~f:(fun (t, lower_bound, upper_bound) ->
|
|
let subrange_alist = access subrange t ~lower_bound ~upper_bound |> to_alist in
|
|
let min =
|
|
match lower_bound with
|
|
| Unbounded -> key Int.min_value
|
|
| Incl min -> min
|
|
| Excl too_small ->
|
|
(* key generator does not generate [max_value], so this cannot overflow *)
|
|
key (int too_small + 1)
|
|
in
|
|
let max =
|
|
match upper_bound with
|
|
| Unbounded -> key Int.max_value
|
|
| Incl max -> max
|
|
| Excl too_large ->
|
|
(* key generator does not generate [min_value], so this cannot overflow *)
|
|
key (int too_large - 1)
|
|
in
|
|
let fold_alist =
|
|
access fold_range_inclusive t ~min ~max ~init:[] ~f:(fun ~key ~data acc ->
|
|
(key, data) :: acc)
|
|
|> List.rev
|
|
in
|
|
let range_alist = access range_to_alist t ~min ~max in
|
|
let expect =
|
|
if Maybe_bound.bounds_crossed
|
|
~lower:lower_bound
|
|
~upper:upper_bound
|
|
~compare:Key.compare
|
|
then []
|
|
else
|
|
List.filter (to_alist t) ~f:(fun (key, _) ->
|
|
Maybe_bound.interval_contains_exn
|
|
key
|
|
~lower:lower_bound
|
|
~upper:upper_bound
|
|
~compare:Key.compare)
|
|
in
|
|
require_equal [%here] (module Alist) subrange_alist expect;
|
|
require_equal [%here] (module Alist) fold_alist expect;
|
|
require_equal [%here] (module Alist) range_alist expect)
|
|
;;
|
|
|
|
let closest_key = closest_key
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, k) ->
|
|
let alist = to_alist t in
|
|
let rev_alist = List.rev alist in
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(access closest_key t `Less_than k)
|
|
(List.find rev_alist ~f:(fun (key, _) -> Key.( < ) key k));
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(access closest_key t `Less_or_equal_to k)
|
|
(List.find rev_alist ~f:(fun (key, _) -> Key.( <= ) key k));
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(access closest_key t `Greater_or_equal_to k)
|
|
(List.find alist ~f:(fun (key, _) -> Key.( >= ) key k));
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(access closest_key t `Greater_than k)
|
|
(List.find alist ~f:(fun (key, _) -> Key.( > ) key k)))
|
|
;;
|
|
|
|
let nth = nth
|
|
let nth_exn = nth_exn
|
|
let rank = rank
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, k) ->
|
|
List.iteri (to_alist t) ~f:(fun i (key, data) ->
|
|
require_equal [%here] (module Opt (Key_and_data)) (nth t i) (Some (key, data));
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(Option.try_with (fun () -> nth_exn t i))
|
|
(nth t i);
|
|
require_equal [%here] (module Opt (Int)) (access rank t key) (Some i));
|
|
require_equal [%here] (module Opt (Key_and_data)) (nth t (length t)) None;
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Int))
|
|
(access rank t k)
|
|
(List.find_mapi (to_alist t) ~f:(fun i (key, _) ->
|
|
Option.some_if (Key.equal key k) i)))
|
|
;;
|
|
|
|
let binary_search = binary_search
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, k) ->
|
|
let targets = [%all: Binary_searchable.Which_target_by_key.t] in
|
|
let compare (key, _) k = Key.compare key k in
|
|
List.iter targets ~f:(fun which_target ->
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(access
|
|
binary_search
|
|
t
|
|
~compare:(fun ~key ~data k' ->
|
|
require_equal [%here] (module Key) k' k;
|
|
require_equal [%here] (module Opt (Int)) (access find t key) (Some data);
|
|
compare (key, data) k')
|
|
which_target
|
|
k)
|
|
(let array = Array.of_list (to_alist t) in
|
|
Array.binary_search array ~compare which_target k
|
|
|> Option.map ~f:(Array.get array))))
|
|
;;
|
|
|
|
let binary_search_segmented = binary_search_segmented
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst_and_key)
|
|
~f:(fun (t, k) ->
|
|
let targets = [%all: Binary_searchable.Which_target_by_segment.t] in
|
|
let segment_of (key, _) = if Key.( <= ) key k then `Left else `Right in
|
|
List.iter targets ~f:(fun which_target ->
|
|
require_equal
|
|
[%here]
|
|
(module Opt (Key_and_data))
|
|
(access
|
|
binary_search_segmented
|
|
t
|
|
~segment_of:(fun ~key ~data ->
|
|
require_equal [%here] (module Opt (Int)) (access find t key) (Some data);
|
|
segment_of (key, data))
|
|
which_target)
|
|
(let array = Array.of_list (to_alist t) in
|
|
Array.binary_search_segmented array ~segment_of which_target
|
|
|> Option.map ~f:(Array.get array))))
|
|
;;
|
|
|
|
let binary_search_subrange = binary_search_subrange
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module struct
|
|
type t = Inst.t * Key.t Maybe_bound.t * Key.t Maybe_bound.t
|
|
[@@deriving quickcheck, sexp_of]
|
|
end)
|
|
~f:(fun (t, lower_bound, upper_bound) ->
|
|
require_equal
|
|
[%here]
|
|
(module Inst)
|
|
(access
|
|
binary_search_subrange
|
|
t
|
|
~compare:(fun ~key ~data bound ->
|
|
require_equal [%here] (module Opt (Int)) (access find t key) (Some data);
|
|
Key.compare key bound)
|
|
~lower_bound
|
|
~upper_bound)
|
|
(access subrange t ~lower_bound ~upper_bound))
|
|
;;
|
|
|
|
module Make_applicative_traversals (A : Applicative.Lazy_applicative) = struct
|
|
module M = Make_applicative_traversals (A)
|
|
|
|
let mapi = M.mapi
|
|
let filter_mapi = M.filter_mapi
|
|
end
|
|
|
|
let () =
|
|
let module M =
|
|
Make_applicative_traversals (struct
|
|
module M = struct
|
|
type 'a t = 'a
|
|
|
|
let return x = x
|
|
let apply f x = f x
|
|
let of_thunk f = f ()
|
|
let map = `Define_using_apply
|
|
end
|
|
|
|
include M
|
|
include Applicative.Make (M)
|
|
end)
|
|
in
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst)
|
|
~f:(fun t ->
|
|
let f1 ~key:_ ~data = (data * 2) + 1 in
|
|
let f2 ~key:_ ~data = if data < 0 then None else Some data in
|
|
require_equal [%here] (module Inst) (mapi t ~f:f1) (M.mapi t ~f:f1);
|
|
require_equal [%here] (module Inst) (filter_mapi t ~f:f2) (M.filter_mapi t ~f:f2))
|
|
;;
|
|
|
|
(** tree conversion *)
|
|
|
|
let to_tree = to_tree
|
|
let of_tree = of_tree
|
|
|
|
let () =
|
|
quickcheck_m
|
|
[%here]
|
|
(module Inst)
|
|
~f:(fun t ->
|
|
let tree = to_tree t in
|
|
let round_trip = create of_tree tree in
|
|
require_equal [%here] (module Inst) t round_trip;
|
|
require_equal
|
|
[%here]
|
|
(module Alist)
|
|
(to_alist t)
|
|
(Map.Using_comparator.Tree.to_alist (Instance.tree tree)))
|
|
;;
|
|
end
|