From 043ffd4c30b1712590b5207c386c9e68d6bfe32b Mon Sep 17 00:00:00 2001 From: public-release Date: Tue, 19 Mar 2024 00:29:52 +0000 Subject: [PATCH] v0.17~preview.129.15+205 --- md5/src/md5_lib.mli | 2 +- src/hashtbl_intf.ml | 14 +- src/indexed_container_intf.ml | 2 +- src/int_string_conversions.ml | 2 +- src/option_array.ml | 2 + src/option_array.mli | 4 + src/string_intf.ml | 38 +- test/allocation/test_array_allocation.ml | 4 +- test/allocation/test_char_allocation.ml | 2 +- test/allocation/test_hashtbl_allocation.ml | 3 +- .../test_option_array_allocation.ml | 2 +- test/allocation/test_string_allocation.ml | 20 +- test/dune | 2 +- .../base_test_map_full_interface.ml | 1 + test/map_full_interface/dune | 6 + .../functor.ml} | 744 +++--------------- test/map_full_interface/functor.mli | 1 + test/map_full_interface/functor_intf.ml | 130 +++ test/map_full_interface/test_all.ml | 315 ++++++++ test/map_full_interface/test_all.mli | 5 + test/map_full_interface/test_poly.ml | 15 + test/map_full_interface/test_poly.mli | 1 + test/map_full_interface/test_poly_intf.ml | 22 + test/map_full_interface/test_toplevel.ml | 15 + test/map_full_interface/test_toplevel.mli | 1 + test/map_full_interface/test_toplevel_intf.ml | 22 + test/map_full_interface/test_tree.ml | 15 + test/map_full_interface/test_tree.mli | 1 + test/map_full_interface/test_tree_intf.ml | 22 + .../test_using_comparator.ml | 15 + .../test_using_comparator.mli | 1 + .../test_using_comparator_intf.ml | 22 + test/test_am_testing.ml | 3 +- test/test_applicative.ml | 15 +- test/test_array.ml | 83 +- test/test_backtrace.ml | 3 +- test/test_base_containers_mono.ml | 142 ++++ ...ners.mli => test_base_containers_mono.mli} | 0 ...ainers.ml => test_base_containers_poly.ml} | 149 +--- ...sive.mli => test_base_containers_poly.mli} | 0 test/test_bool.ml | 8 +- test/test_bytes.ml | 6 +- test/test_char.ml | 15 +- test/test_compare.ml | 34 +- test/test_either.ml | 12 +- test/test_error.ml | 6 +- test/test_exn.ml | 9 +- test/test_exn_reraise.ml | 35 +- test/test_float.ml | 41 +- test/test_fn_local.mlt | 4 +- test/test_globalize_lib.ml | 6 +- test/test_hashtbl.ml | 18 +- test/test_indexed_container.ml | 24 +- test/test_info.ml | 8 +- test/test_int.ml | 54 +- test/test_int32.ml | 27 +- test/test_int32_pow2.ml | 12 +- test/test_int63.ml | 39 +- test/test_int63_emul.ml | 6 +- test/test_int64.ml | 75 +- test/test_int64_pow2.ml | 12 +- test/test_int_math.ml | 15 +- test/test_int_pow2.ml | 12 +- test/test_lazy.ml | 6 +- test/test_list.ml | 266 +++++-- test/test_map.ml | 27 +- test/test_map.mlt | 4 +- test/test_map_traversal.ml | 6 +- test/test_minmax.ml | 27 +- test/test_nativeint.ml | 15 +- test/test_nativeint_pow2.ml | 12 +- test/test_not_found.mlt | 6 +- test/test_option.ml | 6 +- test/test_or_error.ml | 23 +- test/test_pp.ml | 18 +- test/test_ppx_compare_lib.ml | 3 +- test/test_queue.ml | 3 +- test/test_random.ml | 55 +- test/test_ref.ml | 12 +- test/test_sequence.ml | 9 +- test/test_set.ml | 6 +- test/test_sign_or_nan.ml | 3 +- test/test_string.ml | 90 ++- test/test_uniform_array.ml | 15 +- test/test_word_size.ml | 6 +- 85 files changed, 1736 insertions(+), 1206 deletions(-) create mode 100644 test/map_full_interface/base_test_map_full_interface.ml create mode 100644 test/map_full_interface/dune rename test/{test_map_comprehensive.ml => map_full_interface/functor.ml} (72%) create mode 100644 test/map_full_interface/functor.mli create mode 100644 test/map_full_interface/functor_intf.ml create mode 100644 test/map_full_interface/test_all.ml create mode 100644 test/map_full_interface/test_all.mli create mode 100644 test/map_full_interface/test_poly.ml create mode 100644 test/map_full_interface/test_poly.mli create mode 100644 test/map_full_interface/test_poly_intf.ml create mode 100644 test/map_full_interface/test_toplevel.ml create mode 100644 test/map_full_interface/test_toplevel.mli create mode 100644 test/map_full_interface/test_toplevel_intf.ml create mode 100644 test/map_full_interface/test_tree.ml create mode 100644 test/map_full_interface/test_tree.mli create mode 100644 test/map_full_interface/test_tree_intf.ml create mode 100644 test/map_full_interface/test_using_comparator.ml create mode 100644 test/map_full_interface/test_using_comparator.mli create mode 100644 test/map_full_interface/test_using_comparator_intf.ml create mode 100644 test/test_base_containers_mono.ml rename test/{test_base_containers.mli => test_base_containers_mono.mli} (100%) rename test/{test_base_containers.ml => test_base_containers_poly.ml} (62%) rename test/{test_map_comprehensive.mli => test_base_containers_poly.mli} (100%) diff --git a/md5/src/md5_lib.mli b/md5/src/md5_lib.mli index 0eee25f0..f215f84d 100644 --- a/md5/src/md5_lib.mli +++ b/md5/src/md5_lib.mli @@ -6,7 +6,7 @@ val compare : t -> t -> int val length : int val to_binary : t -> string -val to_binary_local : (t[@local]) -> (string[@local]) +val to_binary_local : t -> string val of_binary_exn : string -> t (** assumes the input is 16 bytes without checking *) diff --git a/src/hashtbl_intf.ml b/src/hashtbl_intf.ml index 58bf7c4f..adb781af 100644 --- a/src/hashtbl_intf.ml +++ b/src/hashtbl_intf.ml @@ -129,7 +129,7 @@ module type Accessors = sig {v let h = Hashtbl.of_alist_exn (module Int) [(1, 4); (5, 6)] in - let h' = Hashtbl.map h ~f:((fun x -> x * 2)[@local]) in + let h' = Hashtbl.map h ~f:(local_ (fun x -> x * 2)) in Hashtbl.to_alist h';; - : (int * int) list = [(5, 12); (1, 8)] v} *) @@ -146,7 +146,7 @@ module type Accessors = sig {v let h = Hashtbl.of_alist_exn (module Int) [(1, 4); (5, 6)] in - Hashtbl.filter_map h ~f:((fun x -> if x > 5 then Some x else None)[@local]) + Hashtbl.filter_map h ~f:(local_ (fun x -> if x > 5 then Some x else None)) |> Hashtbl.to_alist;; - : (int * int) list = [(5, 6)] v} *) @@ -541,8 +541,8 @@ module type Creators = sig {v let h = Hashtbl.create_mapped (module Int) - ~get_key:((fun x -> x)[@local]) - ~get_data:((fun x -> x + 1)[@local]) + ~get_key:(local_ (fun x -> x)) + ~get_data:(local_ (fun x -> x + 1)) [1; 2; 3];; val h : [ `Duplicate_keys of int list | `Ok of (int, int) Hashtbl.t ] = `Ok @@ -599,9 +599,9 @@ module type Creators = sig {v Hashtbl.group (module Int) - ~get_key:((fun x -> x / 2)[@local]) - ~get_data:((fun x -> x)[@local]) - ~combine:((fun x y -> x * y)[@local]) + ~get_key:(local_ (fun x -> x / 2)) + ~get_data:(local_ (fun x -> x)) + ~combine:(local_ (fun x y -> x * y)) [ 1; 2; 3; 4] |> Hashtbl.to_alist;; - : (int * int) list = [(2, 4); (1, 6); (0, 1)] diff --git a/src/indexed_container_intf.ml b/src/indexed_container_intf.ml index efa1a551..1ba9b4c1 100644 --- a/src/indexed_container_intf.ml +++ b/src/indexed_container_intf.ml @@ -184,7 +184,7 @@ end module type Derived = sig (** Generic definitions of [foldi] and [iteri] in terms of [fold]. - E.g., [iteri ~fold t ~f = ignore (fold t ~init:0 ~f:((fun i x -> f i x; i + 1)[@local]))]. *) + E.g., [iteri ~fold t ~f = ignore (fold t ~init:0 ~f:(local_ (fun i x -> f i x; i + 1)))]. *) val foldi : fold:('t, 'a, 'acc) fold -> ('t, 'a, 'acc) foldi val iteri : fold:('t, 'a, int) fold -> ('t, 'a) iteri diff --git a/src/int_string_conversions.ml b/src/int_string_conversions.ml index 8ca2e633..3717ab4d 100644 --- a/src/int_string_conversions.ml +++ b/src/int_string_conversions.ml @@ -196,6 +196,6 @@ struct "0b" ^ insert_delimiter_every (to_string_suffix t) ~delimiter ~chars_per_delimiter:4 ;; - let sexp_of_t (t : t) : Sexp.t = Atom (to_string t) + let sexp_of_t (t : t) : Sexp.t = Atom (to_string_hum t) end end diff --git a/src/option_array.ml b/src/option_array.ml index 4a5c39f4..280d4f76 100644 --- a/src/option_array.ml +++ b/src/option_array.ml @@ -90,6 +90,7 @@ module Cheap_option = struct ;; let[@inline] to_option x = if is_some x then Some (value_unsafe x) else None + let[@inline] to_option_local x = if is_some x then Some (value_unsafe x) else None let to_sexpable = to_option let of_sexpable = of_option @@ -129,6 +130,7 @@ let init n ~f = Uniform_array.init n ~f:(fun i -> Cheap_option.of_option (f i)) let init_some n ~f = Uniform_array.init n ~f:(fun i -> Cheap_option.some (f i)) [@nontail] let length = Uniform_array.length let[@inline] get t i = Cheap_option.to_option (Uniform_array.get t i) +let[@inline] get_local t i = Cheap_option.to_option_local (Uniform_array.get t i) let get_some_exn t i = Cheap_option.value_exn (Uniform_array.get t i) let is_none t i = Cheap_option.is_none (Uniform_array.get t i) let is_some t i = Cheap_option.is_some (Uniform_array.get t i) diff --git a/src/option_array.mli b/src/option_array.mli index 261d212e..0229a29e 100644 --- a/src/option_array.mli +++ b/src/option_array.mli @@ -32,6 +32,10 @@ val to_array : 'a t -> 'a option Array.t range 0 to [length t - 1]. *) val get : 'a t -> int -> 'a option +(** Similar to [get], but allocates result in the caller's stack region instead + of heap. *) +val get_local : 'a t -> int -> 'a option + (** Raises if the element number [i] is [None]. *) val get_some_exn : 'a t -> int -> 'a diff --git a/src/string_intf.ml b/src/string_intf.ml index d0834f3f..155743ab 100644 --- a/src/string_intf.ml +++ b/src/string_intf.ml @@ -17,17 +17,6 @@ module type Utf = sig characters. Indexes, length, etc. are with respect to [Uchar.t]. *) include Indexed_container.S0_with_creators with type t := t and type elt = Uchar0.t - (** Counts the number of unicode scalar values in [t]. *) - val length_in_uchars : t -> int - - (** [length] could be misinterpreted as counting bytes. We direct users to other, - clearer options. *) - val length : t -> int - [@@alert - length_in_uchars - "Use [length_in_uchars] to count unicode scalar values or [String.length] to \ - count bytes"] - (** Produce a sequence of unicode characters. *) val to_sequence : t -> Uchar0.t Sequence.t @@ -57,6 +46,33 @@ module type Utf = sig (** The name of this encoding scheme; e.g., "UTF-8". *) val codec_name : string + + (** Counts the number of unicode scalar values in [t]. + + This function is not a good proxy for display width, as some scalar values have + display widths > 1. Many native applications such as terminal emulators use + [wcwidth] (see [man 3 wcwidth]) to compute the display width of a scalar value. See + the uucp library's [Uucp.Break.tty_width_hint] for an implementation of [wcwidth]'s + logic. However, this is merely best-effort, as display widths will vary based on the + font and underlying text shaping engine (see docs on [tty_width_hint] for details). + + For applications that support Grapheme clusters (many terminal emulators do not), + [t] should first be split into Grapheme clusters and then the display width of each + of those Grapheme clusters needs to be computed (which is the max display width of + the scalars that are in the cluster). + + There are some active efforts to improve the current state of affairs: + - https://github.com/wez/wezterm/issues/4320 + - https://www.unicode.org/L2/L2023/23194-text-terminal-wg-report.pdf *) + val length_in_uchars : t -> int + + (** [length] could be misinterpreted as counting bytes. We direct users to other, + clearer options. *) + val length : t -> int + [@@alert + length_in_uchars + "Use [length_in_uchars] to count unicode scalar values or [String.length] to \ + count bytes"] end (** Iterface for Unicode encodings, specialized for string representation. *) diff --git a/test/allocation/test_array_allocation.ml b/test/allocation/test_array_allocation.ml index bd973b18..e05a92ee 100644 --- a/test/allocation/test_array_allocation.ml +++ b/test/allocation/test_array_allocation.ml @@ -4,14 +4,14 @@ open Expect_test_helpers_core let%expect_test "Array.sort [||] only allocates when computing bounds" = require_allocation_does_not_exceed (Minor_words 3) [%here] (fun () -> Array.sort ~compare:Int.compare [||]); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Array.sort [| 5; 2; 3; 4; 1 |] only allocates when computing bounds" = let arr = [| 5; 2; 3; 4; 1 |] in require_allocation_does_not_exceed (Minor_words 3) [%here] (fun () -> Array.sort ~compare:Int.compare arr); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "equal does not allocate" = diff --git a/test/allocation/test_char_allocation.ml b/test/allocation/test_char_allocation.ml index 916c256f..e78cc5d3 100644 --- a/test/allocation/test_char_allocation.ml +++ b/test/allocation/test_char_allocation.ml @@ -6,5 +6,5 @@ let%expect_test _ = let y = Sys.opaque_identity 'b' in require_no_allocation [%here] (fun () -> ignore (Sys.opaque_identity (Char.Caseless.equal x y) : bool)); - [%expect {||}] + [%expect {| |}] ;; diff --git a/test/allocation/test_hashtbl_allocation.ml b/test/allocation/test_hashtbl_allocation.ml index 0cfe58c5..54fbb03e 100644 --- a/test/allocation/test_hashtbl_allocation.ml +++ b/test/allocation/test_hashtbl_allocation.ml @@ -77,7 +77,8 @@ let%expect_test "find_and_call_1_and_2" = 25 29 33 - 3_133 |}] + 3_133 + |}] ;; let%expect_test ("find_or_add shouldn't allocate" [@tags "no-js"]) = diff --git a/test/allocation/test_option_array_allocation.ml b/test/allocation/test_option_array_allocation.ml index a3f323a2..0463d4cf 100644 --- a/test/allocation/test_option_array_allocation.ml +++ b/test/allocation/test_option_array_allocation.ml @@ -6,6 +6,6 @@ let%expect_test _ = using the build info in version_util, which isn't available while compiling a test. So we delegate the whole test to this executable: *) let%bind () = run "bin/test_option_array_allocation.exe" [] in - [%expect {||}]; + [%expect {| |}]; return () ;; diff --git a/test/allocation/test_string_allocation.ml b/test/allocation/test_string_allocation.ml index 119163ae..7814a6d0 100644 --- a/test/allocation/test_string_allocation.ml +++ b/test/allocation/test_string_allocation.ml @@ -6,7 +6,7 @@ let%expect_test _ = let y = Sys.opaque_identity "another" in require_no_allocation [%here] (fun () -> ignore (Sys.opaque_identity (String.Caseless.equal x y) : bool)); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "empty substring" = @@ -27,7 +27,7 @@ let%expect_test "mem does not allocate" = let string = Sys.opaque_identity "abracadabra" in let char = Sys.opaque_identity 'd' in require_no_allocation [%here] (fun () -> ignore (String.mem string char : bool)); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "fold does not allocate" = @@ -36,7 +36,7 @@ let%expect_test "fold does not allocate" = let f acc c = if Char.equal c char then true else acc in require_no_allocation [%here] (fun () -> ignore (String.fold string ~init:false ~f : bool)); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "foldi does not allocate" = @@ -45,7 +45,7 @@ let%expect_test "foldi does not allocate" = let f _i acc c = if Char.equal c char then true else acc in require_no_allocation [%here] (fun () -> ignore (String.foldi string ~init:false ~f : bool)); - [%expect {||}] + [%expect {| |}] ;; let%test_module "common prefix and suffix" = @@ -135,11 +135,13 @@ let%test_module "common prefix and suffix" = test_prefix [ "hello"; "help"; "hex" ]; [%expect {| he - (may allocate) |}]; + (may allocate) + |}]; test_suffix [ "crest"; "zest"; "1st" ]; [%expect {| st - (may allocate) |}] + (may allocate) + |}] ;; let%expect_test "doubleton, no alloc" = @@ -153,11 +155,13 @@ let%test_module "common prefix and suffix" = test_prefix [ "this"; "that"; "the other"; "these"; "those"; "thy"; "thou" ]; [%expect {| th - (may allocate) |}]; + (may allocate) + |}]; test_suffix [ "fourth"; "fifth"; "sixth"; "seventh"; "eleventh"; "twelfth" ]; [%expect {| th - (may allocate) |}] + (may allocate) + |}] ;; let%expect_test "many, no alloc" = diff --git a/test/dune b/test/dune index 1411fc72..afd1ada9 100644 --- a/test/dune +++ b/test/dune @@ -1,7 +1,7 @@ (library (name base_test) (libraries base base_container_tests core.base_for_tests base_test_helpers - expect_test_helpers_core.expect_test_helpers_base sexplib sexp_grammar + expect_test_helpers_core.expect_test_helpers_base sexplib sexp_grammar_validation num stdio) (preprocess (pps ppx_jane -dont-apply=pipebang -no-check-on-extensions))) diff --git a/test/map_full_interface/base_test_map_full_interface.ml b/test/map_full_interface/base_test_map_full_interface.ml new file mode 100644 index 00000000..9b28931c --- /dev/null +++ b/test/map_full_interface/base_test_map_full_interface.ml @@ -0,0 +1 @@ +(*_ This library deliberately exports nothing. *) diff --git a/test/map_full_interface/dune b/test/map_full_interface/dune new file mode 100644 index 00000000..0881dcef --- /dev/null +++ b/test/map_full_interface/dune @@ -0,0 +1,6 @@ +(library + (name base_test_map_full_interface) + (libraries base base_quickcheck + expect_test_helpers_core.expect_test_helpers_base sexp_grammar) + (preprocess + (pps ppx_jane))) diff --git a/test/test_map_comprehensive.ml b/test/map_full_interface/functor.ml similarity index 72% rename from test/test_map_comprehensive.ml rename to test/map_full_interface/functor.ml index 444df92f..16de64b1 100644 --- a/test/test_map_comprehensive.ml +++ b/test/map_full_interface/functor.ml @@ -7,7 +7,10 @@ untested definitions, mark them as untested, and keep them separate from definitions that need tests. *) -open! Import +open! Base +open Base_quickcheck +open Expect_test_helpers_base +include Functor_intf.Definitions open struct (** quickcheck configuration *) @@ -27,63 +30,6 @@ open struct let quickcheck_m here m ~f = quickcheck_m here m ~f ~config:quickcheck_config end -(** The types that distinguish instances of [Map.Creators_and_accessors_generic]. *) -module type Types = sig - type 'k key - type 'c cmp - type ('k, 'v, 'c) t - type ('k, 'v, 'c) tree - type ('k, 'c, 'a) create_options - type ('k, 'c, 'a) access_options -end - -(** Like [Map.Creators_and_accessors_generic], but based on [Types] for easier - instantiation. *) -module type S = sig - module Types : Types - - include - Map.Creators_and_accessors_generic - with type ('a, 'b, 'c) t := ('a, 'b, 'c) Types.t - with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Types.tree - with type 'a key := 'a Types.key - with type 'a cmp := 'a Types.cmp - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Types.create_options - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Types.access_options -end - -(** Helpers for testing a tree or map type that is an instance of [S]. *) -module type Instance = sig - module Types : Types - - module Key : sig - type t = int Types.key [@@deriving compare, equal, quickcheck, sexp_of] - - include Comparable.Infix with type t := t - end - - type 'a t = (int, 'a, Int.comparator_witness) Types.t - [@@deriving equal, quickcheck, sexp_of] - - (** Construct a [Key.t]. *) - val key : int -> Key.t - - (** Extract an int from a [Key.t]. *) - val int : Key.t -> int - - (** Extract a tree (without a comparator) from [t]. *) - val tree - : (Key.t, 'a, Int.comparator_witness) Types.tree - -> (Key.t, 'a, Int.comparator_witness Types.cmp) Map.Using_comparator.Tree.t - - (** Pass a comparator to a creator function, if necessary. *) - val create : (int, Int.comparator_witness, 'a) Types.create_options -> 'a - - (** Pass a comparator to an accessor function, if necessary *) - val access : (int, Int.comparator_witness, 'a) Types.access_options -> 'a -end - -(** A functor to generate all of [Instance] but [create] and [access] for a map type. *) module Instance (Cmp : sig type comparator_witness @@ -128,13 +74,6 @@ struct ;; end -(** Instantiating key and data both as [int]. *) -module Instance_int = struct - module I = Instance (Int) - - type t = int I.t [@@deriving equal, quickcheck, sexp_of] -end - (** A functor like [Instance], but for tree types. *) module Instance_tree (Cmp : sig type comparator_witness @@ -162,7 +101,7 @@ struct 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:Int.comparator equal_a + 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 @@ -208,7 +147,7 @@ struct ;; end -(** Expect tests for everything exported from [Map.Creators_and_accessors_generic]. *) +(* Used in [test__*.ml]. *) module Test_creators_and_accessors (Types : Types) (Impl : S with module Types := Types) @@ -290,24 +229,22 @@ module Test_creators_and_accessors (** creators *) let empty = empty - - let%expect_test _ = - print_s [%sexp (create empty : int t)]; - [%expect {| () |}] - ;; - + let () = require_equal [%here] (module Sexp) [%sexp (create empty : int t)] [%sexp []] let singleton = singleton - let%expect_test _ = - print_s [%sexp (create singleton (key 1) 2 : int t)]; - [%expect {| ((1 2)) |}] + 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%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -328,15 +265,14 @@ module Test_creators_and_accessors 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); - [%expect {| |}] + 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%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -355,15 +291,14 @@ module Test_creators_and_accessors (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); - [%expect {| |}] + 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%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -379,15 +314,14 @@ module Test_creators_and_accessors 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); - [%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%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -406,8 +340,7 @@ module Test_creators_and_accessors 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); - [%expect {| |}] + require_equal [%here] (module Inst_multi) t_reduce expect) ;; let of_list_with_key = of_list_with_key @@ -417,7 +350,7 @@ module Test_creators_and_accessors let of_list_with_key_fold = of_list_with_key_fold let of_list_with_key_reduce = of_list_with_key_reduce - let%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -458,13 +391,12 @@ module Test_creators_and_accessors (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)); - [%expect {| |}] + (create of_alist_multi alist)) ;; let of_increasing_sequence = of_increasing_sequence - let%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -477,13 +409,12 @@ module Test_creators_and_accessors then create of_alist_or_error alist else Or_error.error_string "decreasing keys" in - require_equal [%here] (module Ok (Inst)) actual expect); - [%expect {| |}] + require_equal [%here] (module Ok (Inst)) actual expect) ;; let of_sorted_array = of_sorted_array - let%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -496,13 +427,12 @@ module Test_creators_and_accessors then create of_alist_or_error alist else Or_error.error_string "unsorted" in - require_equal [%here] (module Ok (Inst)) actual expect); - [%expect {| |}] + require_equal [%here] (module Ok (Inst)) actual expect) ;; let of_sorted_array_unchecked = of_sorted_array_unchecked - let%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -515,13 +445,12 @@ module Test_creators_and_accessors 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); - [%expect {| |}] + require_equal [%here] (module Inst) actual_rev expect) ;; let of_increasing_iterator_unchecked = of_increasing_iterator_unchecked - let%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -538,14 +467,13 @@ module Test_creators_and_accessors ~f:(Array.get array) in let expect = create of_alist_exn alist in - require_equal [%here] (module Inst) actual expect); - [%expect {| |}] + require_equal [%here] (module Inst) actual expect) ;; let of_iteri = of_iteri let of_iteri_exn = of_iteri_exn - let%expect_test _ = + let () = quickcheck_m [%here] (module Alist) @@ -559,14 +487,13 @@ module Test_creators_and_accessors 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); - [%expect {| |}] + require_equal [%here] (module Ok (Inst)) actual_exn expect) ;; let map_keys = map_keys let map_keys_exn = map_keys_exn - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -584,13 +511,12 @@ module Test_creators_and_accessors |> 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); - [%expect {| |}] + require_equal [%here] (module Ok (Inst)) actual_exn expect) ;; let transpose_keys = transpose_keys - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_inst) @@ -603,38 +529,35 @@ module Test_creators_and_accessors [%here] (module Inst_inst) (filter t ~f:(Fn.non is_empty)) - round_trip); - [%expect {| |}] + round_trip) ;; (** accessors *) let invariants = invariants - let%expect_test _ = - quickcheck_m [%here] (module Inst) ~f:(fun t -> require [%here] (access invariants t)); - [%expect {| |}] + let () = + quickcheck_m [%here] (module Inst) ~f:(fun t -> require [%here] (access invariants t)) ;; let is_empty = is_empty let length = length - let%expect_test _ = + 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))); - [%expect {| |}] + require_equal [%here] (module Int) len (List.length (to_alist t))) ;; let mem = mem let find = find let find_exn = find_exn - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -646,13 +569,12 @@ module Test_creators_and_accessors [%here] (module Opt (Int)) (Option.try_with (fun () -> access find_exn t key)) - expect); - [%expect {| |}] + expect) ;; let set = set - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key_and_data) @@ -663,14 +585,13 @@ module Test_creators_and_accessors (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))); - [%expect {| |}] + ((key, data) :: List.Assoc.remove (to_alist t) key ~equal:Key.equal))) ;; let add = add let add_exn = add_exn - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key_and_data) @@ -687,13 +608,12 @@ module Test_creators_and_accessors 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); - [%expect {| |}] + require_equal [%here] (module Ok (Inst)) t_add_exn expect) ;; let remove = remove - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -702,13 +622,12 @@ module Test_creators_and_accessors [%here] (module Alist) (to_alist (access remove t key)) - (List.Assoc.remove (to_alist t) key ~equal:Key.equal)); - [%expect {| |}] + (List.Assoc.remove (to_alist t) key ~equal:Key.equal)) ;; let change = change - let%expect_test _ = + let () = quickcheck_m [%here] (module struct @@ -718,7 +637,6 @@ module Test_creators_and_accessors let actual = access change t key ~f:(fun previous -> require_equal [%here] (module Opt (Int)) previous (access find t key); - [%expect {| |}]; maybe_data) in let expect = @@ -726,13 +644,12 @@ module Test_creators_and_accessors | None -> access remove t key | Some data -> access set t ~key ~data in - require_equal [%here] (module Inst) actual expect); - [%expect {| |}] + require_equal [%here] (module Inst) actual expect) ;; let update = update - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key_and_data) @@ -740,19 +657,17 @@ module Test_creators_and_accessors let actual = access update t key ~f:(fun previous -> require_equal [%here] (module Opt (Int)) previous (access find t key); - [%expect {| |}]; data) in let expect = access set t ~key ~data in - require_equal [%here] (module Inst) actual expect); - [%expect {| |}] + require_equal [%here] (module Inst) actual expect) ;; let find_multi = find_multi let add_multi = add_multi let remove_multi = remove_multi - let%expect_test _ = + let () = quickcheck_m [%here] (module struct @@ -775,15 +690,14 @@ module Test_creators_and_accessors (access remove_multi t key) (access change t key ~f:(function | None | Some ([] | [ _ ]) -> None - | Some (_ :: (_ :: _ as rest)) -> Some rest))); - [%expect {| |}] + | Some (_ :: (_ :: _ as rest)) -> Some rest))) ;; let iter_keys = iter_keys let iter = iter let iteri = iteri - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst) @@ -805,14 +719,13 @@ module Test_creators_and_accessors 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)); - [%expect {| |}] + require_equal [%here] (module Lst (Int)) actual (data t)) ;; let map = map let mapi = mapi - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst) @@ -828,8 +741,7 @@ module Test_creators_and_accessors 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)); - [%expect {| |}] + (t |> to_alist |> List.map ~f:(fun (k, v) -> k, (k, v)) |> create of_alist_exn)) ;; let filter_keys = filter_keys @@ -845,7 +757,7 @@ module Test_creators_and_accessors let equal a b = phys_equal a b end - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key_and_data) @@ -869,14 +781,13 @@ module Test_creators_and_accessors [%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))); - [%expect {| |}] + (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%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key_and_data) @@ -894,8 +805,7 @@ module Test_creators_and_accessors (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)))); - [%expect {| |}] + Option.some_if (Key.( <= ) key k && data >= d) (key, data - d)))) ;; let partition_mapi = partition_mapi @@ -903,7 +813,7 @@ module Test_creators_and_accessors let partitioni_tf = partitioni_tf let partition_tf = partition_tf - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key_and_data) @@ -949,14 +859,13 @@ module Test_creators_and_accessors (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)))); - [%expect {| |}] + else Second (key, d)))) ;; let fold = fold let fold_right = fold_right - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst) @@ -970,14 +879,13 @@ module Test_creators_and_accessors [%here] (module Alist) (fold_right t ~init:[] ~f:(fun ~key ~data list -> (key, data) :: list)) - (to_alist t)); - [%expect {| |}] + (to_alist t)) ;; let fold_until = fold_until let iteri_until = iteri_until - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -1003,13 +911,12 @@ module Test_creators_and_accessors |> 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)); - [%expect {| |}] + list, if List.length list = length t then Finished else Unfinished)) ;; let combine_errors = combine_errors - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -1026,13 +933,12 @@ module Test_creators_and_accessors |> 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))); - [%expect {| |}] + |> Or_error.map ~f:(create of_alist_exn))) ;; let unzip = unzip - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_pair) @@ -1044,14 +950,13 @@ module Test_creators_and_accessors to_alist a, to_alist b) (to_alist t |> List.map ~f:(fun (key, (a, b)) -> (key, a), (key, b)) - |> List.unzip)); - [%expect {| |}] + |> List.unzip)) ;; let equal = equal let compare_direct = compare_direct - let%expect_test _ = + let () = quickcheck_m [%here] (module Pair (Inst)) @@ -1065,8 +970,7 @@ module Test_creators_and_accessors [%here] (module Bool) (access compare_direct Int.compare a b = 0) - (access equal Int.equal a b)); - [%expect {| |}] + (access equal Int.equal a b)) ;; let keys = keys @@ -1074,7 +978,7 @@ module Test_creators_and_accessors let to_alist = to_alist let to_sequence = to_sequence - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst) @@ -1087,11 +991,10 @@ module Test_creators_and_accessors [%here] (module Alist) (Sequence.to_list ((access to_sequence) t)) - alist); - [%expect {| |}] + alist) ;; - let%expect_test _ = + let () = quickcheck_m [%here] (module struct @@ -1116,11 +1019,10 @@ module Test_creators_and_accessors ~order: (match key_order with | `Decreasing -> `Decreasing_key - | `Increasing -> `Increasing_key)))); - [%expect {| |}] + | `Increasing -> `Increasing_key)))) ;; - let%expect_test _ = + let () = quickcheck_m [%here] (module struct @@ -1146,15 +1048,14 @@ module Test_creators_and_accessors | `Increasing_key -> to_alist t) ~f:(fun (key, _) -> Key.( <= ) keys_greater_or_equal_to key - && Key.( <= ) key keys_less_or_equal_to))); - [%expect {| |}] + && Key.( <= ) key keys_less_or_equal_to))) ;; let merge = merge let iter2 = iter2 let fold2 = fold2 - let%expect_test _ = + let () = quickcheck_m [%here] (module struct @@ -1195,13 +1096,12 @@ module Test_creators_and_accessors 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); - [%expect {| |}] + require_equal [%here] (module Alist_merge) fold2_alist expect) ;; let merge_disjoint_exn = merge_disjoint_exn - let%expect_test _ = + let () = quickcheck_m [%here] (module Pair (Inst)) @@ -1217,13 +1117,12 @@ module Test_creators_and_accessors | `Left x | `Right x -> Some x | `Both _ -> assert false)) in - require_equal [%here] (module Opt (Inst)) actual expect); - [%expect {| |}] + require_equal [%here] (module Opt (Inst)) actual expect) ;; let merge_skewed = merge_skewed - let%expect_test _ = + let () = quickcheck_m [%here] (module Pair (Inst)) @@ -1236,14 +1135,13 @@ module Test_creators_and_accessors | `Right b -> Some b | `Both (a, b) -> Some (int key + a + b)) in - require_equal [%here] (module Inst) actual expect); - [%expect {| |}] + require_equal [%here] (module Inst) actual expect) ;; let symmetric_diff = symmetric_diff let fold_symmetric_diff = fold_symmetric_diff - let%expect_test _ = + let () = quickcheck_m [%here] (module Pair (Inst)) @@ -1270,8 +1168,7 @@ module Test_creators_and_accessors |> to_alist in require_equal [%here] (module Diff) diff_alist expect; - require_equal [%here] (module Diff) fold_alist expect); - [%expect {| |}] + require_equal [%here] (module Diff) fold_alist expect) ;; let min_elt = min_elt @@ -1279,7 +1176,7 @@ module Test_creators_and_accessors let min_elt_exn = min_elt_exn let max_elt_exn = max_elt_exn - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst) @@ -1303,8 +1200,7 @@ module Test_creators_and_accessors [%here] (module Opt (Key_and_data)) (Option.try_with (fun () -> max_elt_exn t)) - (List.last (to_alist t))); - [%expect {| |}] + (List.last (to_alist t))) ;; let for_all = for_all @@ -1314,7 +1210,7 @@ module Test_creators_and_accessors let count = count let counti = counti - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key_and_data) @@ -1329,14 +1225,13 @@ module Test_creators_and_accessors 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)); - [%expect {| |}] + require_equal [%here] (module Int) (counti t ~f:fi) (List.count alist ~f:fp)) ;; let sum = sum let sumi = sumi - let%expect_test "sum" = + let () = quickcheck_m [%here] (module Inst) @@ -1348,13 +1243,12 @@ module Test_creators_and_accessors 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)); - [%expect {| |}] + require_equal [%here] (module Int) (sumi m t ~f:fi) (List.sum m alist ~f:fp)) ;; let split = split - let%expect_test "split" = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -1372,13 +1266,12 @@ module Test_creators_and_accessors | Equal -> `Snd (key, data) | Greater -> `Trd (key, data)) in - create of_alist_exn before, List.hd equal, create of_alist_exn after)); - [%expect {| |}] + create of_alist_exn before, List.hd equal, create of_alist_exn after)) ;; let split_le_gt = split_le_gt - let%expect_test "split_le_gt" = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -1392,13 +1285,12 @@ module Test_creators_and_accessors (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)); - [%expect {| |}] + create of_alist_exn before, create of_alist_exn after)) ;; let split_lt_ge = split_lt_ge - let%expect_test "split_lt_ge" = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -1412,13 +1304,12 @@ module Test_creators_and_accessors (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)); - [%expect {| |}] + create of_alist_exn before, create of_alist_exn after)) ;; let append = append - let%expect_test _ = + let () = quickcheck_m [%here] (module Pair (Inst)) @@ -1443,15 +1334,14 @@ module Test_creators_and_accessors (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)))); - [%expect {| |}] + (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%expect_test _ = + let () = quickcheck_m [%here] (module struct @@ -1498,13 +1388,12 @@ module Test_creators_and_accessors 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); - [%expect {| |}] + require_equal [%here] (module Alist) range_alist expect) ;; let closest_key = closest_key - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -1530,15 +1419,14 @@ module Test_creators_and_accessors [%here] (module Opt (Key_and_data)) (access closest_key t `Greater_than k) - (List.find alist ~f:(fun (key, _) -> Key.( > ) key k))); - [%expect {| |}] + (List.find alist ~f:(fun (key, _) -> Key.( > ) key k))) ;; let nth = nth let nth_exn = nth_exn let rank = rank - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -1557,13 +1445,12 @@ module Test_creators_and_accessors (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))); - [%expect {| |}] + Option.some_if (Key.equal key k) i))) ;; let binary_search = binary_search - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -1580,19 +1467,17 @@ module Test_creators_and_accessors ~compare:(fun ~key ~data k' -> require_equal [%here] (module Key) k' k; require_equal [%here] (module Opt (Int)) (access find t key) (Some data); - [%expect {| |}]; 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)))); - [%expect {| |}] + |> Option.map ~f:(Array.get array)))) ;; let binary_search_segmented = binary_search_segmented - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst_and_key) @@ -1608,18 +1493,16 @@ module Test_creators_and_accessors t ~segment_of:(fun ~key ~data -> require_equal [%here] (module Opt (Int)) (access find t key) (Some data); - [%expect {| |}]; 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)))); - [%expect {| |}] + |> Option.map ~f:(Array.get array)))) ;; let binary_search_subrange = binary_search_subrange - let%expect_test _ = + let () = quickcheck_m [%here] (module struct @@ -1635,12 +1518,10 @@ module Test_creators_and_accessors t ~compare:(fun ~key ~data bound -> require_equal [%here] (module Opt (Int)) (access find t key) (Some data); - [%expect {| |}]; Key.compare key bound) ~lower_bound ~upper_bound) - (access subrange t ~lower_bound ~upper_bound)); - [%expect {| |}] + (access subrange t ~lower_bound ~upper_bound)) ;; module Make_applicative_traversals (A : Applicative.Lazy_applicative) = struct @@ -1650,7 +1531,7 @@ module Test_creators_and_accessors let filter_mapi = M.filter_mapi end - let%expect_test _ = + let () = let module M = Make_applicative_traversals (struct module M = struct @@ -1673,8 +1554,7 @@ module Test_creators_and_accessors 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)); - [%expect {| |}] + require_equal [%here] (module Inst) (filter_mapi t ~f:f2) (M.filter_mapi t ~f:f2)) ;; (** tree conversion *) @@ -1682,7 +1562,7 @@ module Test_creators_and_accessors let to_tree = to_tree let of_tree = of_tree - let%expect_test _ = + let () = quickcheck_m [%here] (module Inst) @@ -1694,392 +1574,6 @@ module Test_creators_and_accessors [%here] (module Alist) (to_alist t) - (Map.Using_comparator.Tree.to_alist (Instance.tree tree))); - [%expect {| |}] - ;; -end - -(** Expect tests for all of [Base.Map]'s exports. *) -module _ : module type of struct - include Base.Map -end [@ocaml.remove_aliases] = struct - open Base.Map - - (** module types *) - - module type Accessors_generic = Accessors_generic - module type Creators_and_accessors_generic = Creators_and_accessors_generic - module type Creators_generic = Creators_generic - module type For_deriving = For_deriving - module type S_poly = S_poly - - (** type-only modules for module type instantiation - untested *) - - module With_comparator = With_comparator - module With_first_class_module = With_first_class_module - module Without_comparator = Without_comparator - - (** supporting datatypes - untested *) - - module Continue_or_stop = Continue_or_stop - module Finished_or_unfinished = Finished_or_unfinished - module Merge_element = Merge_element - module Or_duplicate = Or_duplicate - module Symmetric_diff_element = Symmetric_diff_element - - (** types *) - - type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t - type nonrec ('k, 'c) comparator = ('k, 'c) Comparator.Module.t - - (** module types for ppx deriving *) - - module type Compare_m = Compare_m - module type Equal_m = Equal_m - module type Hash_fold_m = Hash_fold_m - module type M_sexp_grammar = M_sexp_grammar - module type M_of_sexp = M_of_sexp - module type Sexp_of_m = Sexp_of_m - - (** functor for ppx deriving - tested below *) - - module M = M - - (** sexp conversions and grammar *) - - let sexp_of_m__t = sexp_of_m__t - let m__t_of_sexp = m__t_of_sexp - - let%expect_test _ = - quickcheck_m - [%here] - (module Instance_int) - ~f:(fun t -> - let sexp = [%sexp_of: int M(Int).t] t in - require_equal [%here] (module Sexp) sexp [%sexp (to_alist t : (int * int) list)]; - let round_trip = [%of_sexp: int M(Int).t] sexp in - require_equal [%here] (module Instance_int) round_trip t); - [%expect {| |}] - ;; - - let m__t_sexp_grammar = m__t_sexp_grammar - - let%expect_test _ = - print_s [%sexp ([%sexp_grammar: int M(Int).t] : _ Sexp_grammar.t)]; - [%expect - {| - (Tagged ( - (key sexp_grammar.assoc) - (value ()) - (grammar ( - List ( - Many ( - List ( - Cons - (Tagged ((key sexp_grammar.assoc.key) (value ()) (grammar Integer))) - (Cons - (Tagged ( - (key sexp_grammar.assoc.value) (value ()) (grammar Integer))) - Empty)))))))) |}] + (Map.Using_comparator.Tree.to_alist (Instance.tree tree))) ;; - - (** comparisons *) - - let compare_m__t = compare_m__t - let equal_m__t = equal_m__t - - let%expect_test _ = - quickcheck_m - [%here] - (module Pair (Instance_int)) - ~f:(fun (a, b) -> - require_equal - [%here] - (module Ordering) - (Ordering.of_int ([%compare: int M(Int).t] a b)) - (Ordering.of_int ([%compare: (int * int) list] (to_alist a) (to_alist b))); - require_equal - [%here] - (module Bool) - ([%equal: int M(Int).t] a b) - ([%equal: (int * int) list] (to_alist a) (to_alist b))); - [%expect {| |}] - ;; - - (** hash functions *) - - let hash_fold_m__t = hash_fold_m__t - let hash_fold_direct = hash_fold_direct - - let%expect_test _ = - quickcheck_m - [%here] - (module Instance_int) - ~f:(fun t -> - let actual_m = Hash.run [%hash_fold: int M(Int).t] t in - let actual_direct = - Hash.run (hash_fold_direct Int.hash_fold_t Int.hash_fold_t) t - in - let expect = Hash.run [%hash_fold: (int * int) list] (to_alist t) in - require_equal [%here] (module Int) actual_m expect; - require_equal [%here] (module Int) actual_direct expect); - [%expect {| |}] - ;; - - (** comparator accessors - untested *) - - let comparator_s = comparator_s - let comparator = comparator - - (** creators and accessors *) - - include - Test_creators_and_accessors - (struct - type 'k key = 'k - type 'c cmp = 'c - type ('k, 'v, 'c) tree = ('k, 'v, 'c) Using_comparator.Tree.t - type ('k, 'c, 'a) create_options = ('k, 'c) comparator -> 'a - type ('k, 'c, 'a) access_options = 'a - - include Base.Map - end) - (struct - include Base.Map - end) - (struct - include Instance (Int) - - let create f = f ((module Int) : _ Comparator.Module.t) - let access x = x - end) - - (** polymorphic comparison interface *) - module Poly = struct - open Poly - - type nonrec ('k, 'v) t = ('k, 'v) t - type nonrec ('k, 'v) tree = ('k, 'v) tree - type nonrec comparator_witness = comparator_witness - - include - Test_creators_and_accessors - (struct - type 'k key = 'k - type 'c cmp = comparator_witness - type nonrec ('k, 'v, _) t = ('k, 'v) t - type nonrec ('k, 'v, _) tree = ('k, 'v) tree - type ('k, 'c, 'a) create_options = 'a - type ('k, 'c, 'a) access_options = 'a - end) - (struct - include Poly - end) - (struct - include Instance (Comparator.Poly) - - let create x = x - let access x = x - end) - end - - (** comparator interface *) - - module Using_comparator = struct - open Using_comparator - - (** type *) - - type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t - - (** comparator accessor - untested *) - - let comparator = comparator - - (** sexp conversions *) - - let sexp_of_t = sexp_of_t - let t_of_sexp_direct = t_of_sexp_direct - - let%expect_test _ = - quickcheck_m - [%here] - (module Instance_int) - ~f:(fun t -> - let sexp = sexp_of_t Int.sexp_of_t Int.sexp_of_t [%sexp_of: _] t in - require_equal [%here] (module Sexp) sexp ([%sexp_of: int Map.M(Int).t] t); - let round_trip = - t_of_sexp_direct ~comparator:Int.comparator Int.t_of_sexp Int.t_of_sexp sexp - in - require_equal [%here] (module Instance_int) round_trip t); - [%expect {| |}] - ;; - - (** hash function *) - - let hash_fold_direct = hash_fold_direct - - let%expect_test _ = - quickcheck_m - [%here] - (module Instance_int) - ~f:(fun t -> - require_equal - [%here] - (module Int) - (Hash.run (hash_fold_direct Int.hash_fold_t Int.hash_fold_t) t) - (Hash.run [%hash_fold: int Map.M(Int).t] t)); - [%expect {| |}] - ;; - - (** functor for polymorphic definition - untested *) - - module Empty_without_value_restriction (Cmp : Comparator.S1) = struct - open Empty_without_value_restriction (Cmp) - - let empty = empty - end - - (** creators and accessors *) - - include - Test_creators_and_accessors - (struct - type 'k key = 'k - type 'c cmp = 'c - type ('k, 'v, 'c) tree = ('k, 'v, 'c) Tree.t - type ('k, 'c, 'a) create_options = comparator:('k, 'c) Comparator.t -> 'a - type ('k, 'c, 'a) access_options = 'a - - include Using_comparator - end) - (struct - include Using_comparator - end) - (struct - include Instance (Int) - - let create f = f ~comparator:Int.comparator - let access x = x - end) - - (** tree interface *) - - module Tree = struct - open Tree - - (** type *) - - type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t - - (** sexp conversions *) - - let sexp_of_t = sexp_of_t - let t_of_sexp_direct = t_of_sexp_direct - - let%expect_test _ = - let module Tree_int = struct - module I = Instance_tree (Int) - - type t = int I.t [@@deriving equal, quickcheck, sexp_of] - end - in - quickcheck_m - [%here] - (module Tree_int) - ~f:(fun tree -> - let sexp = sexp_of_t Int.sexp_of_t Int.sexp_of_t [%sexp_of: _] tree in - require_equal - [%here] - (module Sexp) - sexp - ([%sexp_of: int Map.M(Int).t] - (Using_comparator.of_tree tree ~comparator:Int.comparator)); - let round_trip = - t_of_sexp_direct ~comparator:Int.comparator Int.t_of_sexp Int.t_of_sexp sexp - in - require_equal [%here] (module Tree_int) round_trip tree); - [%expect {| |}] - ;; - - (** polymorphic constructor - untested *) - - let empty_without_value_restriction = empty_without_value_restriction - - (** builders *) - - module Build_increasing = struct - open Build_increasing - - type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t - - (** tree builder functions *) - - let empty = empty - let add_exn = add_exn - let to_tree = to_tree - - let%expect_test _ = - let module Tree_int = struct - module I = Instance_tree (Int) - - type t = int I.t [@@deriving equal, quickcheck, sexp_of] - end - in - quickcheck_m - [%here] - (module struct - type t = - ((int[@generator Base_quickcheck.Generator.small_strictly_positive_int]) - * int) - list - [@@deriving quickcheck, sexp_of] - end) - ~f:(fun alist -> - let actual = - List.fold_result alist ~init:empty ~f:(fun builder (key, data) -> - Or_error.try_with (fun () -> - add_exn builder ~comparator:Int.comparator ~key ~data)) - |> Or_error.map ~f:to_tree - in - Or_error.iter actual ~f:(fun map -> - require [%here] (Tree.invariants map ~comparator:Int.comparator)); - let expect = - match List.is_sorted_strictly alist ~compare:[%compare: int * _] with - | false -> Error (Error.of_string "not sorted") - | true -> - Ok - (Map.Using_comparator.Tree.of_sequence_exn - ~comparator:Int.comparator - (Sequence.of_list alist)) - in - require_equal [%here] (module Ok (Tree_int)) actual expect); - [%expect {| |}] - ;; - end - - (** creators and accessors *) - - include - Test_creators_and_accessors - (struct - type 'k key = 'k - type 'c cmp = 'c - type ('k, 'v, 'c) tree = ('k, 'v, 'c) t - type ('k, 'c, 'a) create_options = comparator:('k, 'c) Comparator.t -> 'a - type ('k, 'c, 'a) access_options = comparator:('k, 'c) Comparator.t -> 'a - - include Tree - end) - (struct - include Tree - end) - (struct - include Instance_tree (Int) - - let create f = f ~comparator:Int.comparator - let access f = f ~comparator:Int.comparator - end) - end - end end diff --git a/test/map_full_interface/functor.mli b/test/map_full_interface/functor.mli new file mode 100644 index 00000000..b831749b --- /dev/null +++ b/test/map_full_interface/functor.mli @@ -0,0 +1 @@ +include Functor_intf.Functor diff --git a/test/map_full_interface/functor_intf.ml b/test/map_full_interface/functor_intf.ml new file mode 100644 index 00000000..b568dfc7 --- /dev/null +++ b/test/map_full_interface/functor_intf.ml @@ -0,0 +1,130 @@ +open! Base + +module Definitions = struct + (** The types that distinguish instances of [Map.Creators_and_accessors_generic]. *) + module type Types = sig + type 'k key + type 'c cmp + type ('k, 'v, 'c) t + type ('k, 'v, 'c) tree + type ('k, 'c, 'a) create_options + type ('k, 'c, 'a) access_options + end + + (** Like [Map.Creators_and_accessors_generic], but based on [Types] for easier + instantiation. *) + module type S = sig + module Types : Types + + include + Map.Creators_and_accessors_generic + with type ('a, 'b, 'c) t := ('a, 'b, 'c) Types.t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Types.tree + with type 'a key := 'a Types.key + with type 'a cmp := 'a Types.cmp + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Types.create_options + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Types.access_options + end + + (** Helpers for testing a tree or map type that is an instance of [S]. *) + module type Instance = sig + module Types : Types + + module Key : sig + type t = int Types.key [@@deriving compare, equal, quickcheck, sexp_of] + + include Comparable.Infix with type t := t + end + + type 'a t = (int, 'a, Int.comparator_witness) Types.t + [@@deriving equal, quickcheck, sexp_of] + + (** Construct a [Key.t]. *) + val key : int -> Key.t + + (** Extract an int from a [Key.t]. *) + val int : Key.t -> int + + (** Extract a tree (without a comparator) from [t]. *) + val tree + : (Key.t, 'a, Int.comparator_witness) Types.tree + -> (Key.t, 'a, Int.comparator_witness Types.cmp) Map.Using_comparator.Tree.t + + (** Pass a comparator to a creator function, if necessary. *) + val create : (int, Int.comparator_witness, 'a) Types.create_options -> 'a + + (** Pass a comparator to an accessor function, if necessary *) + val access : (int, Int.comparator_witness, 'a) Types.access_options -> 'a + end +end + +module type Functor = sig + include module type of struct + include Definitions + end + + (** Expect tests for everything exported from [Map.Creators_and_accessors_generic]. *) + module Test_creators_and_accessors + (Types : Types) + (Impl : S with module Types := Types) + (Instance : Instance with module Types := Types) : S with module Types := Types + + (** A functor to generate all of [Instance] but [create] and [access] for a map type. *) + module Instance (Cmp : sig + type comparator_witness + + val comparator : (int, comparator_witness) Comparator.t + end) : sig + module Key : sig + type t = int [@@deriving compare, equal, quickcheck, sexp_of] + + include + Comparator.S with type t := t and type comparator_witness = Cmp.comparator_witness + + include Comparable.Infix with type t := t + end + + type 'a t = 'a Map.M(Key).t [@@deriving equal, quickcheck, sexp_of] + + val key : 'a -> 'a + val int : 'a -> 'a + val tree : 'a -> 'a + 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) : sig + module Key : sig + type t = int [@@deriving compare, equal, quickcheck, sexp_of] + + include + Comparator.S + with type t := int + and type comparator_witness = Cmp.comparator_witness + + include Comparable.Infix with type t := t + end + + type 'a t = (int, 'a, Cmp.comparator_witness) Map.Using_comparator.Tree.t + [@@deriving equal, quickcheck, sexp_of] + + val key : 'a -> 'a + val int : 'a -> 'a + val tree : 'a -> 'a + end + + module Ok (T : sig + type t [@@deriving equal, sexp_of] + end) : sig + type t = T.t Or_error.t [@@deriving equal, sexp_of] + end + + module Pair (T : sig + type t [@@deriving equal, quickcheck, sexp_of] + end) : sig + type t = T.t * T.t [@@deriving equal, quickcheck, sexp_of] + end +end diff --git a/test/map_full_interface/test_all.ml b/test/map_full_interface/test_all.ml new file mode 100644 index 00000000..be1c303b --- /dev/null +++ b/test/map_full_interface/test_all.ml @@ -0,0 +1,315 @@ +open! Base +open Base_quickcheck +open Expect_test_helpers_base +open Functor +open Map + +open struct + (** Instantiating key and data both as [int]. *) + module Instance_int = struct + module I = Instance (Int) + + type t = int I.t [@@deriving equal, quickcheck, sexp_of] + end +end + +(** module types *) + +module type Accessors_generic = Accessors_generic +module type Creators_and_accessors_generic = Creators_and_accessors_generic +module type Creators_generic = Creators_generic +module type For_deriving = For_deriving +module type S_poly = S_poly + +(** type-only modules for module type instantiation - untested *) + +module With_comparator = With_comparator +module With_first_class_module = With_first_class_module +module Without_comparator = Without_comparator + +(** supporting datatypes - untested *) + +module Continue_or_stop = Continue_or_stop +module Finished_or_unfinished = Finished_or_unfinished +module Merge_element = Merge_element +module Or_duplicate = Or_duplicate +module Symmetric_diff_element = Symmetric_diff_element + +(** types *) + +type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t + +(** module types for ppx deriving *) + +module type Compare_m = Compare_m +module type Equal_m = Equal_m +module type Hash_fold_m = Hash_fold_m +module type M_sexp_grammar = M_sexp_grammar +module type M_of_sexp = M_of_sexp +module type Sexp_of_m = Sexp_of_m + +(** functor for ppx deriving - tested below *) + +module M = M + +(** sexp conversions and grammar *) + +let sexp_of_m__t = sexp_of_m__t +let m__t_of_sexp = m__t_of_sexp + +let%expect_test _ = + quickcheck_m + [%here] + (module Instance_int) + ~f:(fun t -> + let sexp = [%sexp_of: int M(Int).t] t in + require_equal [%here] (module Sexp) sexp [%sexp (to_alist t : (int * int) list)]; + let round_trip = [%of_sexp: int M(Int).t] sexp in + require_equal [%here] (module Instance_int) round_trip t); + [%expect {| |}] +;; + +let m__t_sexp_grammar = m__t_sexp_grammar + +let%expect_test _ = + print_s [%sexp ([%sexp_grammar: int M(Int).t] : _ Sexp_grammar.t)]; + [%expect + {| + (Tagged ( + (key sexp_grammar.assoc) + (value ()) + (grammar ( + List ( + Many ( + List ( + Cons + (Tagged ((key sexp_grammar.assoc.key) (value ()) (grammar Integer))) + (Cons + (Tagged ( + (key sexp_grammar.assoc.value) (value ()) (grammar Integer))) + Empty)))))))) + |}] +;; + +(** comparisons *) + +let compare_m__t = compare_m__t +let equal_m__t = equal_m__t + +let%expect_test _ = + quickcheck_m + [%here] + (module Pair (Instance_int)) + ~f:(fun (a, b) -> + require_equal + [%here] + (module Ordering) + (Ordering.of_int ([%compare: int M(Int).t] a b)) + (Ordering.of_int ([%compare: (int * int) list] (to_alist a) (to_alist b))); + require_equal + [%here] + (module Bool) + ([%equal: int M(Int).t] a b) + ([%equal: (int * int) list] (to_alist a) (to_alist b))); + [%expect {| |}] +;; + +(** hash functions *) + +let hash_fold_m__t = hash_fold_m__t +let hash_fold_direct = hash_fold_direct + +let%expect_test _ = + quickcheck_m + [%here] + (module Instance_int) + ~f:(fun t -> + let actual_m = Hash.run [%hash_fold: int M(Int).t] t in + let actual_direct = Hash.run (hash_fold_direct Int.hash_fold_t Int.hash_fold_t) t in + let expect = Hash.run [%hash_fold: (int * int) list] (to_alist t) in + require_equal [%here] (module Int) actual_m expect; + require_equal [%here] (module Int) actual_direct expect); + [%expect {| |}] +;; + +(** comparator accessors - untested *) + +let comparator_s = comparator_s +let comparator = comparator + +(** creators and accessors *) + +include (Test_toplevel : Test_toplevel.S) + +(** polymorphic comparison interface *) +module Poly = struct + open Poly + + type nonrec ('k, 'v) t = ('k, 'v) t + type nonrec ('k, 'v) tree = ('k, 'v) tree + type nonrec comparator_witness = comparator_witness + + include (Test_poly : Test_poly.S) +end + +(** comparator interface *) + +module Using_comparator = struct + open Using_comparator + + (** type *) + + type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t + + (** comparator accessor - untested *) + + let comparator = comparator + + (** sexp conversions *) + + let sexp_of_t = sexp_of_t + let t_of_sexp_direct = t_of_sexp_direct + + let%expect_test _ = + quickcheck_m + [%here] + (module Instance_int) + ~f:(fun t -> + let sexp = sexp_of_t Int.sexp_of_t Int.sexp_of_t [%sexp_of: _] t in + require_equal [%here] (module Sexp) sexp ([%sexp_of: int Map.M(Int).t] t); + let round_trip = + t_of_sexp_direct ~comparator:Int.comparator Int.t_of_sexp Int.t_of_sexp sexp + in + require_equal [%here] (module Instance_int) round_trip t); + [%expect {| |}] + ;; + + (** hash function *) + + let hash_fold_direct = hash_fold_direct + + let%expect_test _ = + quickcheck_m + [%here] + (module Instance_int) + ~f:(fun t -> + require_equal + [%here] + (module Int) + (Hash.run (hash_fold_direct Int.hash_fold_t Int.hash_fold_t) t) + (Hash.run [%hash_fold: int Map.M(Int).t] t)); + [%expect {| |}] + ;; + + (** functor for polymorphic definition - untested *) + + module Empty_without_value_restriction (Cmp : Comparator.S1) = struct + open Empty_without_value_restriction (Cmp) + + let empty = empty + end + + (** creators and accessors *) + + include (Test_using_comparator : Test_using_comparator.S) + + (** tree interface *) + + module Tree = struct + open Tree + + (** type *) + + type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t + + (** sexp conversions *) + + let sexp_of_t = sexp_of_t + let t_of_sexp_direct = t_of_sexp_direct + + let%expect_test _ = + let module Tree_int = struct + module I = Instance_tree (Int) + + type t = int I.t [@@deriving equal, quickcheck, sexp_of] + end + in + quickcheck_m + [%here] + (module Tree_int) + ~f:(fun tree -> + let sexp = sexp_of_t Int.sexp_of_t Int.sexp_of_t [%sexp_of: _] tree in + require_equal + [%here] + (module Sexp) + sexp + ([%sexp_of: int Map.M(Int).t] + (Using_comparator.of_tree tree ~comparator:Int.comparator)); + let round_trip = + t_of_sexp_direct ~comparator:Int.comparator Int.t_of_sexp Int.t_of_sexp sexp + in + require_equal [%here] (module Tree_int) round_trip tree); + [%expect {| |}] + ;; + + (** polymorphic constructor - untested *) + + let empty_without_value_restriction = empty_without_value_restriction + + (** builders *) + + module Build_increasing = struct + open Build_increasing + + type nonrec ('k, 'v, 'c) t = ('k, 'v, 'c) t + + (** tree builder functions *) + + let empty = empty + let add_exn = add_exn + let to_tree = to_tree + + let%expect_test _ = + let module Tree_int = struct + module I = Instance_tree (Int) + + type t = int I.t [@@deriving equal, quickcheck, sexp_of] + end + in + quickcheck_m + [%here] + (module struct + type t = + ((int[@generator Base_quickcheck.Generator.small_strictly_positive_int]) + * int) + list + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun alist -> + let actual = + List.fold_result alist ~init:empty ~f:(fun builder (key, data) -> + Or_error.try_with (fun () -> + add_exn builder ~comparator:Int.comparator ~key ~data)) + |> Or_error.map ~f:to_tree + in + Or_error.iter actual ~f:(fun map -> + require [%here] (Tree.invariants map ~comparator:Int.comparator)); + let expect = + match List.is_sorted_strictly alist ~compare:[%compare: int * _] with + | false -> Error (Error.of_string "not sorted") + | true -> + Ok + (Map.Using_comparator.Tree.of_sequence_exn + ~comparator:Int.comparator + (Sequence.of_list alist)) + in + require_equal [%here] (module Ok (Tree_int)) actual expect); + [%expect {| |}] + ;; + end + + (** creators and accessors *) + + include (Test_tree : Test_tree.S) + end +end diff --git a/test/map_full_interface/test_all.mli b/test/map_full_interface/test_all.mli new file mode 100644 index 00000000..834b2c55 --- /dev/null +++ b/test/map_full_interface/test_all.mli @@ -0,0 +1,5 @@ +open! Base + +include module type of struct + include Map +end [@remove_aliases] diff --git a/test/map_full_interface/test_poly.ml b/test/map_full_interface/test_poly.ml new file mode 100644 index 00000000..d1df570b --- /dev/null +++ b/test/map_full_interface/test_poly.ml @@ -0,0 +1,15 @@ +open! Base +include Test_poly_intf.Definitions +include (Base.Map.Poly : S) + +let%expect_test "[Base.Map.Poly] creators/accessors" = + let open + Functor.Test_creators_and_accessors (Types) (Base.Map.Poly) + (struct + include Functor.Instance (Comparator.Poly) + + let create x = x + let access x = x + end) in + [%expect {| |}] +;; diff --git a/test/map_full_interface/test_poly.mli b/test/map_full_interface/test_poly.mli new file mode 100644 index 00000000..bc6d76f5 --- /dev/null +++ b/test/map_full_interface/test_poly.mli @@ -0,0 +1 @@ +include Test_poly_intf.Test_poly diff --git a/test/map_full_interface/test_poly_intf.ml b/test/map_full_interface/test_poly_intf.ml new file mode 100644 index 00000000..5f3e7eba --- /dev/null +++ b/test/map_full_interface/test_poly_intf.ml @@ -0,0 +1,22 @@ +open! Base + +module Definitions = struct + module Types = struct + type 'key key = 'key + type 'cmp cmp = Comparator.Poly.comparator_witness + type ('key, 'data, 'cmp) t = ('key, 'data) Map.Poly.t + type ('key, 'data, 'cmp) tree = ('key, 'data) Map.Poly.tree + type ('key, 'cmp, 'fn) create_options = 'fn + type ('key, 'cmp, 'fn) access_options = 'fn + end + + module type S = Functor.S with module Types := Types +end + +module type Test_poly = sig + include module type of struct + include Definitions + end + + include S +end diff --git a/test/map_full_interface/test_toplevel.ml b/test/map_full_interface/test_toplevel.ml new file mode 100644 index 00000000..d0d9ca8d --- /dev/null +++ b/test/map_full_interface/test_toplevel.ml @@ -0,0 +1,15 @@ +open! Base +include Test_toplevel_intf.Definitions +include (Base.Map : S) + +let%expect_test "[Base.Map] creators/accessors" = + let open + Functor.Test_creators_and_accessors (Types) (Base.Map) + (struct + include Functor.Instance (Int) + + let create f = f ((module Int) : _ Comparator.Module.t) + let access x = x + end) in + [%expect {| |}] +;; diff --git a/test/map_full_interface/test_toplevel.mli b/test/map_full_interface/test_toplevel.mli new file mode 100644 index 00000000..038567e7 --- /dev/null +++ b/test/map_full_interface/test_toplevel.mli @@ -0,0 +1 @@ +include Test_toplevel_intf.Test_toplevel diff --git a/test/map_full_interface/test_toplevel_intf.ml b/test/map_full_interface/test_toplevel_intf.ml new file mode 100644 index 00000000..56ffc9cd --- /dev/null +++ b/test/map_full_interface/test_toplevel_intf.ml @@ -0,0 +1,22 @@ +open! Base + +module Definitions = struct + module Types = struct + type 'key key = 'key + type 'cmp cmp = 'cmp + type ('key, 'data, 'cmp) t = ('key, 'data, 'cmp) Map.t + type ('key, 'data, 'cmp) tree = ('key, 'data, 'cmp) Map.Using_comparator.Tree.t + type ('key, 'cmp, 'fn) create_options = ('key, 'cmp) Comparator.Module.t -> 'fn + type ('key, 'cmp, 'fn) access_options = 'fn + end + + module type S = Functor.S with module Types := Types +end + +module type Test_toplevel = sig + include module type of struct + include Definitions + end + + include S +end diff --git a/test/map_full_interface/test_tree.ml b/test/map_full_interface/test_tree.ml new file mode 100644 index 00000000..90747818 --- /dev/null +++ b/test/map_full_interface/test_tree.ml @@ -0,0 +1,15 @@ +open! Base +include Test_tree_intf.Definitions +include (Base.Map.Using_comparator.Tree : S) + +let%expect_test "[Base.Map.Using_comparator.Tree] creators/accessors" = + let open + Functor.Test_creators_and_accessors (Types) (Base.Map.Using_comparator.Tree) + (struct + include Functor.Instance_tree (Int) + + let create f = f ~comparator:Int.comparator + let access f = f ~comparator:Int.comparator + end) in + [%expect {| |}] +;; diff --git a/test/map_full_interface/test_tree.mli b/test/map_full_interface/test_tree.mli new file mode 100644 index 00000000..5181eb66 --- /dev/null +++ b/test/map_full_interface/test_tree.mli @@ -0,0 +1 @@ +include Test_tree_intf.Test_tree diff --git a/test/map_full_interface/test_tree_intf.ml b/test/map_full_interface/test_tree_intf.ml new file mode 100644 index 00000000..f375dcd9 --- /dev/null +++ b/test/map_full_interface/test_tree_intf.ml @@ -0,0 +1,22 @@ +open! Base + +module Definitions = struct + module Types = struct + type 'key key = 'key + type 'cmp cmp = 'cmp + type ('key, 'data, 'cmp) t = ('key, 'data, 'cmp) Map.Using_comparator.Tree.t + type ('key, 'data, 'cmp) tree = ('key, 'data, 'cmp) Map.Using_comparator.Tree.t + type ('key, 'cmp, 'fn) create_options = comparator:('key, 'cmp) Comparator.t -> 'fn + type ('key, 'cmp, 'fn) access_options = comparator:('key, 'cmp) Comparator.t -> 'fn + end + + module type S = Functor.S with module Types := Types +end + +module type Test_tree = sig + include module type of struct + include Definitions + end + + include S +end diff --git a/test/map_full_interface/test_using_comparator.ml b/test/map_full_interface/test_using_comparator.ml new file mode 100644 index 00000000..cf37efab --- /dev/null +++ b/test/map_full_interface/test_using_comparator.ml @@ -0,0 +1,15 @@ +open! Base +include Test_using_comparator_intf.Definitions +include (Base.Map.Using_comparator : S) + +let%expect_test "[Base.Map.Using_comparator] creators/accessors" = + let open + Functor.Test_creators_and_accessors (Types) (Base.Map.Using_comparator) + (struct + include Functor.Instance (Int) + + let create f = f ~comparator:Int.comparator + let access x = x + end) in + [%expect {| |}] +;; diff --git a/test/map_full_interface/test_using_comparator.mli b/test/map_full_interface/test_using_comparator.mli new file mode 100644 index 00000000..8a43dcd6 --- /dev/null +++ b/test/map_full_interface/test_using_comparator.mli @@ -0,0 +1 @@ +include Test_using_comparator_intf.Test_using_comparator diff --git a/test/map_full_interface/test_using_comparator_intf.ml b/test/map_full_interface/test_using_comparator_intf.ml new file mode 100644 index 00000000..7c134d9b --- /dev/null +++ b/test/map_full_interface/test_using_comparator_intf.ml @@ -0,0 +1,22 @@ +open! Base + +module Definitions = struct + module Types = struct + type 'key key = 'key + type 'cmp cmp = 'cmp + type ('key, 'data, 'cmp) t = ('key, 'data, 'cmp) Map.Using_comparator.t + type ('key, 'data, 'cmp) tree = ('key, 'data, 'cmp) Map.Using_comparator.Tree.t + type ('key, 'cmp, 'fn) create_options = comparator:('key, 'cmp) Comparator.t -> 'fn + type ('key, 'cmp, 'fn) access_options = 'fn + end + + module type S = Functor.S with module Types := Types +end + +module type Test_using_comparator = sig + include module type of struct + include Definitions + end + + include S +end diff --git a/test/test_am_testing.ml b/test/test_am_testing.ml index 539eac25..6e2940ec 100644 --- a/test/test_am_testing.ml +++ b/test/test_am_testing.ml @@ -3,6 +3,5 @@ open! Import let%expect_test _ = print_s [%sexp (Exported_for_specific_uses.am_testing : bool)]; - [%expect {| - true |}] + [%expect {| true |}] ;; diff --git a/test/test_applicative.ml b/test/test_applicative.ml index 45d4ba6e..afc751e8 100644 --- a/test/test_applicative.ml +++ b/test/test_applicative.ml @@ -111,8 +111,7 @@ module Test_applicative_s (A : Applicative.S with type 'a t := 'a Or_error.t) : test (Ok "o") (error "not okay"); [%expect {| (Error "not okay") |}]; test (error "no fst") (error "no snd"); - [%expect {| - (Error ("no fst" "no snd")) |}] + [%expect {| (Error ("no fst" "no snd")) |}] ;; let map3 = A.map3 @@ -130,8 +129,7 @@ module Test_applicative_s (A : Applicative.S with type 'a t := 'a Or_error.t) : test (Ok "o") (Ok "k") (error "not okay"); [%expect {| (Error "not okay") |}]; test (error "no 1st") (error "no 2nd") (error "no 3rd"); - [%expect {| - (Error ("no 1st" "no 2nd" "no 3rd")) |}] + [%expect {| (Error ("no 1st" "no 2nd" "no 3rd")) |}] ;; let all = A.all @@ -159,8 +157,7 @@ module Test_applicative_s (A : Applicative.S with type 'a t := 'a Or_error.t) : test [ Ok "o"; Ok "kay"; error "oh no!" ]; [%expect {| (Error "oh no!") |}]; test [ error "oh"; error "no"; error "!" ]; - [%expect {| - (Error (oh no !)) |}] + [%expect {| (Error (oh no !)) |}] ;; let all_unit = A.all_unit @@ -188,8 +185,7 @@ module Test_applicative_s (A : Applicative.S with type 'a t := 'a Or_error.t) : test [ Ok (); Ok (); error "oh no!" ]; [%expect {| (Error "oh no!") |}]; test [ error "oh"; error "no"; error "!" ]; - [%expect {| - (Error (oh no !)) |}] + [%expect {| (Error (oh no !)) |}] ;; module Applicative_infix = A.Applicative_infix @@ -266,8 +262,7 @@ let%expect_test _ = test (both a b); [%expect {| (Map2 A B) |}]; test (all_unit [ a; b; c; d ]); - [%expect {| - (Map2 (Map2 (Map2 (Map2 Return A) B) C) D) |}]; + [%expect {| (Map2 (Map2 (Map2 (Map2 Return A) B) C) D) |}]; test (a *> b); [%expect {| (Map2 A B) |}] ;; diff --git a/test/test_array.ml b/test/test_array.ml index 8a959c94..741cccce 100644 --- a/test/test_array.ml +++ b/test/test_array.ml @@ -1,5 +1,7 @@ open! Import -open! Array +open Base_quickcheck +open Expect_test_helpers_base +open Array let%test_module "Binary_searchable" = (module Test_binary_searchable.Test1 (struct @@ -160,23 +162,28 @@ let%expect_test "merge with duplicates" = test [| 1, "a1" |] [| 1, "a2" |]; [%expect {| ((1 a1) - (1 a2)) |}]; + (1 a2)) + |}]; test [| 1, "a1"; 2, "a1"; 3, "a1" |] [| 3, "a2"; 4, "a2"; 5, "a2" |]; - [%expect {| + [%expect + {| ((1 a1) (2 a1) (3 a1) (3 a2) (4 a2) - (5 a2)) |}]; + (5 a2)) + |}]; test [| 3, "a1"; 4, "a1"; 5, "a1" |] [| 1, "a2"; 2, "a2"; 3, "a2" |]; - [%expect {| + [%expect + {| ((1 a2) (2 a2) (3 a1) (3 a2) (4 a1) - (5 a1)) |}]; + (5 a1)) + |}]; test [| 1, "a1"; 3, "a1"; 3, "a1"; 5, "a1" |] [| 2, "a2"; 3, "a2"; 3, "a2"; 4, "a2" |]; [%expect {| @@ -187,14 +194,69 @@ let%expect_test "merge with duplicates" = (3 a2) (3 a2) (4 a2) - (5 a1)) |}] + (5 a1)) + |}] ;; let%test _ = foldi [||] ~init:13 ~f:(fun _ _ _ -> failwith "bad") = 13 let%test _ = foldi [| 13 |] ~init:17 ~f:(fun i ac x -> ac + i + x) = 30 let%test _ = foldi [| 13; 17 |] ~init:19 ~f:(fun i ac x -> ac + i + x) = 50 -let%test _ = counti [| 0; 1; 2; 3; 4 |] ~f:(fun idx x -> idx = x) = 5 -let%test _ = counti [| 0; 1; 2; 3; 4 |] ~f:(fun idx x -> idx = 4 - x) = 1 + +let%test_module "count{,i}" = + (module struct + let%expect_test "[Array.count{,i} = List.count{,i}]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal + [%here] + (module Int) + (list |> List.count ~f) + (list |> of_list |> count ~f)); + quickcheck_m + [%here] + (module struct + type t = int list * (int -> int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal + [%here] + (module Int) + (list |> List.counti ~f) + (list |> of_list |> counti ~f)) + ;; + + let%test _ = counti [| 0; 1; 2; 3; 4 |] ~f:(fun idx x -> idx = x) = 5 + let%test _ = counti [| 0; 1; 2; 3; 4 |] ~f:(fun idx x -> idx = 4 - x) = 1 + end) +;; + +let%test_module "{min,max}_elt" = + (module struct + let test_opt_selector arr_fun list_fun = + quickcheck_m + [%here] + (module struct + type t = int list [@@deriving sexp_of, quickcheck] + end) + ~f:(fun list -> + let arr = of_list list in + require_equal + [%here] + (module struct + type t = int option [@@deriving sexp_of, equal] + end) + (arr_fun arr ~compare:(fun x y -> Int.compare x y)) + (list_fun list ~compare:(fun x y -> Int.compare x y))) + ;; + + let%expect_test "min_elt" = test_opt_selector min_elt List.min_elt + let%expect_test "max_elt" = test_opt_selector max_elt List.max_elt + end) +;; let%test_unit _ = for i = 0 to 5 do @@ -603,7 +665,8 @@ let%expect_test "cartesian_product" = (2 a) (2 b) (3 a) - (3 b)) |}] + (3 b)) + |}] ;; let%expect_test "create_local" = diff --git a/test/test_backtrace.ml b/test/test_backtrace.ml index 439e7f3c..5a0cd3dc 100644 --- a/test/test_backtrace.ml +++ b/test/test_backtrace.ml @@ -10,6 +10,5 @@ let%expect_test _ = Backtrace.elide := true; Stdio.Out_channel.(output_string stdout) (Sexp.to_string (sexp_of_t (Exn.with_recording false ~f:Exn.most_recent))); - [%expect {| - ("") |}] + [%expect {| ("") |}] ;; diff --git a/test/test_base_containers_mono.ml b/test/test_base_containers_mono.ml new file mode 100644 index 00000000..c750fae0 --- /dev/null +++ b/test/test_base_containers_mono.ml @@ -0,0 +1,142 @@ +open! Import +open Test_container + +(* Tests of containers that are not polymorphic (i.e. have a fixed element type). *) + +include ( + Test_S0 (struct + include String + + let mem t c = mem t c + + module Elt = struct + type t = char [@@deriving sexp] + + let of_int = Char.of_int_exn + let to_int = Char.to_int + end + + let of_list = of_char_list + end) : + sig end) + +let%expect_test "Hash_set" = + Base_container_tests.test_container_s0 + (module struct + open Base_quickcheck + + module Elt = struct + include Int + + type t = (int[@generator Generator.small_strictly_positive_int]) + [@@deriving compare, equal, quickcheck, sexp_of] + end + + include Hash_set + + type t = Hash_set.M(Int).t [@@deriving sexp_of] + + let quickcheck_generator = + Generator.map [%generator: Elt.t list] ~f:(Hash_set.of_list (module Int)) + ;; + + let quickcheck_observer = Observer.unmap [%observer: Elt.t list] ~f:Hash_set.to_list + + let quickcheck_shrinker = + Shrinker.map + [%shrinker: Elt.t list] + ~f:(Hash_set.of_list (module Int)) + ~f_inverse:Hash_set.to_list + ;; + + (* [to_list] and [to_array] proceed in the opposite order as everything else. This + is likely a performance hack to reuse [fold] without adding a [List.rev]. It is + not particularly problematic, since hash table order is already unpredictable due + to hash functions. *) + let to_list t = List.rev (to_list t) + let to_array t = Array.rev (to_array t) + end); + [%expect + {| + Container: testing [length] + Container: testing [is_empty] + Container: testing [mem] + Container: testing [iter] + Container: testing [fold] + Container: testing [fold_result] + Container: testing [fold_until] + Container: testing [exists] + Container: testing [for_all] + Container: testing [count] + Container: testing [sum] + Container: testing [find] + Container: testing [find_map] + Container: testing [to_list] + Container: testing [to_array] + Container: testing [min_elt] + Container: testing [max_elt] + |}] +;; + +let%expect_test "String" = + Base_container_tests.test_indexed_container_s0_with_creators + (module struct + include String + + module Elt = struct + type t = char [@@deriving compare, equal, quickcheck, sexp_of] + end + + type t = string [@@deriving quickcheck] + + (* eta-expand due to [local_] types *) + let mem t c = mem t c + + (* leave off the [?sep] argument *) + let concat list = concat list + let concat_map list = concat_map list + let concat_mapi list = concat_mapi list + end); + [%expect + {| + Container: testing [length] + Container: testing [is_empty] + Container: testing [mem] + Container: testing [iter] + Container: testing [fold] + Container: testing [fold_result] + Container: testing [fold_until] + Container: testing [exists] + Container: testing [for_all] + Container: testing [count] + Container: testing [sum] + Container: testing [find] + Container: testing [find_map] + Container: testing [to_list] + Container: testing [to_array] + Container: testing [min_elt] + Container: testing [max_elt] + Container: testing [of_list] + Container: testing [of_array] + Container: testing [append] + Container: testing [concat] + Container: testing [map] + Container: testing [filter] + Container: testing [filter_map] + Container: testing [concat_map] + Container: testing [partition_tf] + Container: testing [partition_map] + Container: testing [foldi] + Container: testing [iteri] + Container: testing [existsi] + Container: testing [for_alli] + Container: testing [counti] + Container: testing [findi] + Container: testing [find_mapi] + Container: testing [init] + Container: testing [mapi] + Container: testing [filteri] + Container: testing [filter_mapi] + Container: testing [concat_mapi] + |}] +;; diff --git a/test/test_base_containers.mli b/test/test_base_containers_mono.mli similarity index 100% rename from test/test_base_containers.mli rename to test/test_base_containers_mono.mli diff --git a/test/test_base_containers.ml b/test/test_base_containers_poly.ml similarity index 62% rename from test/test_base_containers.ml rename to test/test_base_containers_poly.ml index 6233519c..77b007e7 100644 --- a/test/test_base_containers.ml +++ b/test/test_base_containers_poly.ml @@ -1,26 +1,12 @@ open! Import open Test_container + +(* Tests of containers that are polymorphic over their element type. *) + include (Test_S1 (Array) : sig end) include (Test_S1 (List) : sig end) include (Test_S1 (Queue) : sig end) -include ( - Test_S0 (struct - include String - - let mem t c = mem t c - - module Elt = struct - type t = char [@@deriving sexp] - - let of_int = Char.of_int_exn - let to_int = Char.to_int - end - - let of_list = of_char_list - end) : - sig end) - (* Quickcheck-based expect tests *) let%expect_test "Array" = @@ -73,64 +59,8 @@ let%expect_test "Array" = Container: testing [mapi] Container: testing [filteri] Container: testing [filter_mapi] - Container: testing [concat_mapi] |}] -;; - -let%expect_test "Hash_set" = - Base_container_tests.test_container_s0 - (module struct - open Base_quickcheck - - module Elt = struct - include Int - - type t = (int[@generator Generator.small_strictly_positive_int]) - [@@deriving compare, equal, quickcheck, sexp_of] - end - - include Hash_set - - type t = Hash_set.M(Int).t [@@deriving sexp_of] - - let quickcheck_generator = - Generator.map [%generator: Elt.t list] ~f:(Hash_set.of_list (module Int)) - ;; - - let quickcheck_observer = Observer.unmap [%observer: Elt.t list] ~f:Hash_set.to_list - - let quickcheck_shrinker = - Shrinker.map - [%shrinker: Elt.t list] - ~f:(Hash_set.of_list (module Int)) - ~f_inverse:Hash_set.to_list - ;; - - (* [to_list] and [to_array] proceed in the opposite order as everything else. This - is likely a performance hack to reuse [fold] without adding a [List.rev]. It is - not particularly problematic, since hash table order is already unpredictable due - to hash functions. *) - let to_list t = List.rev (to_list t) - let to_array t = Array.rev (to_array t) - end); - [%expect - {| - Container: testing [length] - Container: testing [is_empty] - Container: testing [mem] - Container: testing [iter] - Container: testing [fold] - Container: testing [fold_result] - Container: testing [fold_until] - Container: testing [exists] - Container: testing [for_all] - Container: testing [count] - Container: testing [sum] - Container: testing [find] - Container: testing [find_map] - Container: testing [to_list] - Container: testing [to_array] - Container: testing [min_elt] - Container: testing [max_elt] |}] + Container: testing [concat_mapi] + |}] ;; let%expect_test "List" = @@ -180,7 +110,8 @@ let%expect_test "List" = Container: testing [mapi] Container: testing [filteri] Container: testing [filter_mapi] - Container: testing [concat_mapi] |}] + Container: testing [concat_mapi] + |}] ;; let%expect_test "Set" = @@ -226,46 +157,6 @@ let%expect_test "Set" = Option.first_some (find_map lt ~f) (Some x) ;; end); - [%expect - {| - Container: testing [length] - Container: testing [is_empty] - Container: testing [mem] - Container: testing [iter] - Container: testing [fold] - Container: testing [fold_result] - Container: testing [fold_until] - Container: testing [exists] - Container: testing [for_all] - Container: testing [count] - Container: testing [sum] - Container: testing [find] - Container: testing [find_map] - Container: testing [to_list] - Container: testing [to_array] - Container: testing [min_elt] - Container: testing [max_elt] |}] -;; - -let%expect_test "String" = - Base_container_tests.test_indexed_container_s0_with_creators - (module struct - include String - - module Elt = struct - type t = char [@@deriving compare, equal, quickcheck, sexp_of] - end - - type t = string [@@deriving quickcheck] - - (* eta-expand due to [local_] types *) - let mem t c = mem t c - - (* leave off the [?sep] argument *) - let concat list = concat list - let concat_map list = concat_map list - let concat_mapi list = concat_mapi list - end); [%expect {| Container: testing [length] @@ -285,28 +176,7 @@ let%expect_test "String" = Container: testing [to_array] Container: testing [min_elt] Container: testing [max_elt] - Container: testing [of_list] - Container: testing [of_array] - Container: testing [append] - Container: testing [concat] - Container: testing [map] - Container: testing [filter] - Container: testing [filter_map] - Container: testing [concat_map] - Container: testing [partition_tf] - Container: testing [partition_map] - Container: testing [foldi] - Container: testing [iteri] - Container: testing [existsi] - Container: testing [for_alli] - Container: testing [counti] - Container: testing [findi] - Container: testing [find_mapi] - Container: testing [init] - Container: testing [mapi] - Container: testing [filteri] - Container: testing [filter_mapi] - Container: testing [concat_mapi] |}] + |}] ;; let%expect_test "Queue" = @@ -352,5 +222,6 @@ let%expect_test "Queue" = Container: testing [for_alli] Container: testing [counti] Container: testing [findi] - Container: testing [find_mapi] |}] + Container: testing [find_mapi] + |}] ;; diff --git a/test/test_map_comprehensive.mli b/test/test_base_containers_poly.mli similarity index 100% rename from test/test_map_comprehensive.mli rename to test/test_base_containers_poly.mli diff --git a/test/test_bool.ml b/test/test_bool.ml index e1304892..3ff43ecf 100644 --- a/test/test_bool.ml +++ b/test/test_bool.ml @@ -16,13 +16,13 @@ let%expect_test "Bool.Non_short_circuiting.(||)" = || (print_endline "rhs"; true)); - [%expect {|rhs|}]; + [%expect {| rhs |}]; assert ( false || (print_endline "rhs"; true)); - [%expect {|rhs|}] + [%expect {| rhs |}] ;; let%expect_test "Bool.Non_short_circuiting.(&&)" = @@ -36,12 +36,12 @@ let%expect_test "Bool.Non_short_circuiting.(&&)" = && (print_endline "rhs"; true)); - [%expect {|rhs|}]; + [%expect {| rhs |}]; assert ( not (false && (print_endline "rhs"; true))); - [%expect {|rhs|}] + [%expect {| rhs |}] ;; diff --git a/test/test_bytes.ml b/test/test_bytes.ml index acac6177..e6cf1775 100644 --- a/test/test_bytes.ml +++ b/test/test_bytes.ml @@ -67,7 +67,8 @@ let%test_module "Unsafe primitives" = buffer[0] = 0xef buffer[1] = 0xbe buffer[2] = 0xad - buffer[3] = 0xde |}]; + buffer[3] = 0xde + |}]; (* Ensure that 32-bit writes works on non-word-aligned positions. *) Bytes.unsafe_set_int32 buffer 1 178293l; printf "%ld" (Bytes.unsafe_get_int32 buffer 1); @@ -94,7 +95,8 @@ let%test_module "Unsafe primitives" = buffer[4] = 0x78 buffer[5] = 0x56 buffer[6] = 0x34 - buffer[7] = 0x12 |}]; + buffer[7] = 0x12 + |}]; (* Ensure that 64-bit writes works on non-word-aligned positions. *) Bytes.unsafe_set_int64 buffer 1 0x12345678_deadbeefL; printf "%Lx" (Bytes.unsafe_get_int64 buffer 1); diff --git a/test/test_char.ml b/test/test_char.ml index 2429ff21..3c993390 100644 --- a/test/test_char.ml +++ b/test/test_char.ml @@ -82,7 +82,8 @@ let%expect_test "all" = "\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") |}] + "\252" "\253" "\254" "\255") + |}] ;; let%expect_test "predicates" = @@ -97,18 +98,21 @@ let%expect_test "predicates" = [%expect {| (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l - m n o p q r s t u v w x y z) |}]; + m n o p q r s t u v w x y z) + |}]; print_s [%sexp (List.filter all ~f:is_alphanum : t list)]; [%expect {| (0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b - c d e f g h i j k l m n o p q r s t u v w x y z) |}]; + c d e f g h i j k l m n o p q r s t u v w x y z) + |}]; print_s [%sexp (List.filter all ~f:is_print : t list)]; [%expect {| (" " ! "\"" # $ % & ' "(" ")" * + , - . / 0 1 2 3 4 5 6 7 8 9 : ";" < = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ "\\" ] ^ _ ` a b c d e - f g h i j k l m n o p q r s t u v w x y z { | } ~) |}]; + f g h i j k l m n o p q r s t u v w x y z { | } ~) + |}]; print_s [%sexp (List.filter all ~f:is_whitespace : t list)]; [%expect {| ("\t" "\n" "\011" "\012" "\r" " ") |}]; print_s [%sexp (List.filter all ~f:is_hex_digit : t list)]; @@ -129,7 +133,8 @@ let%expect_test "get_hex_digit" = [%expect {| ((0 0) (1 1) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (A 10) (B 11) - (C 12) (D 13) (E 14) (F 15) (a 10) (b 11) (c 12) (d 13) (e 14) (f 15)) |}]; + (C 12) (D 13) (E 14) (F 15) (a 10) (b 11) (c 12) (d 13) (e 14) (f 15)) + |}]; require_equal [%here] (module struct diff --git a/test/test_compare.ml b/test/test_compare.ml index 02aeef75..1a2b3fbd 100644 --- a/test/test_compare.ml +++ b/test/test_compare.ml @@ -65,52 +65,52 @@ let%expect_test "Base" = type t = int [@@deriving sexp_of] end) Int.[ min_value; minus_one; zero; one; max_value ]; - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Unit" = test [%here] (module Unit) Unit.all; - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Bool" = test [%here] (module Bool) Bool.all; - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Char" = test [%here] (module Char) Char.all; - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Float" = test [%here] (module Float) Float.[ min_value; minus_one; zero; one; max_value ]; - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Int" = test [%here] (module Int) Int.[ min_value; minus_one; zero; one; max_value ]; - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Int32" = test [%here] (module Int32) Int32.[ min_value; minus_one; zero; one; max_value ]; - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Int64" = test [%here] (module Int64) Int64.[ min_value; minus_one; zero; one; max_value ]; - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Nativeint" = test [%here] (module Nativeint) Nativeint.[ min_value; minus_one; zero; one; max_value ]; - [%expect {||}] + [%expect {| |}] ;; let%expect_test "Int63" = test [%here] (module Int63) Int63.[ min_value; minus_one; zero; one; max_value ]; - [%expect {||}] + [%expect {| |}] ;; let%test_module "lexicographic" = @@ -129,9 +129,10 @@ let%test_module "lexicographic" = (Ordering.of_int (Comparable.lexicographic [ compare ] a b))); [%expect {| - ((a 1) (b 2) (ordering Less)) - ((a 1) (b 1) (ordering Equal)) - ((a 2) (b 1) (ordering Greater)) |}]) + ((a 1) (b 2) (ordering Less)) + ((a 1) (b 1) (ordering Equal)) + ((a 2) (b 1) (ordering Greater)) + |}]) ;; let%expect_test "three comparisons" = @@ -168,7 +169,8 @@ let%expect_test "reversed" = print_s [%message (sort_asc1 : int list) (sort_desc : int list) (sort_asc2 : int list)]; [%expect {| - ((sort_asc1 (1 1 2 3 3 4 5 5 5 6 9 9)) - (sort_desc (9 9 6 5 5 5 4 3 3 2 1 1)) - (sort_asc2 (1 1 2 3 3 4 5 5 5 6 9 9))) |}] + ((sort_asc1 (1 1 2 3 3 4 5 5 5 6 9 9)) + (sort_desc (9 9 6 5 5 5 4 3 3 2 1 1)) + (sort_asc2 (1 1 2 3 3 4 5 5 5 6 9 9))) + |}] ;; diff --git a/test/test_either.ml b/test/test_either.ml index 959458c1..6257db5d 100644 --- a/test/test_either.ml +++ b/test/test_either.ml @@ -16,7 +16,8 @@ let%expect_test "First.Monad.map" = print_s [%message (f' : t) (s' : t)]; [%expect {| ((f' (First 1)) - (s' (Second str))) |}] + (s' (Second str))) + |}] ;; let%expect_test "Second.Monad.map" = @@ -30,7 +31,8 @@ let%expect_test "Second.Monad.map" = print_s [%message (f' : t) (s' : t)]; [%expect {| ((f' (First 0)) - (s' (Second str1))) |}] + (s' (Second str1))) + |}] ;; let%expect_test "First.Monad.bind" = @@ -44,7 +46,8 @@ let%expect_test "First.Monad.bind" = print_s [%message (f' : t) (s' : t)]; [%expect {| ((f' (First 1)) - (s' (Second str))) |}] + (s' (Second str))) + |}] ;; let%expect_test "Second.Monad.bind" = @@ -58,7 +61,8 @@ let%expect_test "Second.Monad.bind" = print_s [%message (f' : t) (s' : t)]; [%expect {| ((f' (First 0)) - (s' (Second str1))) |}] + (s' (Second str1))) + |}] ;; let%expect_test "First.map2" = diff --git a/test/test_error.ml b/test/test_error.ml index 3f8be8d7..ca7afee2 100644 --- a/test/test_error.ml +++ b/test/test_error.ml @@ -13,7 +13,8 @@ let%expect_test _ = [%expect {| (raised ABC) (raised (DEF GHI)) - (raised (foo (bar 31))) |}] + (raised (foo (bar 31))) + |}] ;; let%expect_test _ = @@ -22,5 +23,6 @@ let%expect_test _ = [%expect {| (raised ABC) (raised (DEF GHI)) - (raised (foo (bar 31))) |}] + (raised (foo (bar 31))) + |}] ;; diff --git a/test/test_exn.ml b/test/test_exn.ml index 864d1b9a..8e01d81e 100644 --- a/test/test_exn.ml +++ b/test/test_exn.ml @@ -3,15 +3,12 @@ open! Exn let%expect_test "[create_s]" = print_s [%sexp (create_s [%message "foo"] : t)]; - [%expect {| - foo |}]; + [%expect {| foo |}]; print_s [%sexp (create_s [%message "foo" "bar"] : t)]; - [%expect {| - (foo bar) |}]; + [%expect {| (foo bar) |}]; let sexp = [%message "foo"] in print_s [%sexp (phys_equal sexp (sexp_of_t (create_s sexp)) : bool)]; - [%expect {| - true |}] + [%expect {| true |}] ;; let%test _ = not (does_raise Fn.ignore) diff --git a/test/test_exn_reraise.ml b/test/test_exn_reraise.ml index be887016..fd10adb6 100644 --- a/test/test_exn_reraise.ml +++ b/test/test_exn_reraise.ml @@ -89,8 +89,9 @@ let%test_module ("Show native backtraces" [@tags "no-js"]) = test_reraiser _Base_Exn_reraise; really_show_backtrace [%expect.output]; [%expect {| - Before re-raise: true - After re-raise: true |}] + Before re-raise: true + After re-raise: true + |}] ;; (* bad, because the backtrace was clobbered *) @@ -98,8 +99,9 @@ let%test_module ("Show native backtraces" [@tags "no-js"]) = test_reraiser _Base_Exn_reraise_after_clobbering_most_recent_backtrace; really_show_backtrace [%expect.output]; [%expect {| - Before re-raise: false - After re-raise: true |}] + Before re-raise: false + After re-raise: true + |}] ;; (* bad, missing the backtrace before the reraise *) @@ -107,8 +109,9 @@ let%test_module ("Show native backtraces" [@tags "no-js"]) = test_reraiser external_reraise_unequal; really_show_backtrace [%expect.output]; [%expect {| - Before re-raise: false - After re-raise: true |}] + Before re-raise: false + After re-raise: true + |}] ;; (* bad, missing the backtrace before the reraise *) @@ -116,8 +119,9 @@ let%test_module ("Show native backtraces" [@tags "no-js"]) = test_reraiser vanilla_raise_unequal; really_show_backtrace [%expect.output]; [%expect {| - Before re-raise: false - After re-raise: true |}] + Before re-raise: false + After re-raise: true + |}] ;; (* good, but no additional info attached *) @@ -125,8 +129,9 @@ let%test_module ("Show native backtraces" [@tags "no-js"]) = test_reraiser vanilla_raise; really_show_backtrace [%expect.output]; [%expect {| - Before re-raise: true - After re-raise: true |}] + Before re-raise: true + After re-raise: true + |}] ;; (* good *) @@ -134,8 +139,9 @@ let%test_module ("Show native backtraces" [@tags "no-js"]) = test_reraiser raise_with_original_backtrace; really_show_backtrace [%expect.output]; [%expect {| - Before re-raise: true - After re-raise: true |}] + Before re-raise: true + After re-raise: true + |}] ;; (* good *) @@ -143,8 +149,9 @@ let%test_module ("Show native backtraces" [@tags "no-js"]) = test_reraise_uncaught ~reraise_uncaught:(Exn.reraise_uncaught "reraised"); really_show_backtrace [%expect.output]; [%expect {| - Before re-raise: true - After re-raise: true |}] + Before re-raise: true + After re-raise: true + |}] ;; end) ;; diff --git a/test/test_float.ml b/test/test_float.ml index b6075f07..03c93f5f 100644 --- a/test/test_float.ml +++ b/test/test_float.ml @@ -1081,7 +1081,8 @@ let%expect_test "square" = printf "%f\n" (square (-2.5)); [%expect {| 2.250000 - 6.250000 |}] + 6.250000 + |}] ;; let%expect_test "mathematical constants" = @@ -1097,7 +1098,8 @@ let%expect_test "mathematical constants" = [%expect {| sqrt pi diff : 0.00000000000000022204 - sqrt 2pi diff : 0.00000000000000044409 |}] + sqrt 2pi diff : 0.00000000000000044409 + |}] ;; let%test _ = not (is_negative Float.nan) @@ -1189,7 +1191,8 @@ let%expect_test "is_nan, is_inf, and is_finite" = 4.94065645841247e-324 false false true 1. false false true 1.7976931348623157e+308 false false true - inf false true false |}] + inf false true false + |}] ;; let%expect_test "nan" = @@ -1233,62 +1236,72 @@ let%expect_test "log" = [%expect {| ((log2 NAN) (log10 NAN) - (ratio NAN)) |}]; + (ratio NAN)) + |}]; test 0.; [%expect {| ((log2 -INF) (log10 -INF) - (ratio NAN)) |}]; + (ratio NAN)) + |}]; test 1.; [%expect {| ((log2 0) (log10 0) - (ratio NAN)) |}]; + (ratio NAN)) + |}]; test 2.; [%expect {| ((log2 1) (log10 0.3010299956639812) - (ratio 3.3219280948873622)) |}]; + (ratio 3.3219280948873622)) + |}]; test 10.; [%expect {| ((log2 3.3219280948873622) (log10 1) - (ratio 3.3219280948873622)) |}]; + (ratio 3.3219280948873622)) + |}]; test Float.min_positive_subnormal_value; [%expect {| ((log2 -1074) (log10 -323.30621534311581) - (ratio 3.3219280948873622)) |}]; + (ratio 3.3219280948873622)) + |}]; test Float.epsilon_float; [%expect {| ((log2 -52) (log10 -15.653559774527022) - (ratio 3.3219280948873626)) |}]; + (ratio 3.3219280948873626)) + |}]; test Float.pi; [%expect {| ((log2 1.6514961294723187) (log10 0.4971498726941338) - (ratio 3.3219280948873626)) |}]; + (ratio 3.3219280948873626)) + |}]; test Float.max_finite_value; [%expect {| ((log2 1024) (log10 308.25471555991675) - (ratio 3.3219280948873622)) |}]; + (ratio 3.3219280948873622)) + |}]; test Float.infinity; [%expect {| ((log2 INF) (log10 INF) - (ratio NAN)) |}] + (ratio NAN)) + |}] ;; let%expect_test "float comparisons permit both local and global arguments" = let (_ : float -> float -> bool) = Float.( < ) in let (_ : float -> float -> bool) = Float.( < ) in - [%expect {| |}] + [%expect {| |}] ;; diff --git a/test/test_fn_local.mlt b/test/test_fn_local.mlt index 7ff1faa1..031cbd35 100644 --- a/test/test_fn_local.mlt +++ b/test/test_fn_local.mlt @@ -4,13 +4,13 @@ open Base let f : 'a. 'a -> 'a = Fn.id -[%%expect {||}] +[%%expect {| |}] (* [id] can operate on local arguments *) let f : 'a. local_ 'a -> local_ 'a = Fn.id -[%%expect {||}] +[%%expect {| |}] (* [id] cannot make a local argument global; this would be unsound *) diff --git a/test/test_globalize_lib.ml b/test/test_globalize_lib.ml index 688a42a9..f2d41270 100644 --- a/test/test_globalize_lib.ml +++ b/test/test_globalize_lib.ml @@ -65,7 +65,8 @@ let%expect_test "array" = [%expect {| one two - three |}] + three + |}] ;; let%expect_test "list" = @@ -75,7 +76,8 @@ let%expect_test "list" = [%expect {| one two - three |}] + three + |}] ;; let%expect_test "option" = diff --git a/test/test_hashtbl.ml b/test/test_hashtbl.ml index 3ef691e9..28f8e1c0 100644 --- a/test/test_hashtbl.ml +++ b/test/test_hashtbl.ml @@ -79,7 +79,8 @@ let%expect_test "[choose], [choose_exn], [choose_randomly], [choose_randomly_exn (choose_exn (Error ("[Hashtbl.choose_exn] of empty hashtbl"))) (choose_randomly ()) (choose_randomly_exn ( - Error ("[Hashtbl.choose_randomly_exn] of empty hashtbl")))) |}]; + Error ("[Hashtbl.choose_randomly_exn] of empty hashtbl")))) + |}]; test [] ~size:100; [%expect {| @@ -88,7 +89,8 @@ let%expect_test "[choose], [choose_exn], [choose_randomly], [choose_randomly_exn (choose_exn (Error ("[Hashtbl.choose_exn] of empty hashtbl"))) (choose_randomly ()) (choose_randomly_exn ( - Error ("[Hashtbl.choose_randomly_exn] of empty hashtbl")))) |}]; + Error ("[Hashtbl.choose_randomly_exn] of empty hashtbl")))) + |}]; test [ 1 ]; [%expect {| @@ -96,7 +98,8 @@ let%expect_test "[choose], [choose_exn], [choose_randomly], [choose_randomly_exn (choose ((_ _))) (choose_exn (Ok (_ _))) (choose_randomly ((_ _))) - (choose_randomly_exn (Ok (_ _)))) |}]; + (choose_randomly_exn (Ok (_ _)))) + |}]; test [ 1 ] ~size:100; [%expect {| @@ -104,7 +107,8 @@ let%expect_test "[choose], [choose_exn], [choose_randomly], [choose_randomly_exn (choose ((_ _))) (choose_exn (Ok (_ _))) (choose_randomly ((_ _))) - (choose_randomly_exn (Ok (_ _)))) |}]; + (choose_randomly_exn (Ok (_ _)))) + |}]; test [ 1; 2 ]; [%expect {| @@ -114,7 +118,8 @@ let%expect_test "[choose], [choose_exn], [choose_randomly], [choose_randomly_exn (choose ((_ _))) (choose_exn (Ok (_ _))) (choose_randomly ((_ _))) - (choose_randomly_exn (Ok (_ _)))) |}]; + (choose_randomly_exn (Ok (_ _)))) + |}]; test [ 1; 2 ] ~size:100; [%expect {| @@ -124,7 +129,8 @@ let%expect_test "[choose], [choose_exn], [choose_randomly], [choose_randomly_exn (choose ((_ _))) (choose_exn (Ok (_ _))) (choose_randomly ((_ _))) - (choose_randomly_exn (Ok (_ _)))) |}] + (choose_randomly_exn (Ok (_ _)))) + |}] ;; let%expect_test "update_and_return" = diff --git a/test/test_indexed_container.ml b/test/test_indexed_container.ml index 469320f3..e7257223 100644 --- a/test/test_indexed_container.ml +++ b/test/test_indexed_container.ml @@ -60,7 +60,8 @@ let%expect_test "foldi" = (1) (2) (1 4) - (36 16 4 0) |}] + (36 16 4 0) + |}] ;; let%expect_test "findi" = @@ -78,14 +79,16 @@ let%expect_test "findi" = ((0 1)) ((0 2)) ((0 4)) - ((0 0)) |}]; + ((0 0)) + |}]; check (fun _i elt -> elt = 1); [%expect {| () ((0 1)) () ((2 1)) - ((1 1)) |}] + ((1 1)) + |}] ;; let%expect_test "find_mapi" = @@ -101,7 +104,8 @@ let%expect_test "find_mapi" = (1) () (201) - (101) |}] + (101) + |}] ;; let%expect_test "iteri" = @@ -122,7 +126,8 @@ let%expect_test "iteri" = (0 1) (1 3 0 2) (2 1 1 5 0 4) - (7 49 6 36 5 25 4 16 3 9 2 4 1 1 0 0) |}] + (7 49 6 36 5 25 4 16 3 9 2 4 1 1 0 0) + |}] ;; let bool_examples = @@ -151,7 +156,8 @@ let%expect_test "for_alli" = false false false - true |}] + true + |}] ;; let%expect_test "existsi" = @@ -169,7 +175,8 @@ let%expect_test "existsi" = false true true - true |}] + true + |}] ;; let%expect_test "counti" = @@ -187,5 +194,6 @@ let%expect_test "counti" = 0 1 1 - 2 |}] + 2 + |}] ;; diff --git a/test/test_info.ml b/test/test_info.ml index 3c886443..c6d353e3 100644 --- a/test/test_info.ml +++ b/test/test_info.ml @@ -86,7 +86,7 @@ let%expect_test "stack overflow" = overflow just to produce a small value. *) let depth = match Word_size.word_size with - | W64 -> 10_000_000 + | W64 -> 1_000_000 | W32 -> 100_000 in let test f = @@ -139,7 +139,8 @@ let%expect_test "show how backtraces are printed" = "called from Base__Error.raise_s in file \"error.ml\", line 10, characters 19-40" "called from Floops_interfaces__Registrant.register_exn in file \"registrant.ml\", line 18, characters 4-241" "called from Floops_interfaces_test__Registrant_test.Test_brick.create_exn.(fun) in file \"registrant_test.ml\", line 25, characters 6-67" - "called from Base__Or_error.try_with in file \"or_error.ml\", line 84, characters 9-15")) |}]; + "called from Base__Or_error.try_with in file \"or_error.ml\", line 84, characters 9-15")) + |}]; print_endline (Info.to_string_hum exn); [%expect {| @@ -148,5 +149,6 @@ let%expect_test "show how backtraces are printed" = "called from Base__Error.raise_s in file \"error.ml\", line 10, characters 19-40" "called from Floops_interfaces__Registrant.register_exn in file \"registrant.ml\", line 18, characters 4-241" "called from Floops_interfaces_test__Registrant_test.Test_brick.create_exn.(fun) in file \"registrant_test.ml\", line 25, characters 6-67" - "called from Base__Or_error.try_with in file \"or_error.ml\", line 84, characters 9-15")) |}] + "called from Base__Or_error.try_with in file \"or_error.ml\", line 84, characters 9-15")) + |}] ;; diff --git a/test/test_int.ml b/test/test_int.ml index 88879f4c..9a7ca862 100644 --- a/test/test_int.ml +++ b/test/test_int.ml @@ -8,8 +8,7 @@ let%expect_test ("hash coherence" [@tags "64-bits-only"]) = let%expect_test "[max_value_30_bits]" = print_s [%sexp (max_value_30_bits : t)]; - [%expect {| - 1_073_741_823 |}] + [%expect {| 1_073_741_823 |}] ;; let%expect_test "of_string_opt" = @@ -40,9 +39,7 @@ let%expect_test "hex" = print_s [%message (n : int Or_error.t)] in test "0x1c5f"; - [%expect {| - (n (Ok 7_263)) - |}]; + [%expect {| (n (Ok 7_263)) |}]; test "0x1c5f NON-HEX-GARBAGE"; [%expect {| @@ -50,7 +47,7 @@ let%expect_test "hex" = Error ( Failure "Base.Int.Hex.of_string: invalid input \"0x1c5f NON-HEX-GARBAGE\""))) - |}] + |}] ;; let%test_module "Hex" = @@ -135,42 +132,50 @@ let%expect_test "binary" = [%expect {| 0b0 0b0 - 0b0 |}]; + 0b0 + |}]; test_binary 0b01; [%expect {| 0b1 0b1 - 0b1 |}]; + 0b1 + |}]; test_binary 0b100; [%expect {| 0b100 0b100 - 0b100 |}]; + 0b100 + |}]; test_binary 0b101; [%expect {| 0b101 0b101 - 0b101 |}]; + 0b101 + |}]; test_binary 0b10_1010_1010_1010; [%expect {| 0b10_1010_1010_1010 0b10101010101010 - 0b10101010101010 |}]; + 0b10_1010_1010_1010 + |}]; test_binary 0b11_1111_0000_0000; [%expect {| 0b11_1111_0000_0000 0b11111100000000 - 0b11111100000000 |}]; + 0b11_1111_0000_0000 + |}]; test_binary 19; [%expect {| 0b1_0011 0b10011 - 0b10011 |}]; + 0b1_0011 + |}]; test_binary 0; [%expect {| 0b0 0b0 - 0b0 |}] + 0b0 + |}] ;; let%expect_test ("63-bit cases" [@tags "64-bits-only"]) = @@ -179,19 +184,22 @@ let%expect_test ("63-bit cases" [@tags "64-bits-only"]) = {| 0b111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111 0b111111111111111111111111111111111111111111111111111111111111111 - 0b111111111111111111111111111111111111111111111111111111111111111 |}]; + 0b111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111 + |}]; test_binary max_value; [%expect {| 0b11_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111 0b11111111111111111111111111111111111111111111111111111111111111 - 0b11111111111111111111111111111111111111111111111111111111111111 |}]; + 0b11_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111_1111 + |}]; test_binary min_value; [%expect {| 0b100_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000 0b100000000000000000000000000000000000000000000000000000000000000 - 0b100000000000000000000000000000000000000000000000000000000000000 |}] + 0b100_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000_0000 + |}] ;; let%expect_test ("32-bit cases" [@tags "js-only"]) = @@ -200,19 +208,22 @@ let%expect_test ("32-bit cases" [@tags "js-only"]) = {| 0b1111_1111_1111_1111_1111_1111_1111_1111 0b11111111111111111111111111111111 - 0b11111111111111111111111111111111 |}]; + 0b1111_1111_1111_1111_1111_1111_1111_1111 + |}]; test_binary max_value; [%expect {| 0b111_1111_1111_1111_1111_1111_1111_1111 0b1111111111111111111111111111111 - 0b1111111111111111111111111111111 |}]; + 0b111_1111_1111_1111_1111_1111_1111_1111 + |}]; test_binary min_value; [%expect {| 0b1000_0000_0000_0000_0000_0000_0000_0000 0b10000000000000000000000000000000 - 0b10000000000000000000000000000000 |}] + 0b1000_0000_0000_0000_0000_0000_0000_0000 + |}] ;; let%test _ = neg 5 + 5 = 0 @@ -251,7 +262,8 @@ let%expect_test "bswap16" = 0x1020 --> 0x2010 0x11_2233 --> 0x3322 0x1122_331f --> 0x1f33 - 0x1122_3344 --> 0x4433 |}] + 0x1122_3344 --> 0x4433 + |}] ;; let%expect_test "% and /%" = diff --git a/test/test_int32.ml b/test/test_int32.ml index 819c3c80..45f37f0c 100644 --- a/test/test_int32.ml +++ b/test/test_int32.ml @@ -16,17 +16,19 @@ let%expect_test "bswap16" = 0x1020 --> 0x2010 0x11_2233 --> 0x3322 0x1122_331f --> 0x1f33 - 0x1122_3344 --> 0x4433 |}] + 0x1122_3344 --> 0x4433 + |}] ;; let%expect_test "bswap32" = List.iter numbers ~f:(test bswap32); [%expect {| - 0x1020 --> 0x2010_0000 - 0x11_2233 --> 0x3322_1100 - 0x1122_331f --> 0x1f33_2211 - 0x1122_3344 --> 0x4433_2211 |}] + 0x1020 --> 0x2010_0000 + 0x11_2233 --> 0x3322_1100 + 0x1122_331f --> 0x1f33_2211 + 0x1122_3344 --> 0x4433_2211 + |}] ;; let%expect_test "binary" = @@ -50,25 +52,30 @@ let%expect_test "binary" = [%expect {| 0b1 0b1 - 0b1 |}]; + 0b1 + |}]; test_binary 0b100l; [%expect {| 0b100 0b100 - 0b100 |}]; + 0b100 + |}]; test_binary 0b101l; [%expect {| 0b101 0b101 - 0b101 |}]; + 0b101 + |}]; test_binary 0b10_1010_1010_1010l; [%expect {| 0b10_1010_1010_1010 0b10101010101010 - 0b10101010101010 |}]; + 0b10_1010_1010_1010 + |}]; test_binary 0b11_1111_0000_0000l; [%expect {| 0b11_1111_0000_0000 0b11111100000000 - 0b11111100000000 |}] + 0b11_1111_0000_0000 + |}] ;; diff --git a/test/test_int32_pow2.ml b/test/test_int32_pow2.ml index 10dff876..413f9c5c 100644 --- a/test/test_int32_pow2.ml +++ b/test/test_int32_pow2.ml @@ -27,7 +27,8 @@ let%expect_test "[floor_log2]" = (9 (Ok 3)) (63 (Ok 5)) (64 (Ok 6)) - (65 (Ok 6)) |}] + (65 (Ok 6)) + |}] ;; let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = @@ -37,7 +38,8 @@ let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = (-2_147_483_648 (Error ("[Int32.floor_log2] got invalid input" -2147483648))) (-2_147_483_647 (Error ("[Int32.floor_log2] got invalid input" -2147483647))) (2_147_483_646 (Ok 30)) - (2_147_483_647 (Ok 30)) |}] + (2_147_483_647 (Ok 30)) + |}] ;; let%expect_test "[ceil_log2]" = @@ -56,7 +58,8 @@ let%expect_test "[ceil_log2]" = (9 (Ok 4)) (63 (Ok 6)) (64 (Ok 6)) - (65 (Ok 7)) |}] + (65 (Ok 7)) + |}] ;; let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = @@ -66,7 +69,8 @@ let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = (-2_147_483_648 (Error ("[Int32.ceil_log2] got invalid input" -2147483648))) (-2_147_483_647 (Error ("[Int32.ceil_log2] got invalid input" -2147483647))) (2_147_483_646 (Ok 31)) - (2_147_483_647 (Ok 31)) |}] + (2_147_483_647 (Ok 31)) + |}] ;; let%test_module "int_math" = diff --git a/test/test_int63.ml b/test/test_int63.ml index d5772d58..94ae29e7 100644 --- a/test/test_int63.ml +++ b/test/test_int63.ml @@ -94,11 +94,9 @@ let%test_module "Overflow_exn" = let%expect_test "[floor_log2]" = let floor_log2 t = print_s [%sexp (floor_log2 t : int)] in show_raise (fun () -> floor_log2 zero); - [%expect {| - (raised ("[Int.floor_log2] got invalid input" 0)) |}]; + [%expect {| (raised ("[Int.floor_log2] got invalid input" 0)) |}]; floor_log2 one; - [%expect {| - 0 |}]; + [%expect {| 0 |}]; for i = 1 to 8 do floor_log2 (i |> of_int) done; @@ -110,16 +108,14 @@ let%expect_test "[floor_log2]" = 2 2 2 - 3 |}]; + 3 + |}]; floor_log2 ((one lsl 61) - one); - [%expect {| - 60 |}]; + [%expect {| 60 |}]; floor_log2 (one lsl 61); - [%expect {| - 61 |}]; + [%expect {| 61 |}]; floor_log2 max_value; - [%expect {| - 61 |}] + [%expect {| 61 |}] ;; let%expect_test "binary" = @@ -144,12 +140,14 @@ let%expect_test ("binary emulation" [@tags "js-only"]) = [%expect {| 0b1 0b1 - 0b1 |}]; + 0b1 + |}]; test_binary 0b0L; [%expect {| 0b0 0b0 - 0b0 |}] + 0b0 + |}] ;; let%expect_test "binary" = @@ -157,25 +155,30 @@ let%expect_test "binary" = [%expect {| 0b1 0b1 - 0b1 |}]; + 0b1 + |}]; test_binary 0b100L; [%expect {| 0b100 0b100 - 0b100 |}]; + 0b100 + |}]; test_binary 0b101L; [%expect {| 0b101 0b101 - 0b101 |}]; + 0b101 + |}]; test_binary 0b10_1010_1010_1010L; [%expect {| 0b10_1010_1010_1010 0b10101010101010 - 0b10101010101010 |}]; + 0b10_1010_1010_1010 + |}]; test_binary 0b11_1111_0000_0000L; [%expect {| 0b11_1111_0000_0000 0b11111100000000 - 0b11111100000000 |}] + 0b11_1111_0000_0000 + |}] ;; diff --git a/test/test_int63_emul.ml b/test/test_int63_emul.ml index b1f496c3..7579cc40 100644 --- a/test/test_int63_emul.ml +++ b/test/test_int63_emul.ml @@ -6,7 +6,9 @@ let%expect_test _ = let s63_emul = Int63_emul.(Hex.to_string min_value) in print_s [%message (s63 : string) (s63_emul : string)]; require [%here] (String.equal s63 s63_emul); - [%expect {| + [%expect + {| ((s63 -0x4000000000000000) - (s63_emul -0x4000000000000000)) |}] + (s63_emul -0x4000000000000000)) + |}] ;; diff --git a/test/test_int64.ml b/test/test_int64.ml index 817e127e..500a660f 100644 --- a/test/test_int64.ml +++ b/test/test_int64.ml @@ -23,52 +23,56 @@ let%expect_test "bswap16" = List.iter numbers ~f:(test bswap16); [%expect {| - 0x1020 --> 0x2010 - 0x11_2233 --> 0x3322 - 0x1122_3344 --> 0x4433 - 0x11_2233_4455 --> 0x5544 - 0x1122_3344_5566 --> 0x6655 - 0x11_2233_4455_6677 --> 0x7766 - 0x1122_3344_5566_7788 --> 0x8877 |}] + 0x1020 --> 0x2010 + 0x11_2233 --> 0x3322 + 0x1122_3344 --> 0x4433 + 0x11_2233_4455 --> 0x5544 + 0x1122_3344_5566 --> 0x6655 + 0x11_2233_4455_6677 --> 0x7766 + 0x1122_3344_5566_7788 --> 0x8877 + |}] ;; let%expect_test "bswap32" = List.iter numbers ~f:(test bswap32); [%expect {| - 0x1020 --> 0x2010_0000 - 0x11_2233 --> 0x3322_1100 - 0x1122_3344 --> 0x4433_2211 - 0x11_2233_4455 --> 0x5544_3322 - 0x1122_3344_5566 --> 0x6655_4433 - 0x11_2233_4455_6677 --> 0x7766_5544 - 0x1122_3344_5566_7788 --> 0x8877_6655 |}] + 0x1020 --> 0x2010_0000 + 0x11_2233 --> 0x3322_1100 + 0x1122_3344 --> 0x4433_2211 + 0x11_2233_4455 --> 0x5544_3322 + 0x1122_3344_5566 --> 0x6655_4433 + 0x11_2233_4455_6677 --> 0x7766_5544 + 0x1122_3344_5566_7788 --> 0x8877_6655 + |}] ;; let%expect_test "bswap48" = List.iter numbers ~f:(test bswap48); [%expect {| - 0x1020 --> 0x2010_0000_0000 - 0x11_2233 --> 0x3322_1100_0000 - 0x1122_3344 --> 0x4433_2211_0000 - 0x11_2233_4455 --> 0x5544_3322_1100 - 0x1122_3344_5566 --> 0x6655_4433_2211 - 0x11_2233_4455_6677 --> 0x7766_5544_3322 - 0x1122_3344_5566_7788 --> 0x8877_6655_4433 |}] + 0x1020 --> 0x2010_0000_0000 + 0x11_2233 --> 0x3322_1100_0000 + 0x1122_3344 --> 0x4433_2211_0000 + 0x11_2233_4455 --> 0x5544_3322_1100 + 0x1122_3344_5566 --> 0x6655_4433_2211 + 0x11_2233_4455_6677 --> 0x7766_5544_3322 + 0x1122_3344_5566_7788 --> 0x8877_6655_4433 + |}] ;; let%expect_test "bswap64" = List.iter numbers ~f:(test bswap64); [%expect {| - 0x1020 --> 0x2010_0000_0000_0000 - 0x11_2233 --> 0x3322_1100_0000_0000 - 0x1122_3344 --> 0x4433_2211_0000_0000 - 0x11_2233_4455 --> 0x5544_3322_1100_0000 - 0x1122_3344_5566 --> 0x6655_4433_2211_0000 - 0x11_2233_4455_6677 --> 0x7766_5544_3322_1100 - 0x1122_3344_5566_7788 --> -0x7788_99aa_bbcc_ddef |}] + 0x1020 --> 0x2010_0000_0000_0000 + 0x11_2233 --> 0x3322_1100_0000_0000 + 0x1122_3344 --> 0x4433_2211_0000_0000 + 0x11_2233_4455 --> 0x5544_3322_1100_0000 + 0x1122_3344_5566 --> 0x6655_4433_2211_0000 + 0x11_2233_4455_6677 --> 0x7766_5544_3322_1100 + 0x1122_3344_5566_7788 --> -0x7788_99aa_bbcc_ddef + |}] ;; let%expect_test "binary" = @@ -92,25 +96,30 @@ let%expect_test "binary" = [%expect {| 0b1 0b1 - 0b1 |}]; + 0b1 + |}]; test_binary 0b100L; [%expect {| 0b100 0b100 - 0b100 |}]; + 0b100 + |}]; test_binary 0b101L; [%expect {| 0b101 0b101 - 0b101 |}]; + 0b101 + |}]; test_binary 0b10_1010_1010_1010L; [%expect {| 0b10_1010_1010_1010 0b10101010101010 - 0b10101010101010 |}]; + 0b10_1010_1010_1010 + |}]; test_binary 0b11_1111_0000_0000L; [%expect {| 0b11_1111_0000_0000 0b11111100000000 - 0b11111100000000 |}] + 0b11_1111_0000_0000 + |}] ;; diff --git a/test/test_int64_pow2.ml b/test/test_int64_pow2.ml index e406a638..961d7877 100644 --- a/test/test_int64_pow2.ml +++ b/test/test_int64_pow2.ml @@ -26,7 +26,8 @@ let%expect_test "[floor_log2]" = (9 (Ok 3)) (63 (Ok 5)) (64 (Ok 6)) - (65 (Ok 6)) |}] + (65 (Ok 6)) + |}] ;; let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = @@ -38,7 +39,8 @@ let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = (-9_223_372_036_854_775_807 ( Error ("[Int64.floor_log2] got invalid input" -9223372036854775807))) (9_223_372_036_854_775_806 (Ok 62)) - (9_223_372_036_854_775_807 (Ok 62)) |}] + (9_223_372_036_854_775_807 (Ok 62)) + |}] ;; let%expect_test "[ceil_log2]" = @@ -57,7 +59,8 @@ let%expect_test "[ceil_log2]" = (9 (Ok 4)) (63 (Ok 6)) (64 (Ok 6)) - (65 (Ok 7)) |}] + (65 (Ok 7)) + |}] ;; let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = @@ -69,7 +72,8 @@ let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = (-9_223_372_036_854_775_807 ( Error ("[Int64.ceil_log2] got invalid input" -9223372036854775807))) (9_223_372_036_854_775_806 (Ok 63)) - (9_223_372_036_854_775_807 (Ok 63)) |}] + (9_223_372_036_854_775_807 (Ok 63)) + |}] ;; let%test_module "int64_math" = diff --git a/test/test_int_math.ml b/test/test_int_math.ml index 6234cec3..dedcf847 100644 --- a/test/test_int_math.ml +++ b/test/test_int_math.ml @@ -304,7 +304,8 @@ let%test_module "int rounding quickcheck tests" = (testing Up) (testing Down) (testing Zero) - (testing Nearest) |}] + (testing Nearest) + |}] ;; let%expect_test "int32" = @@ -323,7 +324,8 @@ let%test_module "int rounding quickcheck tests" = (testing Up) (testing Down) (testing Zero) - (testing Nearest) |}] + (testing Nearest) + |}] ;; let%expect_test "int63" = @@ -342,7 +344,8 @@ let%test_module "int rounding quickcheck tests" = (testing Up) (testing Down) (testing Zero) - (testing Nearest) |}] + (testing Nearest) + |}] ;; let%expect_test "int64" = @@ -361,7 +364,8 @@ let%test_module "int rounding quickcheck tests" = (testing Up) (testing Down) (testing Zero) - (testing Nearest) |}] + (testing Nearest) + |}] ;; let%expect_test ("nativeint" [@tags "no-js", "64-bits-only"]) = @@ -380,7 +384,8 @@ let%test_module "int rounding quickcheck tests" = (testing Up) (testing Down) (testing Zero) - (testing Nearest) |}] + (testing Nearest) + |}] ;; end) ;; diff --git a/test/test_int_pow2.ml b/test/test_int_pow2.ml index 679b1ba2..ac909718 100644 --- a/test/test_int_pow2.ml +++ b/test/test_int_pow2.ml @@ -29,7 +29,8 @@ let%expect_test "[floor_log2]" = (9 (Ok 3)) (63 (Ok 5)) (64 (Ok 6)) - (65 (Ok 6)) |}] + (65 (Ok 6)) + |}] ;; let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = @@ -41,7 +42,8 @@ let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = (-4_611_686_018_427_387_903 ( Error ("[Int.floor_log2] got invalid input" -4611686018427387903))) (4_611_686_018_427_387_902 (Ok 61)) - (4_611_686_018_427_387_903 (Ok 61)) |}] + (4_611_686_018_427_387_903 (Ok 61)) + |}] ;; let%expect_test "[ceil_log2]" = @@ -60,7 +62,8 @@ let%expect_test "[ceil_log2]" = (9 (Ok 4)) (63 (Ok 6)) (64 (Ok 6)) - (65 (Ok 7)) |}] + (65 (Ok 7)) + |}] ;; let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = @@ -72,7 +75,8 @@ let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = (-4_611_686_018_427_387_903 ( Error ("[Int.ceil_log2] got invalid input" -4611686018427387903))) (4_611_686_018_427_387_902 (Ok 62)) - (4_611_686_018_427_387_903 (Ok 62)) |}] + (4_611_686_018_427_387_903 (Ok 62)) + |}] ;; let%test_module "int_math" = diff --git a/test/test_lazy.ml b/test/test_lazy.ml index bc0c80e9..86215f1b 100644 --- a/test/test_lazy.ml +++ b/test/test_lazy.ml @@ -97,10 +97,12 @@ let%expect_test "equal" = [%expect {| force lazy_b force lazy_a - true |}]; + true + |}]; (* [force], resulting in [false] *) print_s [%sexp (equal Int.equal lazy_b lazy_c : bool)]; [%expect {| force lazy_c - false |}] + false + |}] ;; diff --git a/test/test_list.ml b/test/test_list.ml index b9d0a03f..4d10cb47 100644 --- a/test/test_list.ml +++ b/test/test_list.ml @@ -518,7 +518,8 @@ let%test_module "Assoc.group" = test [ "a", 1; "b", 2 ]; [%expect {| ((a (1)) - (b (2))) |}]; + (b (2))) + |}]; test [ "odd", 1; "even", 2; "Odd", 3; "Even", 4; "ODD", 5; "EVEN", 6 ]; [%expect {| @@ -527,11 +528,13 @@ let%test_module "Assoc.group" = (Odd (3)) (Even (4)) (ODD (5)) - (EVEN (6))) |}]; + (EVEN (6))) + |}]; test [ "odd", 1; "Odd", 3; "ODD", 5; "even", 2; "Even", 4; "EVEN", 6 ]; [%expect {| ((odd (1 3 5)) - (even (2 4 6))) |}] + (even (2 4 6))) + |}] ;; end) ;; @@ -557,11 +560,13 @@ let%test_module "Assoc.sort_and_group" = test [ "a", 1; "b", 2 ]; [%expect {| ((a (1)) - (b (2))) |}]; + (b (2))) + |}]; test [ "odd", 1; "even", 2; "Odd", 3; "Even", 4; "ODD", 5; "EVEN", 6 ]; [%expect {| ((even (2 4 6)) - (odd (1 3 5))) |}] + (odd (1 3 5))) + |}] ;; end) ;; @@ -965,14 +970,6 @@ let%test_unit _ = ~expect:[ 0, 2 ] ;; -let%test_unit _ = - [%test_result: int] (counti [ 0; 1; 2; 3; 4 ] ~f:(fun idx x -> idx = x)) ~expect:5 -;; - -let%test_unit _ = - [%test_result: int] (counti [ 0; 1; 2; 3; 4 ] ~f:(fun idx x -> idx = 4 - x)) ~expect:1 -;; - let%test_unit _ = [%test_result: int list] (filter_map ~f:(fun x -> Some x) Test_values.l1) @@ -1369,7 +1366,8 @@ let%expect_test "[Cartesian_product]" = (c 2 mi) (c 3 do) (c 3 re) - (c 3 mi) |}] + (c 3 mi) + |}] ;; let%expect_test "[compare__local] is the same as [compare]" = @@ -1383,7 +1381,7 @@ let%expect_test "[compare__local] is the same as [compare]" = (module Int) (compare Int.compare l1 l2) (compare__local Int.compare__local l1 l2)); - [%expect] + [%expect {| |}] ;; let%expect_test "[equal__local] is the same as [equal]" = @@ -1397,7 +1395,7 @@ let%expect_test "[equal__local] is the same as [equal]" = (module Bool) (equal Int.equal l1 l2) (equal__local Int.equal__local l1 l2)); - [%expect] + [%expect {| |}] ;; let%expect_test "list sort, dedup" = @@ -1599,48 +1597,180 @@ let%expect_test "[concat_mapi]" = [%expect {| (0 1 2 3 1 2 3 4 5 2 3 4 5 6 7) |}] ;; -let%expect_test "[filter]" = - let test list = - List.filter list ~f:(fun n -> n % 3 > 0) |> [%sexp_of: int list] |> print_s - in - test []; - [%expect {| () |}]; - test [ 1 ]; - [%expect {| (1) |}]; - test [ 1; 2 ]; - [%expect {| (1 2) |}]; - test [ 1; 2; 3 ]; - [%expect {| (1 2) |}]; - test [ 1; 2; 3; 4 ]; - [%expect {| (1 2 4) |}]; - test [ 4; 5; 6 ]; - [%expect {| (4 5) |}] +let%test_module "filter{,i}" = + (module struct + open Base_quickcheck + + module Int_list = struct + type t = int list [@@deriving equal, sexp_of] + end + + let%expect_test "[filter]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + (* test [f] *) + let pos = List.filter list ~f in + require [%here] (List.for_all pos ~f); + (* test [~f] *) + let not_f = Fn.non f in + let neg = List.filter list ~f:not_f in + require [%here] (List.for_all neg ~f:not_f); + (* test [f \/ ~f] *) + let sort = sort ~compare:Int.compare in + require_equal [%here] (module Int_list) (sort list) (sort (pos @ neg))) + ;; + + let%expect_test "[filteri]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + let pos, neg = + (* stash the original indices, so that we can retrieve them after filtering *) + let list = mapi list ~f:(fun i x -> i, x) in + let ignore_stash f : _ = fun i (_, x) -> f i x in + let use_orig_index f : _ = fun (i, x) -> f i x in + (* test [f] *) + let pos = List.filteri list ~f:(ignore_stash f) in + require [%here] (List.for_all pos ~f:(use_orig_index f)); + (* test [~f] *) + let not_f i x = not (f i x) in + let neg = List.filteri list ~f:(ignore_stash not_f) in + require [%here] (List.for_all neg ~f:(use_orig_index not_f)); + pos, neg + in + (* test [f \/ ~f] *) + let sort = sort ~compare:[%compare: int * _] in + require_equal [%here] (module Int_list) list (sort (pos @ neg) |> map ~f:snd)) + ;; + + let%expect_test "[filteri ~f:(Fn.const f) = filter ~f]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal + [%here] + (module Int_list) + (filteri list ~f:(fun _ x -> f x)) + (filter list ~f)) + ;; + + let%expect_test "[filter]" = + let test list = + List.filter list ~f:(fun n -> n % 3 > 0) |> [%sexp_of: int list] |> print_s + in + test []; + [%expect {| () |}]; + test [ 1 ]; + [%expect {| (1) |}]; + test [ 1; 2 ]; + [%expect {| (1 2) |}]; + test [ 1; 2; 3 ]; + [%expect {| (1 2) |}]; + test [ 1; 2; 3; 4 ]; + [%expect {| (1 2 4) |}]; + test [ 4; 5; 6 ]; + [%expect {| (4 5) |}] + ;; + + let%expect_test "[filteri]" = + let test list = + List.filteri list ~f:(fun i n -> n > i) |> [%sexp_of: int list] |> print_s + in + test []; + [%expect {| () |}]; + test [ 0 ]; + [%expect {| () |}]; + test [ 0; 1 ]; + [%expect {| () |}]; + test [ 0; 1; 2 ]; + [%expect {| () |}]; + test [ 1 ]; + [%expect {| (1) |}]; + test [ 1; 2 ]; + [%expect {| (1 2) |}]; + test [ 1; 2; 3 ]; + [%expect {| (1 2 3) |}]; + test [ 1; 0 ]; + [%expect {| (1) |}]; + test [ 2; 1; 0 ]; + [%expect {| (2) |}]; + test [ 3; 2; 1; 0 ]; + [%expect {| (3 2) |}] + ;; + end) ;; -let%expect_test "[filteri]" = - let test list = - List.filteri list ~f:(fun i n -> n > i) |> [%sexp_of: int list] |> print_s - in - test []; - [%expect {| () |}]; - test [ 0 ]; - [%expect {| () |}]; - test [ 0; 1 ]; - [%expect {| () |}]; - test [ 0; 1; 2 ]; - [%expect {| () |}]; - test [ 1 ]; - [%expect {| (1) |}]; - test [ 1; 2 ]; - [%expect {| (1 2) |}]; - test [ 1; 2; 3 ]; - [%expect {| (1 2 3) |}]; - test [ 1; 0 ]; - [%expect {| (1) |}]; - test [ 2; 1; 0 ]; - [%expect {| (2) |}]; - test [ 3; 2; 1; 0 ]; - [%expect {| (3 2) |}] +let%test_module "count{,i}" = + (module struct + let%expect_test "[count{,i} list ~f = List.length (filter{,i} list ~f)]" = + quickcheck_m + [%here] + (module struct + type t = int list * (int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal [%here] (module Int) (count list ~f) (length (filter list ~f))); + quickcheck_m + [%here] + (module struct + type t = int list * (int -> int -> bool) [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (list, f) -> + require_equal [%here] (module Int) (counti list ~f) (length (filteri list ~f))) + ;; + + let%test_unit _ = + [%test_result: int] (counti [ 0; 1; 2; 3; 4 ] ~f:(fun idx x -> idx = x)) ~expect:5 + ;; + + let%test_unit _ = + [%test_result: int] + (counti [ 0; 1; 2; 3; 4 ] ~f:(fun idx x -> idx = 4 - x)) + ~expect:1 + ;; + end) +;; + +let%test_module "{min,max}_elt" = + (module struct + let test_in_list_and_forall ~tested_f ~holds_for_res_over_all_elem = + quickcheck_m + [%here] + (module struct + type t = int list [@@deriving quickcheck, sexp_of] + end) + ~f:(fun list -> + let res = tested_f list ~compare:[%compare: int] in + match res with + | None -> require [%here] (is_empty list) + | Some res -> + require [%here] (mem list res ~equal:Int.equal); + iter list ~f:(fun elem -> + require [%here] (holds_for_res_over_all_elem ~res ~elem))) + ;; + + let%expect_test "min_elt" = + test_in_list_and_forall + ~tested_f:min_elt + ~holds_for_res_over_all_elem:(fun ~res ~elem -> res <= elem) + ;; + + let%expect_test "max_elt" = + test_in_list_and_forall + ~tested_f:max_elt + ~holds_for_res_over_all_elem:(fun ~res ~elem -> res >= elem) + ;; + end) ;; let%expect_test "[map2]" = @@ -1731,27 +1861,35 @@ let%expect_test "[merge]" = test_pair [] []; [%expect {| () - () |}]; + () + |}]; test_pair [] [ 1, "a"; 2, "b"; 3, "c" ]; [%expect {| ((1 a) (2 b) (3 c)) - ((1 a) (2 b) (3 c)) |}]; + ((1 a) (2 b) (3 c)) + |}]; test_pair [ 1, "z"; 2, "y" ] [ 3, "x"; 4, "w"; 5, "v" ]; - [%expect {| + [%expect + {| ((1 z) (2 y) (3 x) (4 w) (5 v)) - ((1 z) (2 y) (3 x) (4 w) (5 v)) |}]; + ((1 z) (2 y) (3 x) (4 w) (5 v)) + |}]; test_pair [ 1, "a"; 2, "b" ] []; [%expect {| ((1 a) (2 b)) - ((1 a) (2 b)) |}]; + ((1 a) (2 b)) + |}]; test_pair [ 1, "a"; 3, "b" ] [ 1, "b"; 2, "a" ]; [%expect {| ((1 a) (1 b) (2 a) (3 b)) - ((1 b) (1 a) (2 a) (3 b)) |}]; + ((1 b) (1 a) (2 a) (3 b)) + |}]; test_pair [ 0, "!"; 1, "b"; 2, "a" ] [ 1, "a"; 2, "b" ]; - [%expect {| + [%expect + {| ((0 !) (1 b) (1 a) (2 a) (2 b)) - ((0 !) (1 a) (1 b) (2 b) (2 a)) |}] + ((0 !) (1 a) (1 b) (2 b) (2 a)) + |}] ;; let%expect_test "[sub]" = diff --git a/test/test_map.ml b/test/test_map.ml index 71d27d62..c3050dec 100644 --- a/test/test_map.ml +++ b/test/test_map.ml @@ -18,7 +18,8 @@ let%expect_test "Finished_or_unfinished <-> Continue_or_stop" = (Finished_or_unfinished.of_continue_or_stop c_or_s)); [%expect {| (Continue Finished) - (Stop Unfinished) |}] + (Stop Unfinished) + |}] ;; let%test _ = @@ -58,7 +59,8 @@ let%expect_test "[Map.of_alist_multi] preserves value ordering" = : int list Map.M(String).t)]; [%expect {| ((a (1 2)) - (b (1 3))) |}] + (b (1 3))) + |}] ;; let%expect_test "find_exn" = @@ -108,21 +110,24 @@ let%expect_test "combine_errors" = test [ Error "one" ]; [%expect {| (Ok ((1 one))) - (Error ((1 one))) |}]; + (Error ((1 one))) + |}]; (* multiple ok *) test [ Ok "one"; Ok "two"; Ok "three" ]; [%expect {| (Ok ( (1 one) (2 two) - (3 three))) |}]; + (3 three))) + |}]; (* multiple errors *) test [ Error "one"; Error "two"; Error "three" ]; [%expect {| (Error ( (1 one) (2 two) - (3 three))) |}]; + (3 three))) + |}]; (* one error among oks *) test [ Error "one"; Ok "two"; Ok "three" ]; test [ Ok "one"; Error "two"; Ok "three" ]; @@ -130,7 +135,8 @@ let%expect_test "combine_errors" = [%expect {| (Error ((1 one))) (Error ((2 two))) - (Error ((3 three))) |}]; + (Error ((3 three))) + |}]; (* one ok among errors *) test [ Ok "one"; Error "two"; Error "three" ]; test [ Error "one"; Ok "two"; Error "three" ]; @@ -145,7 +151,8 @@ let%expect_test "combine_errors" = (3 three))) (Error ( (1 one) - (2 two))) |}] + (2 two))) + |}] ;; let%test_module "Poly" = @@ -367,7 +374,8 @@ let%expect_test "[map_keys]" = (Ok ( (1 one) (2 two) - (3 three))) |}]; + (3 three))) + |}]; test map (module String) ~f:(fun x -> Int.to_string (x / 2)); [%expect {| (Duplicate_key 1) |}] ;; @@ -414,7 +422,8 @@ let%expect_test "[merge_disjoint_exn] success" = [%expect {| ((1 one) (2 two) - (3 three)) |}] + (3 three)) + |}] ;; let%expect_test "[merge_disjoint_exn] failure" = diff --git a/test/test_map.mlt b/test/test_map.mlt index 2572ae70..7261c9a0 100644 --- a/test/test_map.mlt +++ b/test/test_map.mlt @@ -2,6 +2,4 @@ open Base let _ = Map.add -[%%expect - {| -|}] +[%%expect {| |}] diff --git a/test/test_map_traversal.ml b/test/test_map_traversal.ml index 62675982..90a07d74 100644 --- a/test/test_map_traversal.ml +++ b/test/test_map_traversal.ml @@ -128,7 +128,8 @@ let%expect_test "mapi lazy check" = ((key 2) (data 2)) ((key 3) - (data 3)) |}]; + (data 3)) + |}]; (* take more than enough steps to finish, expect the rest of the output *) let test_output = match more_computation.compute ~steps:100 with @@ -150,5 +151,6 @@ let%expect_test "mapi lazy check" = ((key 8) (data 8)) ((key 9) - (data 9)) |}] + (data 9)) + |}] ;; diff --git a/test/test_minmax.ml b/test/test_minmax.ml index c6a35c2c..7542d638 100644 --- a/test/test_minmax.ml +++ b/test/test_minmax.ml @@ -39,7 +39,8 @@ let%expect_test "small values" = (min 4 -20 = -20) (max 4 -20 = 4) (min 100 0 = 0) - (max 100 0 = 100) |}] + (max 100 0 = 100) + |}] in test (module Int); test (module Int64); @@ -65,7 +66,8 @@ let%expect_test "fixed-size types" = = 9_223_372_036_854_775_807) (min 0 -9_223_372_036_854_775_808 = -9_223_372_036_854_775_808) - (max 0 -9_223_372_036_854_775_808 = 0) |}]; + (max 0 -9_223_372_036_854_775_808 = 0) + |}]; test (module Int32) Large; [%expect {| @@ -74,7 +76,8 @@ let%expect_test "fixed-size types" = (min 2_147_483_647 2_147_483_647 = 2_147_483_647) (max 2_147_483_647 2_147_483_647 = 2_147_483_647) (min 0 -2_147_483_648 = -2_147_483_648) - (max 0 -2_147_483_648 = 0) |}] + (max 0 -2_147_483_648 = 0) + |}] ;; let%expect_test ("64-bit platforms" [@tags "no-js", "64-bits-only"]) = @@ -94,7 +97,8 @@ let%expect_test ("64-bit platforms" [@tags "no-js", "64-bits-only"]) = = 4_611_686_018_427_387_903) (min 0 -4_611_686_018_427_387_904 = -4_611_686_018_427_387_904) - (max 0 -4_611_686_018_427_387_904 = 0) |}]; + (max 0 -4_611_686_018_427_387_904 = 0) + |}]; test (module Nativeint) Large; [%expect {| @@ -111,7 +115,8 @@ let%expect_test ("64-bit platforms" [@tags "no-js", "64-bits-only"]) = = 9_223_372_036_854_775_807) (min 0 -9_223_372_036_854_775_808 = -9_223_372_036_854_775_808) - (max 0 -9_223_372_036_854_775_808 = 0) |}] + (max 0 -9_223_372_036_854_775_808 = 0) + |}] ;; let%expect_test ("32-bit platforms" [@tags "no-js", "32-bits-only"]) = @@ -123,7 +128,8 @@ let%expect_test ("32-bit platforms" [@tags "no-js", "32-bits-only"]) = (min 1_073_741_823 1_073_741_823 = 1_073_741_823) (max 1_073_741_823 1_073_741_823 = 1_073_741_823) (min 0 -1_073_741_824 = -1_073_741_824) - (max 0 -1_073_741_824 = 0) |}]; + (max 0 -1_073_741_824 = 0) + |}]; test (module Nativeint) Large; [%expect {| @@ -132,7 +138,8 @@ let%expect_test ("32-bit platforms" [@tags "no-js", "32-bits-only"]) = (min 2_147_483_647 2_147_483_647 = 2_147_483_647) (max 2_147_483_647 2_147_483_647 = 2_147_483_647) (min 0 -2_147_483_648 = -2_147_483_648) - (max 0 -2_147_483_648 = 0) |}] + (max 0 -2_147_483_648 = 0) + |}] ;; let%expect_test ("js_of_ocaml platforms" [@tags "js-only"]) = @@ -144,7 +151,8 @@ let%expect_test ("js_of_ocaml platforms" [@tags "js-only"]) = (min 2_147_483_647 2_147_483_647 = 2_147_483_647) (max 2_147_483_647 2_147_483_647 = 2_147_483_647) (min 0 -2_147_483_648 = -2_147_483_648) - (max 0 -2_147_483_648 = 0) |}]; + (max 0 -2_147_483_648 = 0) + |}]; test (module Nativeint) Large; [%expect {| @@ -153,5 +161,6 @@ let%expect_test ("js_of_ocaml platforms" [@tags "js-only"]) = (min 2_147_483_647 2_147_483_647 = 2_147_483_647) (max 2_147_483_647 2_147_483_647 = 2_147_483_647) (min 0 -2_147_483_648 = -2_147_483_648) - (max 0 -2_147_483_648 = 0) |}] + (max 0 -2_147_483_648 = 0) + |}] ;; diff --git a/test/test_nativeint.ml b/test/test_nativeint.ml index 4138b078..1e652cb2 100644 --- a/test/test_nativeint.ml +++ b/test/test_nativeint.ml @@ -46,25 +46,30 @@ let%expect_test "binary" = [%expect {| 0b1 0b1 - 0b1 |}]; + 0b1 + |}]; test_binary 0b100n; [%expect {| 0b100 0b100 - 0b100 |}]; + 0b100 + |}]; test_binary 0b101n; [%expect {| 0b101 0b101 - 0b101 |}]; + 0b101 + |}]; test_binary 0b101010_10101010n; [%expect {| 0b10_1010_1010_1010 0b10101010101010 - 0b10101010101010 |}]; + 0b10_1010_1010_1010 + |}]; test_binary 0b111111_00000000n; [%expect {| 0b11_1111_0000_0000 0b11111100000000 - 0b11111100000000 |}] + 0b11_1111_0000_0000 + |}] ;; diff --git a/test/test_nativeint_pow2.ml b/test/test_nativeint_pow2.ml index cda6a1ed..b9641e2f 100644 --- a/test/test_nativeint_pow2.ml +++ b/test/test_nativeint_pow2.ml @@ -27,7 +27,8 @@ let%expect_test "[floor_log2]" = (9 (Ok 3)) (63 (Ok 5)) (64 (Ok 6)) - (65 (Ok 6)) |}] + (65 (Ok 6)) + |}] ;; let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = @@ -39,7 +40,8 @@ let%expect_test ("[floor_log2]" [@tags "64-bits-only"]) = (-9_223_372_036_854_775_807 ( Error ("[Nativeint.floor_log2] got invalid input" -9223372036854775807))) (9_223_372_036_854_775_806 (Ok 62)) - (9_223_372_036_854_775_807 (Ok 62)) |}] + (9_223_372_036_854_775_807 (Ok 62)) + |}] ;; let%expect_test "[ceil_log2]" = @@ -58,7 +60,8 @@ let%expect_test "[ceil_log2]" = (9 (Ok 4)) (63 (Ok 6)) (64 (Ok 6)) - (65 (Ok 7)) |}] + (65 (Ok 7)) + |}] ;; let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = @@ -70,7 +73,8 @@ let%expect_test ("[ceil_log2]" [@tags "64-bits-only"]) = (-9_223_372_036_854_775_807 ( Error ("[Nativeint.ceil_log2] got invalid input" -9223372036854775807))) (9_223_372_036_854_775_806 (Ok 63)) - (9_223_372_036_854_775_807 (Ok 63)) |}] + (9_223_372_036_854_775_807 (Ok 63)) + |}] ;; let%test_module "nativeint_math" = diff --git a/test/test_not_found.mlt b/test/test_not_found.mlt index 4225716b..ca5c8ae3 100644 --- a/test/test_not_found.mlt +++ b/test/test_not_found.mlt @@ -3,7 +3,11 @@ open Expect_test_helpers_base;; print_s [%sexp (Not_found_s [%message "foo"] : exn)] -[%%expect {| (Not_found_s foo) |}];; +[%%expect + {| +(Not_found_s foo) +|}] +;; Not_found diff --git a/test/test_option.ml b/test/test_option.ml index 147029be..e3ca0db5 100644 --- a/test/test_option.ml +++ b/test/test_option.ml @@ -18,7 +18,8 @@ let%expect_test "[value_or_thunk]" = test None; [%expect {| THUNK! - 0 |}]; + 0 + |}]; (* same value, no trigger *) test (Some 0); [%expect {| 0 |}]; @@ -29,7 +30,8 @@ let%expect_test "[value_or_thunk]" = test None; [%expect {| THUNK! - 0 |}] + 0 + |}] ;; let%expect_test "map2" = diff --git a/test/test_or_error.ml b/test/test_or_error.ml index 6c376815..ac9efea6 100644 --- a/test/test_or_error.ml +++ b/test/test_or_error.ml @@ -58,7 +58,7 @@ let%expect_test "behavior and performance on lists of or_error's" = List.init len ~f:(Or_error.errorf "at %d") in let short_lists = List.map ~f:make_list [ 0; 1; 2; 10 ] in - let long_list = make_list 1_000_000 in + let long_list = make_list 500_000 in let to_string = function | Ok _ -> "ok" | Error error -> @@ -81,47 +81,54 @@ let%expect_test "behavior and performance on lists of or_error's" = ok at 0 ("at 0" "at 1") - ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") |}]; + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; test all_unit; [%expect {| ok at 0 ("at 0" "at 1") - ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") |}]; + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; test combine_errors; [%expect {| ok "at 0" ("at 0" "at 1") - ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") |}]; + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; test combine_errors_unit; [%expect {| ok "at 0" ("at 0" "at 1") - ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") |}]; + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; test find_ok; [%expect {| () "at 0" ("at 0" "at 1") - ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") |}]; + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; test (find_map_ok ~f:Fn.id); [%expect {| () "at 0" ("at 0" "at 1") - ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") |}]; + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}]; test filter_ok_at_least_one; [%expect {| () "at 0" ("at 0" "at 1") - ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") |}] + ("at 0" "at 1" "at 2" "at 3" "at 4" "at 5" "at 6" "at 7" "at 8" "at 9") + |}] ;; diff --git a/test/test_pp.ml b/test/test_pp.ml index cb28be4f..4c359356 100644 --- a/test/test_pp.ml +++ b/test/test_pp.ml @@ -13,21 +13,25 @@ let%expect_test "pretty-printers" = [%expect {| '\000' '\r' - 'a' |}]; + 'a' + |}]; print_all String.pp [ ""; "foo"; "abc\tdef" ]; [%expect {| "" "foo" - "abc\tdef" |}]; + "abc\tdef" + |}]; print_all Sign.pp Sign.all; [%expect {| Neg Zero - Pos |}]; + Pos + |}]; print_all Bool.pp Bool.all; [%expect {| false - true |}]; + true + |}]; print_all Unit.pp Unit.all; [%expect {| () |}]; print_all Nothing.pp Nothing.all; @@ -36,11 +40,13 @@ let%expect_test "pretty-printers" = [%expect {| 0. 3.14 - inf |}]; + inf + |}]; print_all Int.pp [ 0; 1 ]; [%expect {| 0 - 1 |}]; + 1 + |}]; print Info.pp (Info.create_s [%sexp "hello", "world"]); [%expect {| (hello world) |}] ;; diff --git a/test/test_ppx_compare_lib.ml b/test/test_ppx_compare_lib.ml index 43d17d77..10305b94 100644 --- a/test/test_ppx_compare_lib.ml +++ b/test/test_ppx_compare_lib.ml @@ -89,5 +89,6 @@ let%expect_test "[compare_abstract]" = {| (raised ( Failure - "Compare called on the type TY, which is abstract in an implementation.")) |}] + "Compare called on the type TY, which is abstract in an implementation.")) + |}] ;; diff --git a/test/test_queue.ml b/test/test_queue.ml index cefbe65c..a7cd6814 100644 --- a/test/test_queue.ml +++ b/test/test_queue.ml @@ -1162,7 +1162,8 @@ let%test_module _ = (length 2) (elts ( (_) - (_))))) |}] + (_))))) + |}] ;; end end diff --git a/test/test_random.ml b/test/test_random.ml index 4ad380d1..95c04614 100644 --- a/test/test_random.ml +++ b/test/test_random.ml @@ -76,7 +76,7 @@ let%expect_test "float" = ~min:0. ~max:100. ~check_range:(10., 20.); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "float_range" = @@ -88,12 +88,12 @@ let%expect_test "float_range" = ~min:(-100.) ~max:100. ~check_range:(-20., -10.); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "int" = test [%here] (module Int) 1_000 (fun () -> int 100) ~min:0 ~max:99 ~check_range:(10, 20); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "int_incl" = @@ -105,7 +105,7 @@ let%expect_test "int_incl" = ~min:(-100) ~max:100 ~check_range:(-20, -10); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Int) @@ -114,7 +114,7 @@ let%expect_test "int_incl" = ~min:0 ~max:Int.max_value ~check_range:(0, Int.max_value / 100); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Int) @@ -123,7 +123,7 @@ let%expect_test "int_incl" = ~min:Int.min_value ~max:Int.max_value ~check_range:(Int.min_value / 100, Int.max_value / 100); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "int32" = @@ -135,7 +135,7 @@ let%expect_test "int32" = ~min:0l ~max:99l ~check_range:(10l, 20l); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "int32_incl" = @@ -147,7 +147,7 @@ let%expect_test "int32_incl" = ~min:(-100l) ~max:100l ~check_range:(-20l, -10l); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Int32) @@ -156,7 +156,7 @@ let%expect_test "int32_incl" = ~min:0l ~max:Int32.max_value ~check_range:(0l, Int32.( / ) Int32.max_value 100l); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Int32) @@ -165,7 +165,7 @@ let%expect_test "int32_incl" = ~min:Int32.min_value ~max:Int32.max_value ~check_range:(Int32.( / ) Int32.min_value 100l, Int32.( / ) Int32.max_value 100l); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "int64" = @@ -177,7 +177,7 @@ let%expect_test "int64" = ~min:0L ~max:99L ~check_range:(10L, 20L); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "int64_incl" = @@ -189,7 +189,7 @@ let%expect_test "int64_incl" = ~min:(-100L) ~max:100L ~check_range:(-20L, -10L); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Int64) @@ -198,7 +198,7 @@ let%expect_test "int64_incl" = ~min:0L ~max:Int64.max_value ~check_range:(0L, Int64.( / ) Int64.max_value 100L); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Int64) @@ -207,7 +207,7 @@ let%expect_test "int64_incl" = ~min:Int64.min_value ~max:Int64.max_value ~check_range:(Int64.( / ) Int64.min_value 100L, Int64.( / ) Int64.max_value 100L); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "nativeint" = @@ -219,7 +219,7 @@ let%expect_test "nativeint" = ~min:0n ~max:99n ~check_range:(10n, 20n); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "nativeint_incl" = @@ -231,7 +231,7 @@ let%expect_test "nativeint_incl" = ~min:(-100n) ~max:100n ~check_range:(-20n, -10n); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Nativeint) @@ -240,7 +240,7 @@ let%expect_test "nativeint_incl" = ~min:0n ~max:Nativeint.max_value ~check_range:(0n, Nativeint.( / ) Nativeint.max_value 100n); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Nativeint) @@ -250,7 +250,7 @@ let%expect_test "nativeint_incl" = ~max:Nativeint.max_value ~check_range: (Nativeint.( / ) Nativeint.min_value 100n, Nativeint.( / ) Nativeint.max_value 100n); - [%expect {||}] + [%expect {| |}] ;; (* The int63 functions come from [Int63] rather than [Random], but we test them here @@ -266,7 +266,7 @@ let%expect_test "int63" = ~min:(i 0) ~max:(i 99) ~check_range:(i 10, i 20); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "int63_incl" = @@ -279,7 +279,7 @@ let%expect_test "int63_incl" = ~min:(i (-100)) ~max:(i 100) ~check_range:(i (-20), i (-10)); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Int63) @@ -288,7 +288,7 @@ let%expect_test "int63_incl" = ~min:(i 0) ~max:Int63.max_value ~check_range:(i 0, Int63.( / ) Int63.max_value (i 100)); - [%expect {||}]; + [%expect {| |}]; test [%here] (module Int63) @@ -297,7 +297,7 @@ let%expect_test "int63_incl" = ~min:Int63.min_value ~max:Int63.max_value ~check_range:(Int63.( / ) Int63.min_value (i 100), Int63.( / ) Int63.max_value (i 100)); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "ascii" = @@ -309,7 +309,7 @@ let%expect_test "ascii" = ~min:Char.min_value ~max:(Char.of_int_exn 127) ~check_range:('a', 'z'); - [%expect {||}] + [%expect {| |}] ;; let%expect_test "char" = @@ -321,7 +321,7 @@ let%expect_test "char" = ~min:Char.min_value ~max:Char.max_value ~check_range:('\128', '\255'); - [%expect {||}] + [%expect {| |}] ;; let%test_module "float upper bound is inclusive despite docs" = @@ -358,9 +358,10 @@ let%test_module "float upper bound is inclusive despite docs" = print_s [%message "likelihood of failure" (failures : int ref) (prob : float)]; [%expect {| - ("likelihood of failure" - (failures 64) - (prob 5.5511151231257827E-17)) |}] + ("likelihood of failure" + (failures 64) + (prob 5.5511151231257827E-17)) + |}] ;; end) ;; diff --git a/test/test_ref.ml b/test/test_ref.ml index 78c4b84f..518f0715 100644 --- a/test/test_ref.ml +++ b/test/test_ref.ml @@ -40,19 +40,23 @@ let%expect_test "[sets_temporarily] without raise" = test []; [%expect {| ((r1 1) - (r2 2)) |}]; + (r2 2)) + |}]; test [ T (r1, 13) ]; [%expect {| ((r1 13) - (r2 2)) |}]; + (r2 2)) + |}]; test [ T (r1, 13); T (r1, 17) ]; [%expect {| ((r1 17) - (r2 2)) |}]; + (r2 2)) + |}]; test [ T (r1, 13); T (r2, 17) ]; [%expect {| ((r1 13) - (r2 17)) |}] + (r2 17)) + |}] ;; let%expect_test "[sets_temporarily] with raise" = diff --git a/test/test_sequence.ml b/test/test_sequence.ml index f30b26cf..3847257e 100644 --- a/test/test_sequence.ml +++ b/test/test_sequence.ml @@ -653,8 +653,7 @@ let%expect_test _ = let xs = init 3 ~f:Fn.id |> Generator.of_sequence in let ( @ ) xs ys = Generator.bind xs ~f:(fun () -> ys) in xs @ xs @ xs @ xs @ xs |> Generator.run |> [%sexp_of: int t] |> print_s; - [%expect {| - (0 1 2 0 1 2 0 1 2 0 1 2 0 1 2) |}] + [%expect {| (0 1 2 0 1 2 0 1 2 0 1 2 0 1 2) |}] ;; let%test_module "group" = @@ -708,7 +707,8 @@ let%test_module "Caml.Seq" = 1 2 3 - 4 |}] + 4 + |}] ;; let%expect_test "to_seq" = @@ -717,7 +717,8 @@ let%test_module "Caml.Seq" = 1 2 3 - 4 |}] + 4 + |}] ;; end) ;; diff --git a/test/test_set.ml b/test/test_set.ml index 0fbad1cb..4cfd70dc 100644 --- a/test/test_set.ml +++ b/test/test_set.ml @@ -37,7 +37,8 @@ let%expect_test "split_le_gt" = ((1 2) <= 2 < (3 4)) ((1 2 3) <= 3 < (4)) ((1 2 3 4) <= 4 < ()) - ((1 2 3 4) <= 5 < ()) |}] + ((1 2 3 4) <= 5 < ()) + |}] ;; let%expect_test "split_lt_ge" = @@ -70,7 +71,8 @@ let%expect_test "split_lt_ge" = ((1) < 2 <= (2 3 4)) ((1 2) < 3 <= (3 4)) ((1 2 3) < 4 <= (4)) - ((1 2 3 4) < 5 <= ()) |}] + ((1 2 3 4) < 5 <= ()) + |}] ;; let%test_module "Poly" = diff --git a/test/test_sign_or_nan.ml b/test/test_sign_or_nan.ml index f7bc2e64..18549fb2 100644 --- a/test/test_sign_or_nan.ml +++ b/test/test_sign_or_nan.ml @@ -19,5 +19,6 @@ let%expect_test "to_string_hum" = negative zero positive - not-a-number |}] + not-a-number + |}] ;; diff --git a/test/test_string.ml b/test/test_string.ml index ea34569c..8b59bb12 100644 --- a/test/test_string.ml +++ b/test/test_string.ml @@ -47,7 +47,8 @@ let%expect_test "edit distance" = (3 spots pith) (2 spots pits) (1 spots spits) - (0 spots spots) |}] + (0 spots spots) + |}] ;; let%test_module "concat" = @@ -296,7 +297,8 @@ let%test_module "Unicode" = (UTF-16LE "a\000b\000c\000") (UTF-16BE "\000a\000b\000c") (UTF-32LE "a\000\000\000b\000\000\000c\000\000\000") - (UTF-32BE "\000\000\000a\000\000\000b\000\000\000c") |}]; + (UTF-32BE "\000\000\000a\000\000\000b\000\000\000c") + |}]; test_conversions "\u{0065}\u{0301}"; [%expect {| @@ -306,7 +308,8 @@ let%test_module "Unicode" = (UTF-16LE "e\000\001\003") (UTF-16BE "\000e\003\001") (UTF-32LE "e\000\000\000\001\003\000\000") - (UTF-32BE "\000\000\000e\000\000\003\001") |}]; + (UTF-32BE "\000\000\000e\000\000\003\001") + |}]; test_conversions "\u{0063}\u{030C}"; [%expect {| @@ -316,7 +319,8 @@ let%test_module "Unicode" = (UTF-16LE "c\000\012\003") (UTF-16BE "\000c\003\012") (UTF-32LE "c\000\000\000\012\003\000\000") - (UTF-32BE "\000\000\000c\000\000\003\012") |}]; + (UTF-32BE "\000\000\000c\000\000\003\012") + |}]; test_conversions "\u{0E28}\u{0E34}"; [%expect {| @@ -326,7 +330,8 @@ let%test_module "Unicode" = (UTF-16LE "(\0144\014") (UTF-16BE "\014(\0144") (UTF-32LE "(\014\000\0004\014\000\000") - (UTF-32BE "\000\000\014(\000\000\0144") |}]; + (UTF-32BE "\000\000\014(\000\000\0144") + |}]; test_conversions "\u{1D11E}"; [%expect {| @@ -336,7 +341,8 @@ let%test_module "Unicode" = (UTF-16LE "4\216\030\221") (UTF-16BE "\2164\221\030") (UTF-32LE "\030\209\001\000") - (UTF-32BE "\000\001\209\030") |}]; + (UTF-32BE "\000\001\209\030") + |}]; test_conversions "\u{1D56C}"; [%expect {| @@ -346,7 +352,8 @@ let%test_module "Unicode" = (UTF-16LE "5\216l\221") (UTF-16BE "\2165\221l") (UTF-32LE "l\213\001\000") - (UTF-32BE "\000\001\213l") |}]; + (UTF-32BE "\000\001\213l") + |}]; test_conversions "\xFF\xFF"; [%expect {| @@ -357,7 +364,8 @@ let%test_module "Unicode" = (UTF-16LE "\253\255\253\255") (UTF-16BE "\255\253\255\253") (UTF-32LE "\253\255\000\000\253\255\000\000") - (UTF-32BE "\000\000\255\253\000\000\255\253") |}] + (UTF-32BE "\000\000\255\253\000\000\255\253") + |}] ;; let%expect_test "Test [get] used at an invalid offset" = @@ -371,7 +379,8 @@ let%test_module "Unicode" = {| ("Base.String.Utf8.get: invalid UTF-8 encoding at given position" "\206\177\206\178" - (pos 1)) |}] + (pos 1)) + |}] ;; end) ;; @@ -1182,13 +1191,15 @@ let%expect_test "is_substring_at" = {| (raised ( Invalid_argument - "String.is_substring_at: invalid index 100 for string of length 26")) |}]; + "String.is_substring_at: invalid index 100 for string of length 26")) + |}]; test (-1) ""; [%expect {| (raised ( Invalid_argument - "String.is_substring_at: invalid index -1 for string of length 26")) |}] + "String.is_substring_at: invalid index -1 for string of length 26")) + |}] ;; let%expect_test "prefixes and suffixes" = @@ -1238,31 +1249,38 @@ let%expect_test "testing prefixes and suffixes" = test "" "a"; [%expect {| ((is_prefix false) - (is_suffix false)) |}]; + (is_suffix false)) + |}]; test "" ""; [%expect {| ((is_prefix true) - (is_suffix true)) |}]; + (is_suffix true)) + |}]; test "Foo" ""; [%expect {| ((is_prefix true) - (is_suffix true)) |}]; + (is_suffix true)) + |}]; test "H" "H"; [%expect {| ((is_prefix true) - (is_suffix true)) |}]; + (is_suffix true)) + |}]; test "Hello" "He"; [%expect {| ((is_prefix true) - (is_suffix false)) |}]; + (is_suffix false)) + |}]; test "Hello" "lo"; [%expect {| ((is_prefix false) - (is_suffix true)) |}]; + (is_suffix true)) + |}]; test "HelloFoo" "lo"; [%expect {| ((is_prefix false) - (is_suffix false)) |}] + (is_suffix false)) + |}] ;; let%expect_test "chop_prefix" = @@ -1366,23 +1384,29 @@ let%expect_test "pad_left and pad_right" = {| ((t "") (padded_left " ") - (padded_right " ")) |}]; + (padded_right " ")) + |}]; test "foo" ~len:2; - [%expect {| + [%expect + {| ((t foo) (padded_left foo) - (padded_right foo)) |}]; + (padded_right foo)) + |}]; test "foo" ~len:3; - [%expect {| + [%expect + {| ((t foo) (padded_left foo) - (padded_right foo)) |}]; + (padded_right foo)) + |}]; test "foo" ~len:10 ~char:'_'; [%expect {| ((t foo) (padded_left _______foo) - (padded_right foo_______)) |}] + (padded_right foo_______)) + |}] ;; let%test_module "functions that raise Not_found_s" = @@ -1418,7 +1442,8 @@ let%test_module "functions that raise Not_found_s" = (Error (Not_found_s "String.index_from_exn: not found")) (Error (Not_found_s "String.index_from_exn: not found")) (Error (Not_found_s "String.index_from_exn: not found")) - (Error (Not_found_s "String.index_from_exn: not found")) |}]; + (Error (Not_found_s "String.index_from_exn: not found")) + |}]; test "a:b:c"; [%expect {| @@ -1427,7 +1452,8 @@ let%test_module "functions that raise Not_found_s" = (Ok 3) (Ok 3) (Error (Not_found_s "String.index_from_exn: not found")) - (Error (Not_found_s "String.index_from_exn: not found")) |}]; + (Error (Not_found_s "String.index_from_exn: not found")) + |}]; let test_bounds s = test_at s (-1); test_at s (length s + 1) @@ -1436,7 +1462,8 @@ let%test_module "functions that raise Not_found_s" = [%expect {| (Error (Invalid_argument String.index_from_exn)) - (Error (Invalid_argument String.index_from_exn)) |}] + (Error (Invalid_argument String.index_from_exn)) + |}] ;; let%expect_test "rindex_exn" = @@ -1468,7 +1495,8 @@ let%test_module "functions that raise Not_found_s" = (Error (Not_found_s "String.rindex_from_exn: not found")) (Error (Not_found_s "String.rindex_from_exn: not found")) (Error (Not_found_s "String.rindex_from_exn: not found")) - (Error (Not_found_s "String.rindex_from_exn: not found")) |}]; + (Error (Not_found_s "String.rindex_from_exn: not found")) + |}]; test "a:b:c"; [%expect {| @@ -1477,7 +1505,8 @@ let%test_module "functions that raise Not_found_s" = (Ok 1) (Ok 1) (Error (Not_found_s "String.rindex_from_exn: not found")) - (Error (Not_found_s "String.rindex_from_exn: not found")) |}]; + (Error (Not_found_s "String.rindex_from_exn: not found")) + |}]; let test_bounds s = test_at s (-2); test_at s (length s) @@ -1486,7 +1515,8 @@ let%test_module "functions that raise Not_found_s" = [%expect {| (Error (Invalid_argument String.rindex_from_exn)) - (Error (Invalid_argument String.rindex_from_exn)) |}] + (Error (Invalid_argument String.rindex_from_exn)) + |}] ;; let%expect_test "lsplit2_exn" = diff --git a/test/test_uniform_array.ml b/test/test_uniform_array.ml index 7090e479..cfeb7ad6 100644 --- a/test/test_uniform_array.ml +++ b/test/test_uniform_array.ml @@ -149,7 +149,8 @@ let%expect_test "mapi" = test [ "foo"; "bar" ]; [%expect {| ((0 Foo) - (1 Bar)) |}] + (1 Bar)) + |}] ;; let%expect_test "of_list_rev" = @@ -209,19 +210,23 @@ let%expect_test "partition_map" = test empty; [%expect {| () - () |}]; + () + |}]; test (of_list [ 0; 1; 2; 3 ]); [%expect {| (0 2) - (1 3) |}]; + (1 3) + |}]; test (of_list [ 0; 2; 4; 6 ]); [%expect {| (0 2 4 6) - () |}]; + () + |}]; test (of_list [ 1; 3; 5; 7 ]); [%expect {| () - (1 3 5 7) |}] + (1 3 5 7) + |}] ;; let%expect_test "filter" = diff --git a/test/test_word_size.ml b/test/test_word_size.ml index e071eb5b..44e1e8e9 100644 --- a/test/test_word_size.ml +++ b/test/test_word_size.ml @@ -3,9 +3,7 @@ open! Word_size let%expect_test _ = print_s [%message (W32 : t)]; - [%expect {| - (W32 W32) |}]; + [%expect {| (W32 W32) |}]; print_s [%message (W64 : t)]; - [%expect {| - (W64 W64) |}] + [%expect {| (W64 W64) |}] ;;