unikernel/duniverse/base/test/allocation/base_test_allocation.ml

@@ -0,0 +1 @@
+(*_ This library deliberately does not export anything. *)

unikernel/duniverse/base/test/allocation/bin/dune

@@ -0,0 +1,8 @@
+(executables
+ (modes byte exe)
+ (names test_option_array_allocation)
+ (libraries base expect_test_helpers_core compiler-libs.common
+   core_kernel.version_util)
+ (ocamlopt_flags :standard -O3)
+ (preprocess
+  (pps ppx_jane)))

unikernel/duniverse/base/test/allocation/bin/test_option_array_allocation.ml

@@ -0,0 +1,58 @@
+open! Base
+open Option_array
+open Expect_test_helpers_core
+
+let () =
+  let t = of_array [| None |] in
+  assert (
+    require_no_allocation [%here] (fun () ->
+      match get t 0 with
+      | None -> true
+      | Some _ -> false))
+;;
+
+let () =
+  let t = of_array [| Some 0 |] in
+  let get_some () =
+    match get t 0 with
+    | None -> false
+    | Some _ -> true
+  in
+  (* After inlining, [match get t 0 with] is:
+
+     {[
+       match
+         let cheap_option = Uniform_array.get t 0 in
+         if Cheap_option.is_some cheap_option
+         then Some (Cheap_option.value_unsafe cheap_option)
+         else None
+       with
+     ]}
+
+     This situation is called "match-in-match" (the inner [if] is essentially a match).
+     The OCaml compiler and Flambda optimizer don't handle match-in-match well, and so
+     cannot eliminate the allocation of [Some].  Flambda2 is expected to eliminate the
+     allocation, at which point we can [require_no_allocation] (possibly annotating the
+     test with [@tags "fast-flambda"]).
+
+     Note that Flambda 2 only eliminates the allocation in optimized mode.
+     In classic mode, it will remain.  This file is compiled with optimized mode.
+  *)
+  let compiler_eliminates_the_allocation =
+    (* [Version_util.x_library_inlining] is the whole reason this is a separate
+       executable. *)
+    Config.flambda2 && Version_util.x_library_inlining
+  in
+  if compiler_eliminates_the_allocation
+  then assert (require_no_allocation [%here] get_some)
+  else
+    let module Gc = Core.Gc.For_testing in
+    let _, { Gc.Allocation_report.minor_words_allocated; _ } =
+      Gc.measure_allocation get_some
+    in
+    if minor_words_allocated <= 2
+    then ()
+    else
+      failwith
+        (Printf.sprintf "Allocated more words than expected: %d" minor_words_allocated)
+;;

unikernel/duniverse/base/test/allocation/bin/test_option_array_allocation.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/allocation/dune

@@ -0,0 +1,5 @@
+(library
+ (name base_test_allocation)
+ (libraries async base expect_test_helpers_async expect_test_helpers_core)
+ (preprocess
+  (pps ppx_jane)))

unikernel/duniverse/base/test/allocation/test_array_allocation.ml

@@ -0,0 +1,32 @@
+open! Base
+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 {| |}]
+;;
+
+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 {| |}]
+;;
+
+let%expect_test "equal does not allocate" =
+  let arr1 = [| 1; 2; 3; 4 |] in
+  let arr2 = [| 1; 2; 4; 3 |] in
+  require
+    [%here]
+    (require_no_allocation [%here] (fun () -> not (Array.equal Int.equal arr1 arr2)));
+  [%expect {| |}]
+;;
+
+let%expect_test "foldi does not allocate" =
+  let arr = [| 1; 2; 3; 4 |] in
+  let f i x y = i + x + y in
+  require
+    [%here]
+    (require_no_allocation [%here] (fun () -> 16 = Array.foldi ~init:0 ~f arr))
+;;

unikernel/duniverse/base/test/allocation/test_array_allocation.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/allocation/test_char_allocation.ml

@@ -0,0 +1,10 @@
+open! Base
+open Expect_test_helpers_core
+
+let%expect_test _ =
+  let x = Sys.opaque_identity 'a' in
+  let y = Sys.opaque_identity 'b' in
+  require_no_allocation [%here] (fun () ->
+    ignore (Sys.opaque_identity (Char.Caseless.equal x y) : bool));
+  [%expect {| |}]
+;;

unikernel/duniverse/base/test/allocation/test_char_allocation.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/allocation/test_float_allocation.ml

@@ -0,0 +1,10 @@
+open! Base
+open Stdio
+open Float
+
+let%expect_test "iround_nearest_exn noalloc" =
+  let t = Sys.opaque_identity 205.414 in
+  Expect_test_helpers_core.require_no_allocation [%here] (fun () -> iround_nearest_exn t)
+  |> printf "%d\n";
+  [%expect {| 205 |}]
+;;

unikernel/duniverse/base/test/allocation/test_float_allocation.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/allocation/test_hashtbl_allocation.ml

@@ -0,0 +1,90 @@
+open! Base
+open Expect_test_helpers_core
+
+let () = Int_conversions.sexp_of_int_style := `Underscores
+
+let%expect_test "find_and_call_1_and_2" =
+  let test x =
+    let t = Hashtbl.create (module Int) ~size:16 ~growth_allowed:false in
+    for i = 0 to x - 1 do
+      Hashtbl.add_exn t ~key:i ~data:(i * 7)
+    done;
+    let if_found a b = assert (a = b) in
+    let if_not_found a b =
+      assert (a = x);
+      assert (b = x * 7)
+    in
+    require_no_allocation [%here] (fun () ->
+      for i = 0 to x do
+        Hashtbl.find_and_call1 t i ~a:(i * 7) ~if_found ~if_not_found
+      done);
+    let if_found ~key ~data:a b =
+      assert (a = b);
+      assert (key = a / 7)
+    in
+    let if_not_found a b =
+      assert (a = x);
+      assert (b = x * 7)
+    in
+    require_no_allocation [%here] (fun () ->
+      for i = 0 to x do
+        Hashtbl.findi_and_call1 t i ~a:(i * 7) ~if_found ~if_not_found
+      done);
+    let if_found a b c =
+      assert (a = b);
+      assert (b = c / 2)
+    in
+    let if_not_found a b c =
+      assert (a = x);
+      assert (b = x * 7);
+      assert (c = x * 14)
+    in
+    require_no_allocation [%here] (fun () ->
+      for i = 0 to x do
+        Hashtbl.find_and_call2 t i ~a:(i * 7) ~b:(i * 14) ~if_found ~if_not_found
+      done);
+    let if_found ~key ~data:a b c =
+      assert (a = b);
+      assert (b = c / 2);
+      assert (key = a / 7)
+    in
+    let if_not_found a b c =
+      assert (a = x);
+      assert (b = x * 7);
+      assert (c = x * 14)
+    in
+    require_no_allocation [%here] (fun () ->
+      for i = 0 to x do
+        Hashtbl.findi_and_call2 t i ~a:(i * 7) ~b:(i * 14) ~if_found ~if_not_found
+      done);
+    print_s (Int.sexp_of_t x)
+  in
+  (* try various load factors, to exercise all branches of matching on the structure of
+     the avl tree *)
+  test 1;
+  test 3;
+  test 10;
+  test 17;
+  test 25;
+  test 29;
+  test 33;
+  test 3133;
+  [%expect {|
+    1
+    3
+    10
+    17
+    25
+    29
+    33
+    3_133
+    |}]
+;;
+
+let%expect_test ("find_or_add shouldn't allocate" [@tags "no-js"]) =
+  let default = Fn.const () in
+  let t = Hashtbl.create (module Int) ~size:16 ~growth_allowed:false in
+  Hashtbl.add_exn t ~key:100 ~data:();
+  require_no_allocation [%here] (fun () -> Hashtbl.find_or_add t 100 ~default);
+  [%expect {| |}]
+;;

unikernel/duniverse/base/test/allocation/test_hashtbl_allocation.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/allocation/test_list_allocation.ml

@@ -0,0 +1,22 @@
+open! Base
+open Expect_test_helpers_core
+
+let%expect_test "is_prefix does not allocate" =
+  let list = Sys.opaque_identity [ 1; 2; 3 ] in
+  let prefix = Sys.opaque_identity [ 1; 2 ] in
+  let equal = Int.equal in
+  let (_ : bool) =
+    require_no_allocation [%here] (fun () -> List.is_prefix list ~equal ~prefix)
+  in
+  [%expect {| |}]
+;;
+
+let%expect_test "is_suffix does not allocate" =
+  let list = Sys.opaque_identity [ 1; 2; 3 ] in
+  let suffix = Sys.opaque_identity [ 2; 3 ] in
+  let equal = Int.equal in
+  let (_ : bool) =
+    require_no_allocation [%here] (fun () -> List.is_suffix list ~equal ~suffix)
+  in
+  [%expect {| |}]
+;;

unikernel/duniverse/base/test/allocation/test_list_allocation.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/allocation/test_option_array_allocation.ml

@@ -0,0 +1,11 @@
+open! Async
+open Expect_test_helpers_async
+
+let%expect_test _ =
+  (* Sadly, the test is sensitive to cross-library inlining, which we can only detect
+     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 {| |}];
+  return ()
+;;

unikernel/duniverse/base/test/allocation/test_option_array_allocation.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/allocation/test_string_allocation.ml

@@ -0,0 +1,182 @@
+open! Base
+open Expect_test_helpers_core
+
+let%expect_test _ =
+  let x = Sys.opaque_identity "one string" in
+  let y = Sys.opaque_identity "another" in
+  require_no_allocation [%here] (fun () ->
+    ignore (Sys.opaque_identity (String.Caseless.equal x y) : bool));
+  [%expect {| |}]
+;;
+
+let%expect_test "empty substring" =
+  let string = String.init 10 ~f:Char.of_int_exn in
+  let test here f =
+    let substring = require_no_allocation here f in
+    assert (String.is_empty substring)
+  in
+  test [%here] (fun () -> String.sub string ~pos:0 ~len:0);
+  test [%here] (fun () -> String.prefix string 0);
+  test [%here] (fun () -> String.suffix string 0);
+  test [%here] (fun () -> String.drop_prefix string 10);
+  test [%here] (fun () -> String.drop_suffix string 10);
+  [%expect {| |}]
+;;
+
+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 {| |}]
+;;
+
+let%expect_test "fold does not allocate" =
+  let string = Sys.opaque_identity "abracadabra" in
+  let char = Sys.opaque_identity 'd' in
+  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 {| |}]
+;;
+
+let%expect_test "foldi does not allocate" =
+  let string = Sys.opaque_identity "abracadabra" in
+  let char = Sys.opaque_identity 'd' in
+  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 {| |}]
+;;
+
+let%test_module "common prefix and suffix" =
+  (module struct
+    let require_int_equal a b ~message = require_equal [%here] (module Int) a b ~message
+
+    let require_string_equal a b ~message =
+      require_equal [%here] (module String) a b ~message
+    ;;
+
+    let simulate_common_length ~get_common2_length list =
+      let rec loop acc prev list ~get_common2_length =
+        match list with
+        | [] -> acc
+        | head :: tail ->
+          loop (Int.min acc (get_common2_length prev head)) head tail ~get_common2_length
+      in
+      match list with
+      | [] -> 0
+      | [ head ] -> String.length head
+      | head :: tail -> loop Int.max_value head tail ~get_common2_length
+    ;;
+
+    let get_shortest_and_longest list =
+      let compare_by_length a b = Comparable.lift Int.compare ~f:String.length a b in
+      Option.both
+        (List.min_elt list ~compare:compare_by_length)
+        (List.max_elt list ~compare:compare_by_length)
+    ;;
+
+    let test_generic get_common get_common2 get_common_length get_common2_length =
+      Staged.stage (fun list ->
+        let common = get_common list in
+        print_s [%sexp (common : string)];
+        let len = get_common_length list in
+        require_int_equal len (String.length common) ~message:"wrong length";
+        let common2 = List.reduce list ~f:get_common2 |> Option.value ~default:"" in
+        require_string_equal common common2 ~message:"pairwise result mismatch";
+        let len2 = simulate_common_length ~get_common2_length list in
+        require_int_equal len len2 ~message:"pairwise length mismatch";
+        if not (String.is_empty common || List.mem list common ~equal:String.equal)
+        then print_endline "(may allocate)"
+        else (
+          ignore (require_no_allocation [%here] (fun () -> get_common list) : string);
+          Option.iter (get_shortest_and_longest list) ~f:(fun (shortest, longest) ->
+            ignore
+              (require_no_allocation [%here] (fun () -> get_common2 shortest longest)
+                : string);
+            ignore
+              (require_no_allocation [%here] (fun () -> get_common2 longest shortest)
+                : string))))
+    ;;
+
+    let test_prefix =
+      test_generic
+        String.common_prefix
+        String.common_prefix2
+        String.common_prefix_length
+        String.common_prefix2_length
+      |> Staged.unstage
+    ;;
+
+    let test_suffix =
+      test_generic
+        String.common_suffix
+        String.common_suffix2
+        String.common_suffix_length
+        String.common_suffix2_length
+      |> Staged.unstage
+    ;;
+
+    let%expect_test "empty" =
+      test_prefix [];
+      [%expect {| "" |}];
+      test_suffix [];
+      [%expect {| "" |}]
+    ;;
+
+    let%expect_test "singleton" =
+      test_prefix [ "abut" ];
+      [%expect {| abut |}];
+      test_suffix [ "tuba" ];
+      [%expect {| tuba |}]
+    ;;
+
+    let%expect_test "doubleton, alloc" =
+      test_prefix [ "hello"; "help"; "hex" ];
+      [%expect {|
+        he
+        (may allocate)
+        |}];
+      test_suffix [ "crest"; "zest"; "1st" ];
+      [%expect {|
+        st
+        (may allocate)
+        |}]
+    ;;
+
+    let%expect_test "doubleton, no alloc" =
+      test_prefix [ "hello"; "help"; "he" ];
+      [%expect {| he |}];
+      test_suffix [ "crest"; "zest"; "st" ];
+      [%expect {| st |}]
+    ;;
+
+    let%expect_test "many, alloc" =
+      test_prefix [ "this"; "that"; "the other"; "these"; "those"; "thy"; "thou" ];
+      [%expect {|
+        th
+        (may allocate)
+        |}];
+      test_suffix [ "fourth"; "fifth"; "sixth"; "seventh"; "eleventh"; "twelfth" ];
+      [%expect {|
+        th
+        (may allocate)
+        |}]
+    ;;
+
+    let%expect_test "many, no alloc" =
+      test_prefix [ "inconsequential"; "invariant"; "in"; "inner"; "increment" ];
+      [%expect {| in |}];
+      test_suffix [ "fat"; "cat"; "sat"; "at"; "bat" ];
+      [%expect {| at |}]
+    ;;
+
+    let%expect_test "many, nothing in common" =
+      let lorem_ipsum = [ "lorem"; "ipsum"; "dolor"; "sit"; "amet" ] in
+      test_prefix lorem_ipsum;
+      [%expect {| "" |}];
+      test_suffix lorem_ipsum;
+      [%expect {| "" |}]
+    ;;
+  end)
+;;

unikernel/duniverse/base/test/allocation/test_string_allocation.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/allocation/test_type_equal_allocation.ml

@@ -0,0 +1,9 @@
+open! Base
+open Expect_test_helpers_core
+
+let t1 = Type_equal.Id.create ~name:"t1" [%sexp_of: _]
+
+let%expect_test "Type_equal.Id.to_sexp allocation" =
+  require_no_allocation [%here] (fun () ->
+    ignore (Type_equal.Id.to_sexp t1 : 'a -> Sexp.t))
+;;

unikernel/duniverse/base/test/allocation/test_type_equal_allocation.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/allocation/test_zero_alloc.ml

@@ -0,0 +1,20 @@
+let[@zero_alloc] [@inline never] foo x = Base.Printf.failwithf "%d" x ()
+let[@zero_alloc] [@inline never] bar x y = Base.Printf.invalid_argf "%d" (x + y) ()
+
+let%expect_test "foo" =
+  let x = Sys.opaque_identity 5 in
+  (try foo x with
+   | Failure s ->
+     print_string s;
+     print_newline ());
+  [%expect {| 5 |}]
+;;
+
+let%expect_test "bar" =
+  let x = Sys.opaque_identity 5 in
+  (try bar x x with
+   | Invalid_argument s ->
+     print_string s;
+     print_newline ());
+  [%expect {| 10 |}]
+;;

unikernel/duniverse/base/test/allocation/test_zero_alloc.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/avltree_unit_tests.ml

@@ -0,0 +1,429 @@
+open! Import
+
+let%test_module _ =
+  (module (
+             struct
+               open Avltree
+
+               type ('k, 'v) t = ('k, 'v) Avltree.t = private
+                 | Empty
+                 | Node of
+                     { mutable left : ('k, 'v) t
+                     ; key : 'k
+                     ; mutable value : 'v
+                     ; mutable height : int
+                     ; mutable right : ('k, 'v) t
+                     }
+                 | Leaf of
+                     { key : 'k
+                     ; mutable value : 'v
+                     }
+
+               module For_quickcheck = struct
+                 module Key = struct
+                   include Int
+
+                   type t = int [@@deriving quickcheck]
+
+                   let quickcheck_generator =
+                     Base_quickcheck.Generator.small_positive_or_zero_int
+                   ;;
+                 end
+
+                 module Data = struct
+                   include String
+
+                   type t = string [@@deriving quickcheck]
+
+                   let quickcheck_generator =
+                     Base_quickcheck.Generator.string_of
+                       Base_quickcheck.Generator.char_lowercase
+                   ;;
+                 end
+
+                 let compare = Key.compare
+
+                 module Constructor = struct
+                   type t =
+                     | Add of Key.t * Data.t
+                     | Replace of Key.t * Data.t
+                     | Remove of Key.t
+                   [@@deriving quickcheck, sexp_of]
+
+                   let apply_to_tree t tree =
+                     match t with
+                     | Add (key, data) ->
+                       add tree ~key ~data ~compare ~added:(ref false) ~replace:false
+                     | Replace (key, data) ->
+                       add tree ~key ~data ~compare ~added:(ref false) ~replace:true
+                     | Remove key -> remove tree key ~compare ~removed:(ref false)
+                   ;;
+
+                   let apply_to_map t map =
+                     match t with
+                     | Add (key, data) ->
+                       if Map.mem map key then map else Map.set map ~key ~data
+                     | Replace (key, data) -> Map.set map ~key ~data
+                     | Remove key -> Map.remove map key
+                   ;;
+                 end
+
+                 module Constructors = struct
+                   type t = Constructor.t list [@@deriving quickcheck, sexp_of]
+                 end
+
+                 let reify constructors =
+                   List.fold
+                     constructors
+                     ~init:(empty, Map.empty (module Key))
+                     ~f:(fun (t, map) constructor ->
+                       ( Constructor.apply_to_tree constructor t
+                       , Constructor.apply_to_map constructor map ))
+                 ;;
+
+                 let merge map1 map2 =
+                   Map.merge map1 map2 ~f:(fun ~key variant ->
+                     match variant with
+                     | `Left data | `Right data -> Some data
+                     | `Both (data1, data2) ->
+                       Error.raise_s
+                         [%message
+                           "duplicate data for key"
+                             (key : Key.t)
+                             (data1 : Data.t)
+                             (data2 : Data.t)])
+                 ;;
+
+                 let rec to_map = function
+                   | Empty -> Map.empty (module Key)
+                   | Leaf { key; value = data } -> Map.singleton (module Key) key data
+                   | Node { left; key; value = data; height = _; right } ->
+                     merge
+                       (Map.singleton (module Key) key data)
+                       (merge (to_map left) (to_map right))
+                 ;;
+               end
+
+               open For_quickcheck
+
+               let empty = empty
+
+               let%test_unit _ =
+                 match empty with
+                 | Empty -> ()
+                 | _ -> assert false
+               ;;
+
+               let is_empty = is_empty
+               let%test _ = is_empty empty
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module Constructors)
+                   ~f:(fun constructors ->
+                     let t, map = reify constructors in
+                     [%test_result: bool] (is_empty t) ~expect:(Map.is_empty map))
+               ;;
+
+               let invariant = invariant
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module Constructors)
+                   ~f:(fun constructors ->
+                     let t, map = reify constructors in
+                     invariant t ~compare;
+                     [%test_result: Data.t Map.M(Key).t] (to_map t) ~expect:map)
+               ;;
+
+               let add = add
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructor.t list * Key.t * Data.t * bool
+                     [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key, data, replace) ->
+                     let t, map = reify constructors in
+                     (* test [added], other aspects of [add] are tested via [reify] in the
+              [invariant] test above *)
+                     let added = ref false in
+                     let (_ : (Key.t, Data.t) t) =
+                       add t ~key ~data ~compare ~added ~replace
+                     in
+                     [%test_result: bool] !added ~expect:(not (Map.mem map key)))
+               ;;
+
+               let remove = remove
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key) ->
+                     let t, map = reify constructors in
+                     (* test [removed], other aspects of [remove] are tested via [reify] in the
+              [invariant] test above *)
+                     let removed = ref false in
+                     let (_ : (Key.t, Data.t) t) = remove t key ~compare ~removed in
+                     [%test_result: bool] !removed ~expect:(Map.mem map key))
+               ;;
+
+               let find = find
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key) ->
+                     let t, map = reify constructors in
+                     [%test_result: Data.t option]
+                       (find t key ~compare)
+                       ~expect:(Map.find map key))
+               ;;
+
+               let mem = mem
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key) ->
+                     let t, map = reify constructors in
+                     [%test_result: bool] (mem t key ~compare) ~expect:(Map.mem map key))
+               ;;
+
+               let first = first
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module Constructors)
+                   ~f:(fun constructors ->
+                     let t, map = reify constructors in
+                     [%test_result: (Key.t * Data.t) option]
+                       (first t)
+                       ~expect:(Map.min_elt map))
+               ;;
+
+               let last = last
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module Constructors)
+                   ~f:(fun constructors ->
+                     let t, map = reify constructors in
+                     [%test_result: (Key.t * Data.t) option]
+                       (last t)
+                       ~expect:(Map.max_elt map))
+               ;;
+
+               let find_and_call = find_and_call
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key) ->
+                     let t, map = reify constructors in
+                     [%test_result: [ `Found of Data.t | `Not_found of Key.t ]]
+                       (find_and_call
+                          t
+                          key
+                          ~compare
+                          ~if_found:(fun data -> `Found data)
+                          ~if_not_found:(fun key -> `Not_found key))
+                       ~expect:
+                         (match Map.find map key with
+                          | None -> `Not_found key
+                          | Some data -> `Found data))
+               ;;
+
+               let findi_and_call = findi_and_call
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key) ->
+                     let t, map = reify constructors in
+                     [%test_result: [ `Found of Key.t * Data.t | `Not_found of Key.t ]]
+                       (findi_and_call
+                          t
+                          key
+                          ~compare
+                          ~if_found:(fun ~key ~data -> `Found (key, data))
+                          ~if_not_found:(fun key -> `Not_found key))
+                       ~expect:
+                         (match Map.find map key with
+                          | None -> `Not_found key
+                          | Some data -> `Found (key, data)))
+               ;;
+
+               let find_and_call1 = find_and_call1
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructors.t * Key.t * int
+                     [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key, a) ->
+                     let t, map = reify constructors in
+                     [%test_result:
+                       [ `Found of Data.t * int | `Not_found of Key.t * int ]]
+                       (find_and_call1
+                          t
+                          key
+                          ~compare
+                          ~a
+                          ~if_found:(fun data a -> `Found (data, a))
+                          ~if_not_found:(fun key a -> `Not_found (key, a)))
+                       ~expect:
+                         (match Map.find map key with
+                          | None -> `Not_found (key, a)
+                          | Some data -> `Found (data, a)))
+               ;;
+
+               let findi_and_call1 = findi_and_call1
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructors.t * Key.t * int
+                     [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key, a) ->
+                     let t, map = reify constructors in
+                     [%test_result:
+                       [ `Found of Key.t * Data.t * int | `Not_found of Key.t * int ]]
+                       (findi_and_call1
+                          t
+                          key
+                          ~compare
+                          ~a
+                          ~if_found:(fun ~key ~data a -> `Found (key, data, a))
+                          ~if_not_found:(fun key a -> `Not_found (key, a)))
+                       ~expect:
+                         (match Map.find map key with
+                          | None -> `Not_found (key, a)
+                          | Some data -> `Found (key, data, a)))
+               ;;
+
+               let find_and_call2 = find_and_call2
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructors.t * Key.t * int * string
+                     [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key, a, b) ->
+                     let t, map = reify constructors in
+                     [%test_result:
+                       [ `Found of Data.t * int * string
+                       | `Not_found of Key.t * int * string
+                       ]]
+                       (find_and_call2
+                          t
+                          key
+                          ~compare
+                          ~a
+                          ~b
+                          ~if_found:(fun data a b -> `Found (data, a, b))
+                          ~if_not_found:(fun key a b -> `Not_found (key, a, b)))
+                       ~expect:
+                         (match Map.find map key with
+                          | None -> `Not_found (key, a, b)
+                          | Some data -> `Found (data, a, b)))
+               ;;
+
+               let findi_and_call2 = findi_and_call2
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module struct
+                     type t = Constructors.t * Key.t * int * string
+                     [@@deriving quickcheck, sexp_of]
+                   end)
+                   ~f:(fun (constructors, key, a, b) ->
+                     let t, map = reify constructors in
+                     [%test_result:
+                       [ `Found of Key.t * Data.t * int * string
+                       | `Not_found of Key.t * int * string
+                       ]]
+                       (findi_and_call2
+                          t
+                          key
+                          ~compare
+                          ~a
+                          ~b
+                          ~if_found:(fun ~key ~data a b -> `Found (key, data, a, b))
+                          ~if_not_found:(fun key a b -> `Not_found (key, a, b)))
+                       ~expect:
+                         (match Map.find map key with
+                          | None -> `Not_found (key, a, b)
+                          | Some data -> `Found (key, data, a, b)))
+               ;;
+
+               let iter = iter
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module Constructors)
+                   ~f:(fun constructors ->
+                     let t, map = reify constructors in
+                     [%test_result: (Key.t * Data.t) list]
+                       (let q = Queue.create () in
+                        iter t ~f:(fun ~key ~data -> Queue.enqueue q (key, data));
+                        Queue.to_list q)
+                       ~expect:(Map.to_alist map))
+               ;;
+
+               let mapi_inplace = mapi_inplace
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module Constructors)
+                   ~f:(fun constructors ->
+                     let t, map = reify constructors in
+                     [%test_result: (Key.t * Data.t) list]
+                       (mapi_inplace t ~f:(fun ~key:_ ~data -> data ^ data);
+                        fold t ~init:[] ~f:(fun ~key ~data acc -> (key, data) :: acc))
+                       ~expect:
+                         (Map.map map ~f:(fun data -> data ^ data)
+                          |> Map.to_alist
+                          |> List.rev))
+               ;;
+
+               let fold = fold
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module Constructors)
+                   ~f:(fun constructors ->
+                     let t, map = reify constructors in
+                     [%test_result: (Key.t * Data.t) list]
+                       (fold t ~init:[] ~f:(fun ~key ~data acc -> (key, data) :: acc))
+                       ~expect:(Map.to_alist map |> List.rev))
+               ;;
+
+               let choose_exn = choose_exn
+
+               let%test_unit _ =
+                 Base_quickcheck.Test.run_exn
+                   (module Constructors)
+                   ~f:(fun constructors ->
+                     let t, map = reify constructors in
+                     [%test_result: bool]
+                       (is_some (Option.try_with (fun () -> choose_exn t)))
+                       ~expect:(not (Map.is_empty map)))
+               ;;
+             end :
+               module type of Avltree))
+;;

unikernel/duniverse/base/test/avltree_unit_tests.mli

@@ -0,0 +1 @@
+(* intentionally blank *)

unikernel/duniverse/base/test/base_test.ml

@@ -0,0 +1 @@
+(*_ This library deliberately does not export anything. *)

unikernel/duniverse/base/test/dune

@@ -0,0 +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_validation num stdio)
+ (preprocess
+  (pps ppx_jane -dont-apply=pipebang -no-check-on-extensions)))

unikernel/duniverse/base/test/hashtbl_tests.ml

@@ -0,0 +1,373 @@
+open! Base
+
+module type Hashtbl_for_testing = sig
+  include Hashtbl.Accessors with type 'key key = 'key
+  include Invariant.S2 with type ('key, 'data) t := ('key, 'data) t
+
+  (* we don't define [module Poly : Hashtbl.S_poly] because we want to require only
+     the minimal number of constructors necessary to implement the tests, and also avoid
+     conflicting with any existing names. *)
+
+  val create_poly : ?size:int -> unit -> ('key, 'data) t
+  val of_alist_poly_exn : ('key * 'data) list -> ('key, 'data) t
+  val of_alist_poly_or_error : ('key * 'data) list -> ('key, 'data) t Or_error.t
+end
+
+module Make (Hashtbl : Hashtbl_for_testing) = struct
+  open Poly
+
+  let test_data = [ "a", 1; "b", 2; "c", 3 ]
+
+  let test_hash =
+    let h = Hashtbl.create_poly () ~size:10 in
+    List.iter test_data ~f:(fun (k, v) -> Hashtbl.set h ~key:k ~data:v);
+    h
+  ;;
+
+  (* This is a very strong notion of equality on hash tables *)
+  let equal t t' equal_data =
+    let subtable t t' =
+      try
+        List.for_all (Hashtbl.keys t) ~f:(fun key ->
+          equal_data (Hashtbl.find_exn t key) (Hashtbl.find_exn t' key))
+      with
+      | Invalid_argument _ -> false
+    in
+    subtable t t' && subtable t' t
+  ;;
+
+  let%test "find" =
+    let found = Hashtbl.find test_hash "a" in
+    let not_found = Hashtbl.find test_hash "A" in
+    Hashtbl.invariant ignore ignore test_hash;
+    match found, not_found with
+    | Some _, None -> true
+    | _ -> false
+  ;;
+
+  (* In js_of_ocaml, strings can be hashconst-ed. *)
+  let%test ("findi_and_call" [@tags "no-js"]) =
+    let our_hash = Hashtbl.copy test_hash in
+    let test_string = "test string" in
+    Hashtbl.add_exn our_hash ~key:test_string ~data:10;
+    let test_string' = "test " ^ "string" in
+    assert (not (phys_equal test_string test_string'));
+    Hashtbl.findi_and_call
+      our_hash
+      test_string'
+      ~if_found:(fun ~key ~data -> phys_equal test_string key && data = 10)
+      ~if_not_found:(fun _ -> false)
+  ;;
+
+  let%test_unit "add" =
+    let our_hash = Hashtbl.copy test_hash in
+    let duplicate = Hashtbl.add our_hash ~key:"a" ~data:4 in
+    let no_duplicate = Hashtbl.add our_hash ~key:"d" ~data:5 in
+    assert (Hashtbl.find our_hash "a" = Some 1);
+    assert (Hashtbl.find our_hash "d" = Some 5);
+    Hashtbl.invariant ignore ignore our_hash;
+    assert (
+      match duplicate, no_duplicate with
+      | `Duplicate, `Ok -> true
+      | _ -> false)
+  ;;
+
+  let%test "iter" =
+    let predicted =
+      List.sort ~compare:Int.descending (List.map test_data ~f:(fun (_, v) -> v))
+    in
+    let found =
+      let found = ref [] in
+      Hashtbl.iter test_hash ~f:(fun v -> found := v :: !found);
+      !found |> List.sort ~compare:Int.descending
+    in
+    List.equal Int.equal predicted found
+  ;;
+
+  let%test "iter_keys" =
+    let predicted =
+      List.sort ~compare:String.descending (List.map test_data ~f:(fun (k, _) -> k))
+    in
+    let found =
+      let found = ref [] in
+      Hashtbl.iter_keys test_hash ~f:(fun k -> found := k :: !found);
+      !found |> List.sort ~compare:String.descending
+    in
+    List.equal String.equal predicted found
+  ;;
+
+  let%test_module "of_alist" =
+    (module struct
+      let%test "size" =
+        let predicted = List.length test_data in
+        let found = Hashtbl.length (Hashtbl.of_alist_poly_exn test_data) in
+        predicted = found
+      ;;
+
+      let%test "right keys" =
+        let predicted = List.map test_data ~f:(fun (k, _) -> k) in
+        let found = Hashtbl.keys (Hashtbl.of_alist_poly_exn test_data) in
+        let sp = List.sort ~compare:Poly.ascending predicted in
+        let sf = List.sort ~compare:Poly.ascending found in
+        sp = sf
+      ;;
+    end)
+  ;;
+
+  let%test_module "of_alist_or_error" =
+    (module struct
+      let%test "unique" = Result.is_ok (Hashtbl.of_alist_poly_or_error test_data)
+
+      let%test "duplicate" =
+        Result.is_error (Hashtbl.of_alist_poly_or_error (test_data @ test_data))
+      ;;
+    end)
+  ;;
+
+  let%test "size and right keys" =
+    let predicted = List.map test_data ~f:(fun (k, _) -> k) in
+    let found = Hashtbl.keys test_hash in
+    let sp = List.sort ~compare:Poly.ascending predicted in
+    let sf = List.sort ~compare:Poly.ascending found in
+    sp = sf
+  ;;
+
+  let%test "size and right data" =
+    let predicted = List.map test_data ~f:(fun (_, v) -> v) in
+    let found = Hashtbl.data test_hash in
+    let sp = List.sort ~compare:Poly.ascending predicted in
+    let sf = List.sort ~compare:Poly.ascending found in
+    sp = sf
+  ;;
+
+  let%test "map" =
+    let add1 x = x + 1 in
+    let predicted_data =
+      List.sort ~compare:Poly.ascending (List.map test_data ~f:(fun (k, v) -> k, add1 v))
+    in
+    let found_alist =
+      Hashtbl.map test_hash ~f:add1
+      |> Hashtbl.to_alist
+      |> List.sort ~compare:Poly.ascending
+    in
+    List.equal Poly.equal predicted_data found_alist
+  ;;
+
+  let%test_unit "filter_map" =
+    let f x = Some x in
+    let result = Hashtbl.filter_map test_hash ~f in
+    assert (equal test_hash result Int.( = ));
+    let is_even x = x % 2 = 0 in
+    let add1_to_even x = if is_even x then Some (x + 1) else None in
+    let predicted_data =
+      List.filter_map test_data ~f:(fun (k, v) ->
+        if is_even v then Some (k, v + 1) else None)
+    in
+    let found = Hashtbl.filter_map test_hash ~f:add1_to_even in
+    let found_alist = List.sort ~compare:Poly.ascending (Hashtbl.to_alist found) in
+    assert (List.equal Poly.equal predicted_data found_alist)
+  ;;
+
+  let%test "filter_inplace" =
+    let f x = x <> 2 in
+    let predicted_data =
+      List.sort ~compare:Poly.ascending (List.filter test_data ~f:(fun (_, v) -> f v))
+    in
+    let test_hash = Hashtbl.copy test_hash in
+    Hashtbl.filter_inplace test_hash ~f;
+    let found_alist = Hashtbl.to_alist test_hash |> List.sort ~compare:Poly.ascending in
+    List.equal Poly.equal predicted_data found_alist
+  ;;
+
+  let%test "filter_keys_inplace" =
+    let f x = x = "c" in
+    let predicted_data =
+      List.sort ~compare:Poly.ascending (List.filter test_data ~f:(fun (k, _) -> f k))
+    in
+    let test_hash = Hashtbl.copy test_hash in
+    Hashtbl.filter_keys_inplace test_hash ~f;
+    let found_alist = Hashtbl.to_alist test_hash |> List.sort ~compare:Poly.ascending in
+    List.equal Poly.equal predicted_data found_alist
+  ;;
+
+  let%test "filter_map_inplace" =
+    let f x = if x = 1 then None else Some (x * 2) in
+    let predicted_data =
+      List.sort
+        ~compare:Poly.ascending
+        (List.filter_map test_data ~f:(fun (k, v) -> Option.map (f v) ~f:(fun x -> k, x)))
+    in
+    let test_hash = Hashtbl.copy test_hash in
+    Hashtbl.filter_map_inplace test_hash ~f;
+    let found_alist = Hashtbl.to_alist test_hash |> List.sort ~compare:Poly.ascending in
+    List.equal Poly.equal predicted_data found_alist
+  ;;
+
+  let%test "map_inplace" =
+    let f x = x + 3 in
+    let predicted_data =
+      List.sort ~compare:Poly.ascending (List.map test_data ~f:(fun (k, v) -> k, f v))
+    in
+    let test_hash = Hashtbl.copy test_hash in
+    Hashtbl.map_inplace test_hash ~f;
+    let found_alist = Hashtbl.to_alist test_hash |> List.sort ~compare:Poly.ascending in
+    List.equal Poly.equal predicted_data found_alist
+  ;;
+
+  let%test_unit "insert-find-remove" =
+    let t = Hashtbl.create_poly () ~size:1 in
+    let inserted = ref [] in
+    Random.init 123;
+    let verify_inserted t =
+      let missing =
+        List.fold !inserted ~init:[] ~f:(fun acc (key, data) ->
+          match Hashtbl.find t key with
+          | None -> `Missing key :: acc
+          | Some d -> if data = d then acc else `Wrong_data (key, data) :: acc)
+      in
+      match missing with
+      | [] -> ()
+      | _ ->
+        raise_s
+          [%message
+            "some inserts are missing"
+              (missing : [ `Missing of int | `Wrong_data of int * int ] list)]
+    in
+    let equal = Int.equal in
+    let rec loop i t =
+      if i < 2000
+      then (
+        let k = Random.int 10_000 in
+        inserted := List.Assoc.add (List.Assoc.remove !inserted ~equal k) ~equal k i;
+        Hashtbl.set t ~key:k ~data:i;
+        Hashtbl.invariant ignore ignore t;
+        verify_inserted t;
+        loop (i + 1) t)
+    in
+    loop 0 t;
+    List.iter !inserted ~f:(fun (x, _) ->
+      Hashtbl.remove t x;
+      Hashtbl.invariant ignore ignore t;
+      (match Hashtbl.find t x with
+       | None -> ()
+       | Some _ -> failwith (Printf.sprintf "present after removal: %d" x));
+      inserted := List.Assoc.remove !inserted ~equal x;
+      verify_inserted t)
+  ;;
+
+  let%test_unit "clear" =
+    let t = Hashtbl.create_poly () ~size:1 in
+    let l = List.range 0 100 in
+    let verify_present l = List.for_all l ~f:(Hashtbl.mem t) in
+    let verify_not_present l = List.for_all l ~f:(fun i -> not (Hashtbl.mem t i)) in
+    List.iter l ~f:(fun i -> Hashtbl.set t ~key:i ~data:(i * i));
+    List.iter l ~f:(fun i -> Hashtbl.set t ~key:i ~data:(i * i));
+    assert (Hashtbl.length t = 100);
+    assert (verify_present l);
+    Hashtbl.clear t;
+    Hashtbl.invariant ignore ignore t;
+    assert (Hashtbl.length t = 0);
+    assert (verify_not_present l);
+    let l = List.take l 42 in
+    List.iter l ~f:(fun i -> Hashtbl.set t ~key:i ~data:(i * i));
+    assert (Hashtbl.length t = 42);
+    assert (verify_present l);
+    Hashtbl.invariant ignore ignore t
+  ;;
+
+  let%test_unit "mem" =
+    let t = Hashtbl.create_poly () ~size:1 in
+    Hashtbl.invariant ignore ignore t;
+    assert (not (Hashtbl.mem t "Fred"));
+    Hashtbl.invariant ignore ignore t;
+    Hashtbl.set t ~key:"Fred" ~data:"Wilma";
+    Hashtbl.invariant ignore ignore t;
+    assert (Hashtbl.mem t "Fred");
+    Hashtbl.invariant ignore ignore t;
+    Hashtbl.remove t "Fred";
+    Hashtbl.invariant ignore ignore t;
+    assert (not (Hashtbl.mem t "Fred"));
+    Hashtbl.invariant ignore ignore t
+  ;;
+
+  let%test_unit "exists" =
+    let t = Hashtbl.create_poly () in
+    assert (not (Hashtbl.exists t ~f:(fun _ -> failwith "can't be called")));
+    assert (not (Hashtbl.existsi t ~f:(fun ~key:_ ~data:_ -> failwith "can't be called")));
+    Hashtbl.set t ~key:7 ~data:3;
+    assert (not (Hashtbl.exists t ~f:(Int.equal 4)));
+    Hashtbl.set t ~key:8 ~data:4;
+    assert (Hashtbl.exists t ~f:(Int.equal 4));
+    Hashtbl.set t ~key:9 ~data:5;
+    assert (Hashtbl.existsi t ~f:(fun ~key ~data -> key + data = 14))
+  ;;
+
+  let%test_unit "for_all" =
+    let t = Hashtbl.create_poly () in
+    assert (Hashtbl.for_all t ~f:(fun _ -> failwith "can't be called"));
+    assert (Hashtbl.for_alli t ~f:(fun ~key:_ ~data:_ -> failwith "can't be called"));
+    Hashtbl.set t ~key:7 ~data:3;
+    assert (Hashtbl.for_all t ~f:(fun x -> Int.equal x 3));
+    Hashtbl.set t ~key:8 ~data:4;
+    assert (not (Hashtbl.for_all t ~f:(fun x -> Int.equal x 3)));
+    Hashtbl.set t ~key:9 ~data:5;
+    assert (Hashtbl.for_alli t ~f:(fun ~key ~data -> key - 4 = data))
+  ;;
+
+  let%test_unit "count" =
+    let t = Hashtbl.create_poly () in
+    assert (Hashtbl.count t ~f:(fun _ -> failwith "can't be called") = 0);
+    assert (Hashtbl.counti t ~f:(fun ~key:_ ~data:_ -> failwith "can't be called") = 0);
+    Hashtbl.set t ~key:7 ~data:3;
+    assert (Hashtbl.count t ~f:(fun x -> Int.equal x 3) = 1);
+    Hashtbl.set t ~key:8 ~data:4;
+    assert (Hashtbl.count t ~f:(fun x -> Int.equal x 3) = 1);
+    Hashtbl.set t ~key:9 ~data:5;
+    assert (Hashtbl.counti t ~f:(fun ~key ~data -> key - 4 = data) = 3)
+  ;;
+
+  let%test_unit "merge" =
+    let make alist = Hashtbl.of_alist_poly_exn alist in
+    let t1 = make [ 1, 111; 2, 222; 3, 333 ] in
+    let t2 = make [ 1, 123; 2, 222; 4, 444 ] in
+    [%test_result: (int * [ `Left of int | `Right of int | `Both of int * int ]) List.t]
+      (Hashtbl.merge t1 t2 ~f:(fun ~key:_ -> function
+         | `Left x -> Some (`Left x)
+         | `Right y -> Some (`Right y)
+         | `Both (x, y) -> if x = y then None else Some (`Both (x, y)))
+       |> Hashtbl.to_alist
+       |> List.sort ~compare:(fun (x, _) (y, _) -> Int.compare x y))
+      ~expect:[ 1, `Both (111, 123); 3, `Left 333; 4, `Right 444 ]
+  ;;
+end
+
+(* typechecking this code is a compile-time test that [Creators] is a specialization of
+   [Creators_generic].  *)
+module _ : sig end = struct
+  module Make_creators_check
+    (Type : T.T2)
+    (Key : T.T1)
+    (Options : T.T3)
+    (_ : Hashtbl.Private.Creators_generic
+           with type ('a, 'b) t := ('a, 'b) Type.t
+           with type 'a key := 'a Key.t
+           with type ('a, 'b, 'z) create_options := ('a, 'b, 'z) Options.t) =
+  struct end
+
+  module _ (M : Hashtbl.Creators) =
+    Make_creators_check
+      (struct
+        type ('a, 'b) t = ('a, 'b) M.t
+      end)
+      (struct
+        type 'a t = 'a
+      end)
+      (struct
+        type ('a, 'b, 'z) t = ('a, 'b, 'z) Hashtbl.create_options
+      end)
+      (struct
+        include M
+
+        let create ?growth_allowed ?size m () = create ?growth_allowed ?size m
+      end)
+end

unikernel/duniverse/base/test/hashtbl_tests.mli

@@ -0,0 +1,12 @@
+open! Base
+
+module type Hashtbl_for_testing = sig
+  include Hashtbl.Accessors with type 'key key = 'key
+  include Invariant.S2 with type ('key, 'data) t := ('key, 'data) t
+
+  val create_poly : ?size:int -> unit -> ('key, 'data) t
+  val of_alist_poly_exn : ('key * 'data) list -> ('key, 'data) t
+  val of_alist_poly_or_error : ('key * 'data) list -> ('key, 'data) t Or_error.t
+end
+
+module Make (Hashtbl : Hashtbl_for_testing) : sig end

unikernel/duniverse/base/test/helpers/dune

@@ -0,0 +1,5 @@
+(library
+ (name base_test_helpers)
+ (libraries base)
+ (preprocess
+  (pps ppx_jane)))

unikernel/duniverse/base/test/helpers/test_container.ml

@@ -0,0 +1,210 @@
+open! Base
+open! Container
+
+module Test_generic (Elt : sig
+  type 'a t
+
+  val of_int : int -> int t
+  val to_int : int t -> int
+end) (Container : sig
+  type 'a t [@@deriving sexp]
+
+  include Generic with type ('a, _, _) t := 'a t with type 'a elt := 'a Elt.t
+
+  val mem : 'a t -> 'a Elt.t -> equal:('a Elt.t -> 'a Elt.t -> bool) -> bool
+  val of_list : 'a Elt.t list -> [ `Ok of 'a t | `Skip_test ]
+end) : sig
+  type 'a t [@@deriving sexp]
+
+  include Generic with type ('a, _, _) t := 'a t
+
+  val mem : 'a t -> 'a Elt.t -> equal:('a Elt.t -> 'a Elt.t -> bool) -> bool
+end
+with type 'a t := 'a Container.t
+with type 'a elt := 'a Elt.t =
+(* This signature constraint reminds us to add unit tests when functions are added to
+   [Generic]. *)
+struct
+  open Container
+
+  let find = find
+  let find_map = find_map
+  let fold = fold
+  let is_empty = is_empty
+  let iter = iter
+  let length = length
+  let mem = mem
+  let sexp_of_t = sexp_of_t
+  let t_of_sexp = t_of_sexp
+  let to_array = to_array
+  let to_list = to_list
+  let fold_result = fold_result
+  let fold_until = fold_until
+
+  let%test_unit _ =
+    let ( = ) = Poly.equal in
+    let compare = Poly.compare in
+    List.iter [ 0; 1; 2; 3; 4; 8; 128 ] ~f:(fun n ->
+      let list = List.init n ~f:Elt.of_int in
+      match Container.of_list list with
+      | `Skip_test -> ()
+      | `Ok c ->
+        let sort l = List.sort l ~compare in
+        let sorts_are_equal l1 l2 = sort l1 = sort l2 in
+        assert (n = Container.length c);
+        assert (n = 0 = Container.is_empty c);
+        assert (sorts_are_equal list (Container.fold c ~init:[] ~f:(fun ac e -> e :: ac)));
+        assert (sorts_are_equal list (Container.to_list c));
+        assert (sorts_are_equal list (Array.to_list (Container.to_array c)));
+        assert (n > 0 = Option.is_some (Container.find c ~f:(fun e -> Elt.to_int e = 0)));
+        assert (
+          n > 0 = Option.is_some (Container.find c ~f:(fun e -> Elt.to_int e = n - 1)));
+        assert (Option.is_none (Container.find c ~f:(fun e -> Elt.to_int e = n)));
+        assert (n > 0 = Container.mem c (Elt.of_int 0) ~equal:( = ));
+        if n > 0 then assert (Container.mem c (Elt.of_int (n - 1)) ~equal:( = ));
+        assert (not (Container.mem c (Elt.of_int n) ~equal:( = )));
+        assert (
+          n
+          > 0
+          = Option.is_some
+              (Container.find_map c ~f:(fun e ->
+                 if Elt.to_int e = 0 then Some () else None)));
+        assert (
+          n
+          > 0
+          = Option.is_some
+              (Container.find_map c ~f:(fun e ->
+                 if Elt.to_int e = n - 1 then Some () else None)));
+        assert (
+          Option.is_none
+            (Container.find_map c ~f:(fun e -> if Elt.to_int e = n then Some () else None)));
+        let r = ref 0 in
+        Container.iter c ~f:(fun e -> r := !r + Elt.to_int e);
+        assert (!r = List.fold list ~init:0 ~f:(fun n e -> n + Elt.to_int e));
+        assert (!r = sum (module Int) c ~f:Elt.to_int);
+        let c2 = [%of_sexp: int Container.t] ([%sexp_of: int Container.t] c) in
+        assert (sorts_are_equal list (Container.to_list c2));
+        let compare_elt a b = Int.compare (Elt.to_int a) (Elt.to_int b) in
+        if n = 0
+        then (
+          assert (!r = 0);
+          assert (min_elt ~compare:compare_elt c = None);
+          assert (max_elt ~compare:compare_elt c = None))
+        else (
+          assert (!r = n * (n - 1) / 2);
+          assert (Option.map ~f:Elt.to_int (min_elt ~compare:compare_elt c) = Some 0);
+          assert (
+            Option.map ~f:Elt.to_int (max_elt ~compare:compare_elt c) = Some (Int.pred n)));
+        let mid = Container.length c / 2 in
+        (match
+           Container.fold_result c ~init:0 ~f:(fun count _elt ->
+             if count = mid then Error count else Ok (count + 1))
+         with
+         | Ok 0 -> assert (Container.length c = 0)
+         | Ok _ -> failwith "Expected fold to stop early"
+         | Error x -> assert (mid = x)))
+  ;;
+
+  let min_elt = min_elt
+  let max_elt = max_elt
+  let count = count
+  let sum = sum
+  let exists = exists
+  let for_all = for_all
+
+  let%test_unit _ =
+    List.iter
+      [ []
+      ; [ true ]
+      ; [ false ]
+      ; [ false; false ]
+      ; [ true; false ]
+      ; [ false; true ]
+      ; [ true; true ]
+      ]
+      ~f:(fun bools ->
+        let count_should_be =
+          List.fold bools ~init:0 ~f:(fun n b -> if b then n + 1 else n)
+        in
+        let forall_should_be = List.fold bools ~init:true ~f:(fun ac b -> b && ac) in
+        let exists_should_be = List.fold bools ~init:false ~f:(fun ac b -> b || ac) in
+        match
+          Container.of_list (List.map bools ~f:(fun b -> Elt.of_int (if b then 1 else 0)))
+        with
+        | `Skip_test -> ()
+        | `Ok container ->
+          let is_one e = Elt.to_int e = 1 in
+          let ( = ) = Poly.equal in
+          assert (forall_should_be = Container.for_all container ~f:is_one);
+          assert (exists_should_be = Container.exists container ~f:is_one);
+          assert (count_should_be = Container.count container ~f:is_one))
+  ;;
+end
+
+module Test_S1_allow_skipping_tests (Container : sig
+  type 'a t [@@deriving sexp]
+
+  include Container.S1 with type 'a t := 'a t
+
+  val of_list : 'a list -> [ `Ok of 'a t | `Skip_test ]
+end) =
+struct
+  include
+    Test_generic
+      (struct
+        type 'a t = 'a
+
+        let of_int = Fn.id
+        let to_int = Fn.id
+      end)
+      (Container)
+end
+
+module Test_S1 (Container : sig
+  type 'a t [@@deriving sexp]
+
+  include Container.S1 with type 'a t := 'a t
+
+  val of_list : 'a list -> 'a t
+end) =
+Test_S1_allow_skipping_tests (struct
+  include Container
+
+  let of_list l = `Ok (of_list l)
+end)
+
+module Test_S0 (Container : sig
+  module Elt : sig
+    type t [@@deriving sexp]
+
+    val of_int : int -> t
+    val to_int : t -> int
+  end
+
+  type t [@@deriving sexp]
+
+  include Container.S0 with type t := t and type elt := Elt.t
+
+  val of_list : Elt.t list -> t
+end) =
+struct
+  include
+    Test_generic
+      (struct
+        include Container.Elt
+
+        type 'a t = Container.Elt.t
+      end)
+      (struct
+        include Container
+
+        type 'a t = Container.t [@@deriving sexp]
+
+        let of_list l = `Ok (of_list l)
+        let mem t x ~equal:_ = Container.mem t x
+      end)
+
+  (* [mem] in the second functor argument above ignores its [~equal], so this [~equal]
+     should never be called. *)
+  let mem t x = mem t x ~equal:(fun _ _ -> assert false)
+end

unikernel/duniverse/base/test/helpers/test_container.mli

@@ -0,0 +1,57 @@
+open! Base
+open! Container
+
+module Test_S1_allow_skipping_tests (Container : sig
+  type 'a t [@@deriving sexp]
+
+  include Container.S1 with type 'a t := 'a t
+
+  val of_list : 'a list -> [ `Ok of 'a t | `Skip_test ]
+end) : sig
+  type 'a t [@@deriving sexp]
+
+  include Generic with type ('a, _, _) t := 'a t
+
+  val mem : 'a t -> 'a -> equal:('a -> 'a -> bool) -> bool
+end
+with type 'a t := 'a Container.t
+with type 'a elt := 'a
+
+module Test_S1 (Container : sig
+  type 'a t [@@deriving sexp]
+
+  include Container.S1 with type 'a t := 'a t
+
+  val of_list : 'a list -> 'a t
+end) : sig
+  type 'a t [@@deriving sexp]
+
+  include Generic with type ('a, _, _) t := 'a t
+
+  val mem : 'a t -> 'a -> equal:('a -> 'a -> bool) -> bool
+end
+with type 'a t := 'a Container.t
+with type 'a elt := 'a
+
+module Test_S0 (Container : sig
+  module Elt : sig
+    type t [@@deriving sexp]
+
+    val of_int : int -> t
+    val to_int : t -> int
+  end
+
+  type t [@@deriving sexp]
+
+  include Container.S0 with type t := t and type elt := Elt.t
+
+  val of_list : Elt.t list -> t
+end) : sig
+  type 'a t [@@deriving sexp]
+
+  include Generic with type ('a, _, _) t := 'a t
+
+  val mem : 'a t -> 'a elt -> bool
+end
+with type 'a t := Container.t
+with type 'a elt := Container.Elt.t

unikernel/duniverse/base/test/helpers/test_stack.ml

@@ -0,0 +1,296 @@
+open! Base
+open! Stack
+
+module Debug (Stack : S) : S with type 'a t = 'a Stack.t = struct
+  open Stack
+
+  type nonrec 'a t = 'a t
+
+  let invariant = invariant
+  let t_sexp_grammar = t_sexp_grammar
+
+  let check_and_return t =
+    invariant ignore t;
+    t
+  ;;
+
+  let debug t f =
+    let result = Result.try_with f in
+    invariant ignore t;
+    Result.ok_exn result
+  ;;
+
+  (* The return-type annotations are to prevent an error where we don't supply all the
+     arguments to the function, and thus wouldn't be checking the invariant after fully
+     applying the function. *)
+  let clear t : unit = debug t (fun () -> clear t)
+  let copy t : _ t = check_and_return (debug t (fun () -> copy t))
+  let count t ~f : int = debug t (fun () -> count t ~f) [@nontail]
+  let sum m t ~f = debug t (fun () -> sum m t ~f) [@nontail]
+  let create () : _ t = check_and_return (create ())
+  let exists t ~f : bool = debug t (fun () -> exists t ~f) [@nontail]
+  let find t ~f : _ option = debug t (fun () -> find t ~f) [@nontail]
+  let find_map t ~f : _ option = debug t (fun () -> find_map t ~f) [@nontail]
+  let fold (type a) t ~init ~f : a = debug t (fun () -> fold t ~init ~f) [@nontail]
+  let for_all t ~f : bool = debug t (fun () -> for_all t ~f) [@nontail]
+  let is_empty t : bool = debug t (fun () -> is_empty t)
+  let iter t ~f : unit = debug t (fun () -> iter t ~f) [@nontail]
+  let length t : int = debug t (fun () -> length t)
+  let mem t a ~equal : bool = debug t (fun () -> mem t a ~equal) [@nontail]
+  let of_list l : _ t = check_and_return (of_list l)
+  let pop t : _ option = debug t (fun () -> pop t)
+  let pop_exn (type a) t : a = debug t (fun () -> pop_exn t)
+  let push t a : unit = debug t (fun () -> push t a)
+  let sexp_of_t sexp_of_a t : Sexp.t = debug t (fun () -> [%sexp_of: a t] t)
+  let singleton x : _ t = check_and_return (singleton x)
+  let t_of_sexp a_of_sexp sexp : _ t = check_and_return ([%of_sexp: a t] sexp)
+  let to_array t : _ array = debug t (fun () -> to_array t)
+  let to_list t : _ list = debug t (fun () -> to_list t)
+  let top t : _ option = debug t (fun () -> top t)
+  let top_exn (type a) t : a = debug t (fun () -> top_exn t)
+  let until_empty t f : unit = debug t (fun () -> until_empty t f) [@nontail]
+  let min_elt t ~compare : _ option = debug t (fun () -> min_elt t ~compare) [@nontail]
+  let max_elt t ~compare : _ option = debug t (fun () -> max_elt t ~compare) [@nontail]
+  let fold_result t ~init ~f = debug t (fun () -> fold_result t ~init ~f) [@nontail]
+
+  let fold_until t ~init ~f ~finish =
+    debug t (fun () -> fold_until t ~init ~f ~finish) [@nontail]
+  ;;
+
+  let filter_map t ~f = debug t (fun () -> filter_map t ~f) [@nontail]
+  let filter t ~f = debug t (fun () -> filter t ~f) [@nontail]
+  let filter_inplace t ~f = debug t (fun () -> filter_inplace t ~f) [@nontail]
+end
+
+module Test (Stack : S) : S with type 'a t = 'a Stack.t =
+(* This signature is here to remind us to add a unit test whenever we add something to
+   the stack interface. *)
+struct
+  open Stack
+
+  type nonrec 'a t = 'a t
+
+  include Test_container.Test_S1 (Stack)
+
+  let t_sexp_grammar = t_sexp_grammar
+  let invariant = invariant
+  let create = create
+  let is_empty = is_empty
+  let top_exn = top_exn
+  let pop_exn = pop_exn
+  let pop = pop
+  let top = top
+  let singleton = singleton
+
+  let%test_unit _ =
+    let empty = create () in
+    invariant ignore empty;
+    invariant (fun b -> assert b) (of_list [ true ]);
+    assert (is_empty empty);
+    let t = create () in
+    push t 0;
+    assert (not (is_empty t));
+    assert (Exn.does_raise (fun () -> top_exn empty));
+    let t = create () in
+    push t 0;
+    [%test_result: int] (top_exn t) ~expect:0;
+    assert (Exn.does_raise (fun () -> pop_exn empty));
+    let t = create () in
+    push t 0;
+    [%test_result: int] (pop_exn t) ~expect:0;
+    assert (Option.is_none (pop empty));
+    assert (Option.is_some (pop (of_list [ 0 ])));
+    assert (Option.is_none (top empty));
+    assert (Option.is_some (top (of_list [ 0 ])));
+    assert (Option.is_some (top (singleton 0)));
+    assert (Option.is_some (pop (singleton 0)));
+    assert (
+      let t = singleton 0 in
+      ignore (pop_exn t : int);
+      Option.is_none (top t))
+  ;;
+
+  let min_elt = min_elt
+  let max_elt = max_elt
+
+  let%test_unit _ =
+    let empty = create () in
+    [%test_result: _ option] (min_elt ~compare:Int.compare empty) ~expect:None;
+    [%test_result: _ option] (max_elt ~compare:Int.compare empty) ~expect:None;
+    [%test_result: int] (sum (module Int) ~f:Fn.id empty) ~expect:0
+  ;;
+
+  let push = push
+  let copy = copy
+  let until_empty = until_empty
+
+  let%test_unit _ =
+    let t =
+      let t = create () in
+      push t 0;
+      push t 1;
+      push t 2;
+      t
+    in
+    [%test_result: bool] (is_empty t) ~expect:false;
+    [%test_result: int] (length t) ~expect:3;
+    [%test_result: int option] (top t) ~expect:(Some 2);
+    [%test_result: int] (top_exn t) ~expect:2;
+    [%test_result: int option] (min_elt ~compare:Int.compare t) ~expect:(Some 0);
+    [%test_result: int option] (max_elt ~compare:Int.compare t) ~expect:(Some 2);
+    [%test_result: int] (sum (module Int) ~f:Fn.id t) ~expect:3;
+    let t' = copy t in
+    [%test_result: int] (pop_exn t') ~expect:2;
+    [%test_result: int] (pop_exn t') ~expect:1;
+    [%test_result: int] (pop_exn t') ~expect:0;
+    [%test_result: int] (length t') ~expect:0;
+    [%test_result: bool] (is_empty t') ~expect:true;
+    let t' = copy t in
+    [%test_result: int option] (pop t') ~expect:(Some 2);
+    [%test_result: int option] (pop t') ~expect:(Some 1);
+    [%test_result: int option] (pop t') ~expect:(Some 0);
+    [%test_result: int] (length t') ~expect:0;
+    [%test_result: bool] (is_empty t') ~expect:true;
+    (* test that t was not modified by pops applied to copies *)
+    [%test_result: int] (length t) ~expect:3;
+    [%test_result: int] (top_exn t) ~expect:2;
+    [%test_result: int list] (to_list t) ~expect:[ 2; 1; 0 ];
+    [%test_result: int array] (to_array t) ~expect:[| 2; 1; 0 |];
+    [%test_result: int] (length t) ~expect:3;
+    [%test_result: int] (top_exn t) ~expect:2;
+    let t' = copy t in
+    let n = ref 0 in
+    until_empty t' (fun x -> n := !n + x);
+    [%test_result: int] !n ~expect:3;
+    [%test_result: bool] (is_empty t') ~expect:true;
+    [%test_result: int] (length t') ~expect:0
+  ;;
+
+  let%test_unit _ =
+    let t = create () in
+    [%test_result: bool] (is_empty t) ~expect:true;
+    [%test_result: int] (length t) ~expect:0;
+    [%test_result: _ list] (to_list t) ~expect:[];
+    [%test_result: _ option] (pop t) ~expect:None;
+    push t 13;
+    [%test_result: bool] (is_empty t) ~expect:false;
+    [%test_result: int] (length t) ~expect:1;
+    [%test_result: int option] (min_elt ~compare:Int.compare t) ~expect:(Some 13);
+    [%test_result: int option] (max_elt ~compare:Int.compare t) ~expect:(Some 13);
+    [%test_result: int] (sum (module Int) ~f:Fn.id t) ~expect:13;
+    [%test_result: int] (pop_exn t) ~expect:13;
+    [%test_result: bool] (is_empty t) ~expect:true;
+    [%test_result: int] (length t) ~expect:0;
+    push t 13;
+    push t 14;
+    [%test_result: bool] (is_empty t) ~expect:false;
+    [%test_result: int] (length t) ~expect:2;
+    [%test_result: int list] (to_list t) ~expect:[ 14; 13 ];
+    [%test_result: int option] (min_elt ~compare:Int.compare t) ~expect:(Some 13);
+    [%test_result: int option] (max_elt ~compare:Int.compare t) ~expect:(Some 14);
+    [%test_result: int] (sum (module Int) ~f:Fn.id t) ~expect:27;
+    [%test_result: bool] (Option.is_some (pop t)) ~expect:true;
+    [%test_result: bool] (Option.is_some (pop t)) ~expect:true
+  ;;
+
+  let of_list = of_list
+
+  let%test_unit _ =
+    for n = 0 to 5 do
+      let l = List.init n ~f:Fn.id in
+      [%test_result: int list] (to_list (of_list l)) ~expect:l
+    done
+  ;;
+
+  let clear = clear
+
+  let%test_unit _ =
+    for n = 0 to 5 do
+      let t = of_list (List.init n ~f:Fn.id) in
+      clear t;
+      assert (is_empty t);
+      push t 13;
+      [%test_result: int] (length t) ~expect:1
+    done
+  ;;
+
+  let%test_unit "float test" =
+    let s = create () in
+    push s 1.0;
+    push s 2.0;
+    push s 3.0
+  ;;
+
+  let filter_map = filter_map
+
+  let%test_unit "filter_map" =
+    let s = create () in
+    push s 0;
+    push s 1;
+    push s 2;
+    push s 3;
+    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
+    let s = filter_map s ~f:(fun i -> if i % 2 <> 0 then Some (i * 2) else None) in
+    [%test_result: int list] (to_list s) ~expect:[ 6; 2 ];
+    let s = filter_map s ~f:(fun i -> if i < 4 then Some (i * 2) else None) in
+    [%test_result: int list] (to_list s) ~expect:[ 4 ]
+  ;;
+
+  let filter = filter
+
+  let%test_unit "filter" =
+    let s = create () in
+    push s 0;
+    push s 1;
+    push s 2;
+    push s 3;
+    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
+    let s = filter s ~f:(fun i -> i % 2 <> 0) in
+    [%test_result: int list] (to_list s) ~expect:[ 3; 1 ];
+    let s = filter s ~f:(fun i -> i < 2) in
+    [%test_result: int list] (to_list s) ~expect:[ 1 ]
+  ;;
+
+  let filter_inplace = filter_inplace
+
+  let%test_unit "filter_inplace" =
+    let s = create () in
+    push s 0;
+    push s 1;
+    push s 2;
+    push s 3;
+    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
+    filter_inplace s ~f:(fun i -> i % 2 <> 0);
+    [%test_result: int list] (to_list s) ~expect:[ 3; 1 ];
+    filter_inplace s ~f:(fun i -> i < 2);
+    [%test_result: int list] (to_list s) ~expect:[ 1 ]
+  ;;
+
+  let%test_unit "filter_inplace raises after removing" =
+    let s = create () in
+    push s 0;
+    push s 1;
+    push s 2;
+    push s 3;
+    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
+    assert (
+      Exn.does_raise (fun () ->
+        filter_inplace s ~f:(fun i ->
+          if Int.(i = 2) then raise_s [%message "exn"] else false)));
+    [%test_result: int list] (to_list s) ~expect:[]
+  ;;
+
+  let%test_unit "filter_inplace raises after keeping" =
+    let s = create () in
+    push s 0;
+    push s 1;
+    push s 2;
+    push s 3;
+    [%test_result: int list] (to_list s) ~expect:[ 3; 2; 1; 0 ];
+    assert (
+      Exn.does_raise (fun () ->
+        filter_inplace s ~f:(fun i ->
+          if Int.(i = 2) then raise_s [%message "exn"] else true)));
+    [%test_result: int list] (to_list s) ~expect:[ 1; 0 ]
+  ;;
+end

unikernel/duniverse/base/test/helpers/test_stack.mli

@@ -0,0 +1,3 @@
+open! Base
+module Debug (S : Stack.S) : Stack.S with type 'a t = 'a S.t
+module Test (S : Stack.S) : sig end

unikernel/duniverse/base/test/import.ml

@@ -0,0 +1,46 @@
+include Base
+include Stdio
+include Base_for_tests
+include Base_test_helpers
+include Base_quickcheck.Export
+include Expect_test_helpers_base
+
+let () = Int_conversions.sexp_of_int_style := `Underscores
+let is_none = Option.is_none
+let is_some = Option.is_some
+let ok_exn = Or_error.ok_exn
+let stage = Staged.stage
+let unstage = Staged.unstage
+
+module type Hash = sig
+  type t [@@deriving hash, sexp_of]
+end
+
+let check_hash_coherence (type t) here (module T : Hash with type t = t) ts =
+  List.iter ts ~f:(fun t ->
+    let hash1 = T.hash t in
+    let hash2 = [%hash: T.t] t in
+    require
+      here
+      (hash1 = hash2)
+      ~cr:CR_soon
+      ~if_false_then_print_s:
+        (lazy [%message "" ~value:(t : T.t) (hash1 : int) (hash2 : int)]))
+;;
+
+module type Int_hash = sig
+  include Hash
+
+  val of_int_exn : int -> t
+  val min_value : t
+  val max_value : t
+end
+
+let check_int_hash_coherence (type t) here (module I : Int_hash with type t = t) =
+  check_hash_coherence
+    here
+    (module I)
+    [ I.min_value; I.of_int_exn 0; I.of_int_exn 37; I.max_value ]
+;;
+
+let test_conversion ~to_string f x = printf "%s --> %s\n" (to_string x) (to_string (f x))

unikernel/duniverse/base/test/map_full_interface/base_test_map_full_interface.ml

@@ -0,0 +1 @@
+(*_ This library deliberately exports nothing. *)

unikernel/duniverse/base/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)))

unikernel/duniverse/base/test/map_full_interface/functor.mli

@@ -0,0 +1 @@
+include Functor_intf.Functor

unikernel/duniverse/base/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

unikernel/duniverse/base/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

unikernel/duniverse/base/test/map_full_interface/test_all.mli

@@ -0,0 +1,5 @@
+open! Base
+
+include module type of struct
+  include Map
+end [@remove_aliases]

unikernel/duniverse/base/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 {| |}]
+;;

unikernel/duniverse/base/test/map_full_interface/test_poly.mli

@@ -0,0 +1 @@
+include Test_poly_intf.Test_poly

unikernel/duniverse/base/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

unikernel/duniverse/base/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 {| |}]
+;;

unikernel/duniverse/base/test/map_full_interface/test_toplevel.mli

@@ -0,0 +1 @@
+include Test_toplevel_intf.Test_toplevel

unikernel/duniverse/base/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

unikernel/duniverse/base/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 {| |}]
+;;

unikernel/duniverse/base/test/map_full_interface/test_tree.mli

@@ -0,0 +1 @@
+include Test_tree_intf.Test_tree

unikernel/duniverse/base/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

unikernel/duniverse/base/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 {| |}]
+;;

unikernel/duniverse/base/test/map_full_interface/test_using_comparator.mli

@@ -0,0 +1 @@
+include Test_using_comparator_intf.Test_using_comparator

unikernel/duniverse/base/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

unikernel/duniverse/base/test/test_am_testing.ml

@@ -0,0 +1,7 @@
+open! Base
+open! Import
+
+let%expect_test _ =
+  print_s [%sexp (Exported_for_specific_uses.am_testing : bool)];
+  [%expect {| true |}]
+;;

unikernel/duniverse/base/test/test_am_testing.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_am_testing.mlt

@@ -0,0 +1,9 @@
+open! Base
+open! Expect_test_helpers_base
+
+let () = print_s [%sexp (Exported_for_specific_uses.am_testing : bool)]
+
+[%%expect
+  {|
+true
+|}]

unikernel/duniverse/base/test/test_applicative.ml

@@ -0,0 +1,337 @@
+open! Import
+
+module Test_applicative_s (A : Applicative.S with type 'a t := 'a Or_error.t) :
+  Applicative.S with type 'a t := 'a Or_error.t = struct
+  let error = Or_error.error_string
+  let return = A.return
+
+  let%expect_test _ =
+    print_s [%sexp (return "okay" : string Or_error.t)];
+    [%expect {| (Ok okay) |}]
+  ;;
+
+  let apply = A.apply
+
+  let%expect_test _ =
+    let test x y = print_s [%sexp (apply x y : string Or_error.t)] in
+    test (Ok String.capitalize) (Ok "okay");
+    [%expect {| (Ok Okay) |}];
+    test (error "not okay") (Ok "okay");
+    [%expect {| (Error "not okay") |}];
+    test (Ok String.capitalize) (error "not okay");
+    [%expect {| (Error "not okay") |}];
+    test (error "no fun") (error "no arg");
+    [%expect {| (Error ("no fun" "no arg")) |}]
+  ;;
+
+  let ( <*> ) = A.( <*> )
+
+  let%expect_test _ =
+    let test x y = print_s [%sexp (x <*> y : string Or_error.t)] in
+    test (Ok String.capitalize) (Ok "okay");
+    [%expect {| (Ok Okay) |}];
+    test (error "not okay") (Ok "okay");
+    [%expect {| (Error "not okay") |}];
+    test (Ok String.capitalize) (error "not okay");
+    [%expect {| (Error "not okay") |}];
+    test (error "no fun") (error "no arg");
+    [%expect {| (Error ("no fun" "no arg")) |}]
+  ;;
+
+  let ( *> ) = A.( *> )
+
+  let%expect_test _ =
+    let test x y = print_s [%sexp (x *> y : string Or_error.t)] in
+    test (Ok ()) (Ok "kay");
+    [%expect {| (Ok kay) |}];
+    test (error "not okay") (Ok "kay");
+    [%expect {| (Error "not okay") |}];
+    test (Ok ()) (error "not okay");
+    [%expect {| (Error "not okay") |}];
+    test (error "no fst") (error "no snd");
+    [%expect {| (Error ("no fst" "no snd")) |}]
+  ;;
+
+  let ( <* ) = A.( <* )
+
+  let%expect_test _ =
+    let test x y = print_s [%sexp (x <* y : string Or_error.t)] in
+    test (Ok "okay") (Ok ());
+    [%expect {| (Ok okay) |}];
+    test (error "not okay") (Ok ());
+    [%expect {| (Error "not okay") |}];
+    test (Ok "okay") (error "not okay");
+    [%expect {| (Error "not okay") |}];
+    test (error "no fst") (error "no snd");
+    [%expect {| (Error ("no fst" "no snd")) |}]
+  ;;
+
+  let both = A.both
+
+  let%expect_test _ =
+    let test x y = print_s [%sexp (both x y : (string * string) Or_error.t)] in
+    test (Ok "o") (Ok "kay");
+    [%expect {| (Ok (o kay)) |}];
+    test (error "not okay") (Ok "kay");
+    [%expect {| (Error "not okay") |}];
+    test (Ok "o") (error "not okay");
+    [%expect {| (Error "not okay") |}];
+    test (error "no fst") (error "no snd");
+    [%expect {| (Error ("no fst" "no snd")) |}]
+  ;;
+
+  let map = A.map
+
+  let%expect_test _ =
+    let test x = print_s [%sexp (map x ~f:String.capitalize : string Or_error.t)] in
+    test (Ok "okay");
+    [%expect {| (Ok Okay) |}];
+    test (error "not okay");
+    [%expect {| (Error "not okay") |}]
+  ;;
+
+  let ( >>| ) = A.( >>| )
+
+  let%expect_test _ =
+    let test x = print_s [%sexp (x >>| String.capitalize : string Or_error.t)] in
+    test (Ok "okay");
+    [%expect {| (Ok Okay) |}];
+    test (error "not okay");
+    [%expect {| (Error "not okay") |}]
+  ;;
+
+  let map2 = A.map2
+
+  let%expect_test _ =
+    let test x y = print_s [%sexp (map2 x y ~f:( ^ ) : string Or_error.t)] in
+    test (Ok "o") (Ok "kay");
+    [%expect {| (Ok okay) |}];
+    test (error "not okay") (Ok "kay");
+    [%expect {| (Error "not okay") |}];
+    test (Ok "o") (error "not okay");
+    [%expect {| (Error "not okay") |}];
+    test (error "no fst") (error "no snd");
+    [%expect {| (Error ("no fst" "no snd")) |}]
+  ;;
+
+  let map3 = A.map3
+
+  let%expect_test _ =
+    let test x y z =
+      print_s [%sexp (map3 x y z ~f:(fun a b c -> a ^ b ^ c) : string Or_error.t)]
+    in
+    test (Ok "o") (Ok "k") (Ok "ay");
+    [%expect {| (Ok okay) |}];
+    test (error "not okay") (Ok "k") (Ok "ay");
+    [%expect {| (Error "not okay") |}];
+    test (Ok "o") (error "not okay") (Ok "ay");
+    [%expect {| (Error "not okay") |}];
+    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")) |}]
+  ;;
+
+  let all = A.all
+
+  let%expect_test _ =
+    let test list = print_s [%sexp (all list : string list Or_error.t)] in
+    test [];
+    [%expect {| (Ok ()) |}];
+    test [ Ok "okay" ];
+    [%expect {| (Ok (okay)) |}];
+    test [ Ok "o"; Ok "kay" ];
+    [%expect {| (Ok (o kay)) |}];
+    test [ Ok "o"; Ok "k"; Ok "ay" ];
+    [%expect {| (Ok (o k ay)) |}];
+    test [ error "oh no!" ];
+    [%expect {| (Error "oh no!") |}];
+    test [ error "oh no!"; Ok "okay" ];
+    [%expect {| (Error "oh no!") |}];
+    test [ Ok "okay"; error "oh no!" ];
+    [%expect {| (Error "oh no!") |}];
+    test [ error "oh no!"; Ok "o"; Ok "kay" ];
+    [%expect {| (Error "oh no!") |}];
+    test [ Ok "o"; error "oh no!"; Ok "aay" ];
+    [%expect {| (Error "oh no!") |}];
+    test [ Ok "o"; Ok "kay"; error "oh no!" ];
+    [%expect {| (Error "oh no!") |}];
+    test [ error "oh"; error "no"; error "!" ];
+    [%expect {| (Error (oh no !)) |}]
+  ;;
+
+  let all_unit = A.all_unit
+
+  let%expect_test _ =
+    let test list = print_s [%sexp (all_unit list : unit Or_error.t)] in
+    test [];
+    [%expect {| (Ok ()) |}];
+    test [ Ok () ];
+    [%expect {| (Ok ()) |}];
+    test [ Ok (); Ok () ];
+    [%expect {| (Ok ()) |}];
+    test [ Ok (); Ok (); Ok () ];
+    [%expect {| (Ok ()) |}];
+    test [ error "oh no!" ];
+    [%expect {| (Error "oh no!") |}];
+    test [ error "oh no!"; Ok () ];
+    [%expect {| (Error "oh no!") |}];
+    test [ Ok (); error "oh no!" ];
+    [%expect {| (Error "oh no!") |}];
+    test [ error "oh no!"; Ok (); Ok () ];
+    [%expect {| (Error "oh no!") |}];
+    test [ Ok (); error "oh no!"; Ok () ];
+    [%expect {| (Error "oh no!") |}];
+    test [ Ok (); Ok (); error "oh no!" ];
+    [%expect {| (Error "oh no!") |}];
+    test [ error "oh"; error "no"; error "!" ];
+    [%expect {| (Error (oh no !)) |}]
+  ;;
+
+  module Applicative_infix = A.Applicative_infix
+end
+
+let%test_module "Make" =
+  (module Test_applicative_s (Applicative.Make (struct
+    type 'a t = 'a Or_error.t
+
+    let return = Or_error.return
+    let apply = Or_error.apply
+    let map = `Define_using_apply
+  end)))
+;;
+
+let%test_module "Make" =
+  (module Test_applicative_s (Applicative.Make_using_map2 (struct
+    type 'a t = 'a Or_error.t
+
+    let return = Or_error.return
+    let map2 = Or_error.map2
+    let map = `Define_using_map2
+  end)))
+;;
+
+let%test_module "Make" =
+  (module Test_applicative_s (Applicative.Make_using_map2_local (struct
+    type 'a t = 'a Or_error.t
+
+    let return x = Ok x
+    let map2 = Or_error.map2
+    let map = `Define_using_map2
+  end)))
+;;
+
+(* While law-abiding applicatives shouldn't be relying functions being called
+   the minimal number of times, it is good for performance that things be this
+   way. For many applicatives this will not matter very much, but for others,
+   like Bonsai, it is a little more significant, since extra calls construct
+   more Incremental nodes, yielding more strain on the Incremental stabilizer.
+
+   The point is that we should not assume that the input applicative instance
+   can be frivolous in creating nodes in the applicative call-tree.
+*)
+let%expect_test _ =
+  let module A = struct
+    type 'a t =
+      | Other of string
+      | Return : 'a -> 'a t
+      | Map : ('a -> 'b) * 'a t -> 'b t
+      | Map2 : ('a -> 'b -> 'c) * 'a t * 'b t -> 'c t
+
+    include Applicative.Make_using_map2 (struct
+      type nonrec 'a t = 'a t
+
+      let return x = Return x
+      let map2 a b ~f = Map2 (f, a, b)
+      let map = `Custom (fun a ~f -> Map (f, a))
+    end)
+
+    let rec sexp_of_t : type a. a t -> Sexp.t = function
+      | Other x -> Atom x
+      | Return _ -> Atom "Return"
+      | Map (_, a) -> List [ Atom "Map"; sexp_of_t a ]
+      | Map2 (_, a, b) -> List [ Atom "Map2"; sexp_of_t a; sexp_of_t b ]
+    ;;
+  end
+  in
+  let open A in
+  let test x = print_s [%sexp (x : A.t)] in
+  let a, b, c, d = Other "A", Other "B", Other "C", Other "D" in
+  test (map2 a b ~f:(fun a b -> a, b));
+  [%expect {| (Map2 A B) |}];
+  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) |}];
+  test (a *> b);
+  [%expect {| (Map2 A B) |}]
+;;
+
+(* These functors serve only to check that the signatures for various Foo and Foo2 module
+   types don't drift apart over time. *)
+module _ = struct
+  open Applicative
+
+  (* Applicative_infix to Applicative_infix2 *)
+
+  module _ (X : Applicative_infix) : Applicative_infix2 with type ('a, 'e) t = 'a X.t =
+  struct
+    include X
+
+    type ('a, 'e) t = 'a X.t
+  end
+
+  (* Applicative_infix2 to Applicative_infix *)
+  module _ (X : Applicative_infix2) : Applicative_infix with type 'a t = ('a, unit) X.t =
+  struct
+    include X
+
+    type 'a t = ('a, unit) X.t
+  end
+
+  (* Applicative_infix2 to Applicative_infix3 *)
+  module _ (X : Applicative_infix2) :
+    Applicative_infix3 with type ('a, 'd, 'e) t = ('a, 'd) X.t = struct
+    include X
+
+    type ('a, 'd, 'e) t = ('a, 'd) X.t
+  end
+
+  (* Applicative_infix3 to Applicative_infix2 *)
+  module _ (X : Applicative_infix3) :
+    Applicative_infix2 with type ('a, 'd) t = ('a, 'd, unit) X.t = struct
+    include X
+
+    type ('a, 'd) t = ('a, 'd, unit) X.t
+  end
+
+  (* Let_syntax to Let_syntax2 *)
+  module _ (X : Let_syntax) : Let_syntax2 with type ('a, 'e) t = 'a X.t = struct
+    include X
+
+    type ('a, 'e) t = 'a X.t
+  end
+
+  (* Let_syntax2 to Let_syntax *)
+  module _ (X : Let_syntax2) : Let_syntax with type 'a t = ('a, unit) X.t = struct
+    include X
+
+    type 'a t = ('a, unit) X.t
+  end
+
+  (* Let_syntax2 to Let_syntax3 *)
+  module _ (X : Let_syntax2) : Let_syntax3 with type ('a, 'd, 'e) t = ('a, 'd) X.t =
+  struct
+    include X
+
+    type ('a, 'd, 'e) t = ('a, 'd) X.t
+  end
+
+  (* Let_syntax3 to Let_syntax2 *)
+  module _ (X : Let_syntax3) : Let_syntax2 with type ('a, 'd) t = ('a, 'd, unit) X.t =
+  struct
+    include X
+
+    type ('a, 'd) t = ('a, 'd, unit) X.t
+  end
+end

unikernel/duniverse/base/test/test_applicative.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_applicative.mlt

@@ -0,0 +1,14 @@
+open Base
+open Expect_test_helpers_base
+
+let () =
+  let z = 3 in
+  let local_ f x y = x + y + z in
+  let r = Option.map2 (Some 3) (Some 4) ~f in
+  print_s [%sexp (r : int option)]
+;;
+
+[%%expect
+  {|
+(10)
+|}]

unikernel/duniverse/base/test/test_array.ml

@@ -0,0 +1,682 @@
+open! Import
+open Base_quickcheck
+open Expect_test_helpers_base
+open Array
+
+let%test_module "Binary_searchable" =
+  (module Test_binary_searchable.Test1 (struct
+    include Array
+
+    module For_test = struct
+      let of_array = Fn.id
+    end
+  end))
+;;
+
+let%test_module "Blit" =
+  (module Test_blit.Test1
+            (struct
+              type 'a z = 'a
+
+              include Array
+
+              let create_bool ~len = create ~len false
+            end)
+            (Array))
+;;
+
+module List_helpers = struct
+  let rec sprinkle x xs =
+    (x :: xs)
+    ::
+    (match xs with
+     | [] -> []
+     | x' :: xs' -> List.map (sprinkle x xs') ~f:(fun sprinkled -> x' :: sprinkled))
+  ;;
+
+  let rec permutations = function
+    | [] -> [ [] ]
+    | x :: xs -> List.concat_map (permutations xs) ~f:(fun perms -> sprinkle x perms)
+  ;;
+end
+
+let%test_module "Sort" =
+  (module struct
+    open Private.Sort
+
+    let%test_module "Intro_sort.five_element_sort" =
+      (module struct
+        (* run [five_element_sort] on all permutations of an array of five elements *)
+
+        let all_perms = List_helpers.permutations [ 1; 2; 3; 4; 5 ]
+        let%test _ = List.length all_perms = 120
+        let%test _ = not (List.contains_dup ~compare:[%compare: int list] all_perms)
+
+        let%test _ =
+          List.for_all all_perms ~f:(fun l ->
+            let arr = Array.of_list l in
+            Intro_sort.five_element_sort arr ~compare:[%compare: int] 0 1 2 3 4;
+            [%compare.equal: int t] arr [| 1; 2; 3; 4; 5 |])
+        ;;
+      end)
+    ;;
+
+    module Test (M : Private.Sort.Sort) = struct
+      let random_data ~length ~range =
+        let arr = Array.create ~len:length 0 in
+        for i = 0 to length - 1 do
+          arr.(i) <- Random.int range
+        done;
+        arr
+      ;;
+
+      let assert_sorted arr =
+        M.sort arr ~left:0 ~right:(Array.length arr - 1) ~compare:[%compare: int];
+        let len = Array.length arr in
+        let rec loop i prev =
+          if i = len then true else if arr.(i) < prev then false else loop (i + 1) arr.(i)
+        in
+        loop 0 (-1)
+      ;;
+
+      let%test _ = assert_sorted (random_data ~length:0 ~range:100)
+      let%test _ = assert_sorted (random_data ~length:1 ~range:100)
+      let%test _ = assert_sorted (random_data ~length:100 ~range:1_000)
+      let%test _ = assert_sorted (random_data ~length:1_000 ~range:1)
+      let%test _ = assert_sorted (random_data ~length:1_000 ~range:10)
+      let%test _ = assert_sorted (random_data ~length:1_000 ~range:1_000_000)
+    end
+
+    let%test_module _ = (module Test (Insertion_sort))
+    let%test_module _ = (module Test (Heap_sort))
+    let%test_module _ = (module Test (Intro_sort))
+  end)
+;;
+
+let%test _ = is_sorted [||] ~compare:[%compare: int]
+let%test _ = is_sorted [| 0 |] ~compare:[%compare: int]
+let%test _ = is_sorted [| 0; 1; 2; 2; 4 |] ~compare:[%compare: int]
+let%test _ = not (is_sorted [| 0; 1; 2; 3; 2 |] ~compare:[%compare: int])
+
+let%test_unit _ =
+  List.iter
+    ~f:(fun (t, expect) ->
+      assert (Bool.equal expect (is_sorted_strictly (of_list t) ~compare:[%compare: int])))
+    [ [], true
+    ; [ 1 ], true
+    ; [ 1; 2 ], true
+    ; [ 1; 1 ], false
+    ; [ 2; 1 ], false
+    ; [ 1; 2; 3 ], true
+    ; [ 1; 1; 3 ], false
+    ; [ 1; 2; 2 ], false
+    ]
+;;
+
+let%expect_test "merge" =
+  let test a1 a2 =
+    let res = merge a1 a2 ~compare:Int.compare in
+    print_s ([%sexp_of: int array] res);
+    require_equal
+      [%here]
+      (module struct
+        type t = int list [@@deriving equal, sexp_of]
+      end)
+      (to_list res)
+      (List.merge (to_list a1) (to_list a2) ~compare:Int.compare)
+  in
+  test [||] [||];
+  [%expect {| () |}];
+  test [| 1; 2; 3 |] [||];
+  [%expect {| (1 2 3) |}];
+  test [||] [| 1; 2; 3 |];
+  [%expect {| (1 2 3) |}];
+  test [| 1; 2; 3 |] [| 1; 2; 3 |];
+  [%expect {| (1 1 2 2 3 3) |}];
+  test [| 1; 2; 3 |] [| 4; 5; 6 |];
+  [%expect {| (1 2 3 4 5 6) |}];
+  test [| 4; 5; 6 |] [| 1; 2; 3 |];
+  [%expect {| (1 2 3 4 5 6) |}];
+  test [| 3; 5 |] [| 1; 2; 4; 6 |];
+  [%expect {| (1 2 3 4 5 6) |}];
+  test [| 1; 3; 7; 8; 9 |] [| 2; 4; 5; 6 |];
+  [%expect {| (1 2 3 4 5 6 7 8 9) |}];
+  test [| 1; 2; 2; 3 |] [| 2; 2; 3; 4 |];
+  [%expect {| (1 2 2 2 2 3 3 4) |}]
+;;
+
+let%expect_test "merge with duplicates" =
+  (* Testing that equal elements from a1 come before equal elements from a2 *)
+  let test a1 a2 =
+    let compare a b = Comparable.lift Int.compare ~f:fst a b in
+    let res = merge a1 a2 ~compare in
+    print_s ([%sexp_of: (int * string) array] res);
+    require_equal
+      [%here]
+      (module struct
+        type t = (int * string) list [@@deriving equal, sexp_of]
+      end)
+      (to_list res)
+      (List.merge (to_list a1) (to_list a2) ~compare)
+  in
+  test [| 1, "a1" |] [| 1, "a2" |];
+  [%expect {|
+    ((1 a1)
+     (1 a2))
+    |}];
+  test [| 1, "a1"; 2, "a1"; 3, "a1" |] [| 3, "a2"; 4, "a2"; 5, "a2" |];
+  [%expect
+    {|
+    ((1 a1)
+     (2 a1)
+     (3 a1)
+     (3 a2)
+     (4 a2)
+     (5 a2))
+    |}];
+  test [| 3, "a1"; 4, "a1"; 5, "a1" |] [| 1, "a2"; 2, "a2"; 3, "a2" |];
+  [%expect
+    {|
+    ((1 a2)
+     (2 a2)
+     (3 a1)
+     (3 a2)
+     (4 a1)
+     (5 a1))
+    |}];
+  test [| 1, "a1"; 3, "a1"; 3, "a1"; 5, "a1" |] [| 2, "a2"; 3, "a2"; 3, "a2"; 4, "a2" |];
+  [%expect
+    {|
+    ((1 a1)
+     (2 a2)
+     (3 a1)
+     (3 a1)
+     (3 a2)
+     (3 a2)
+     (4 a2)
+     (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_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
+    let l1 = List.init i ~f:Fn.id in
+    let l2 = List.rev (to_list (of_list_rev l1)) in
+    assert ([%compare.equal: int list] l1 l2)
+  done
+;;
+
+let%test_unit _ =
+  [%test_result: int array]
+    (filter_opt [| Some 1; None; Some 2; None; Some 3 |])
+    ~expect:[| 1; 2; 3 |]
+;;
+
+let%test_unit _ =
+  [%test_result: int array] (filter_opt [| Some 1; None; Some 2 |]) ~expect:[| 1; 2 |]
+;;
+
+let%test_unit _ = [%test_result: int array] (filter_opt [| Some 1 |]) ~expect:[| 1 |]
+let%test_unit _ = [%test_result: int array] (filter_opt [| None |]) ~expect:[||]
+let%test_unit _ = [%test_result: int array] (filter_opt [||]) ~expect:[||]
+
+let%expect_test _ =
+  print_s ([%sexp_of: int array] (map2_exn [| 1; 2; 3 |] [| 2; 3; 4 |] ~f:( + )));
+  [%expect {| (3 5 7) |}]
+;;
+
+let%expect_test "map2_exn raise" =
+  require_does_raise [%here] (fun () -> map2_exn [| 1; 2; 3 |] [| 2; 3; 4; 5 |] ~f:( + ));
+  [%expect {| (Invalid_argument "length mismatch in Array.map2_exn: 3 <> 4") |}]
+;;
+
+let%test_unit _ =
+  [%test_result: int]
+    (fold2_exn [||] [||] ~init:13 ~f:(fun _ -> failwith "fail"))
+    ~expect:13
+;;
+
+let%test_unit _ =
+  [%test_result: (int * string) list]
+    (fold2_exn [| 1 |] [| "1" |] ~init:[] ~f:(fun ac a b -> (a, b) :: ac))
+    ~expect:[ 1, "1" ]
+;;
+
+let%test_unit _ =
+  [%test_result: int array] (filter [| 0; 1 |] ~f:(fun n -> n < 2)) ~expect:[| 0; 1 |]
+;;
+
+let%test_unit _ =
+  [%test_result: int array] (filter [| 0; 1 |] ~f:(fun n -> n < 1)) ~expect:[| 0 |]
+;;
+
+let%test_unit _ =
+  [%test_result: int array] (filter [| 0; 1 |] ~f:(fun n -> n < 0)) ~expect:[||]
+;;
+
+let%test_unit _ = [%test_result: bool] (exists [||] ~f:(fun _ -> true)) ~expect:false
+
+let%test_unit _ =
+  [%test_result: bool] (exists [| 0; 1; 2; 3 |] ~f:(fun x -> 4 = x)) ~expect:false
+;;
+
+let%test_unit _ =
+  [%test_result: bool] (exists [| 0; 1; 2; 3 |] ~f:(fun x -> 2 = x)) ~expect:true
+;;
+
+let%test_unit _ = [%test_result: bool] (existsi [||] ~f:(fun _ _ -> true)) ~expect:false
+
+let%test_unit _ =
+  [%test_result: bool] (existsi [| 0; 1; 2; 3 |] ~f:(fun i x -> i <> x)) ~expect:false
+;;
+
+let%test_unit _ =
+  [%test_result: bool] (existsi [| 0; 1; 3; 3 |] ~f:(fun i x -> i <> x)) ~expect:true
+;;
+
+let%test_unit _ = [%test_result: bool] (for_all [||] ~f:(fun _ -> false)) ~expect:true
+
+let%test_unit _ =
+  [%test_result: bool] (for_all [| 1; 2; 3 |] ~f:Int.is_positive) ~expect:true
+;;
+
+let%test_unit _ =
+  [%test_result: bool] (for_all [| 0; 1; 3; 3 |] ~f:Int.is_positive) ~expect:false
+;;
+
+let%test_unit _ = [%test_result: bool] (for_alli [||] ~f:(fun _ _ -> false)) ~expect:true
+
+let%test_unit _ =
+  [%test_result: bool] (for_alli [| 0; 1; 2; 3 |] ~f:(fun i x -> i = x)) ~expect:true
+;;
+
+let%test_unit _ =
+  [%test_result: bool] (for_alli [| 0; 1; 3; 3 |] ~f:(fun i x -> i = x)) ~expect:false
+;;
+
+let%test_unit _ =
+  [%test_result: bool] (exists2_exn [||] [||] ~f:(fun _ _ -> true)) ~expect:false
+;;
+
+let%test_unit _ =
+  [%test_result: bool]
+    (exists2_exn [| 0; 2; 4; 6 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x <> y))
+    ~expect:false
+;;
+
+let%test_unit _ =
+  [%test_result: bool]
+    (exists2_exn [| 0; 2; 4; 8 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x <> y))
+    ~expect:true
+;;
+
+let%test_unit _ =
+  [%test_result: bool]
+    (exists2_exn [| 2; 2; 4; 6 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x <> y))
+    ~expect:true
+;;
+
+let%test_unit _ =
+  [%test_result: bool] (for_all2_exn [||] [||] ~f:(fun _ _ -> false)) ~expect:true
+;;
+
+let%test_unit _ =
+  [%test_result: bool]
+    (for_all2_exn [| 0; 2; 4; 6 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x = y))
+    ~expect:true
+;;
+
+let%test_unit _ =
+  [%test_result: bool]
+    (for_all2_exn [| 0; 2; 4; 8 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x = y))
+    ~expect:false
+;;
+
+let%test_unit _ =
+  [%test_result: bool]
+    (for_all2_exn [| 2; 2; 4; 6 |] [| 0; 2; 4; 6 |] ~f:(fun x y -> x = y))
+    ~expect:false
+;;
+
+let%test_unit _ = [%test_result: bool] (equal ( = ) [||] [||]) ~expect:true
+let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1 |] [| 1 |]) ~expect:true
+let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1; 2 |] [| 1; 2 |]) ~expect:true
+let%test_unit _ = [%test_result: bool] (equal ( = ) [||] [| 1 |]) ~expect:false
+let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1 |] [||]) ~expect:false
+let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1 |] [| 1; 2 |]) ~expect:false
+let%test_unit _ = [%test_result: bool] (equal ( = ) [| 1; 2 |] [| 1; 3 |]) ~expect:false
+
+let%test_unit _ =
+  [%test_result: (int * int) option]
+    (findi [| 1; 2; 3; 4 |] ~f:(fun i x -> i = 2 * x))
+    ~expect:None
+;;
+
+let%test_unit _ =
+  [%test_result: (int * int) option]
+    (findi [| 1; 2; 1; 4 |] ~f:(fun i x -> i = 2 * x))
+    ~expect:(Some (2, 1))
+;;
+
+let%test_unit _ =
+  [%test_result: int option]
+    (find_mapi [| 0; 5; 2; 1; 4 |] ~f:(fun i x -> if i = x then Some (i + x) else None))
+    ~expect:(Some 0)
+;;
+
+let%test_unit _ =
+  [%test_result: int option]
+    (find_mapi [| 3; 5; 2; 1; 4 |] ~f:(fun i x -> if i = x then Some (i + x) else None))
+    ~expect:(Some 4)
+;;
+
+let%test_unit _ =
+  [%test_result: int option]
+    (find_mapi [| 3; 5; 1; 1; 4 |] ~f:(fun i x -> if i = x then Some (i + x) else None))
+    ~expect:(Some 8)
+;;
+
+let%test_unit _ =
+  [%test_result: int option]
+    (find_mapi [| 3; 5; 1; 1; 2 |] ~f:(fun i x -> if i = x then Some (i + x) else None))
+    ~expect:None
+;;
+
+let%test_unit _ =
+  List.iter
+    ~f:(fun (l, expect) ->
+      let t = of_list l in
+      assert (Poly.equal expect (find_consecutive_duplicate t ~equal:Poly.equal)))
+    [ [], None
+    ; [ 1 ], None
+    ; [ 1; 1 ], Some (1, 1)
+    ; [ 1; 2 ], None
+    ; [ 1; 2; 1 ], None
+    ; [ 1; 2; 2 ], Some (2, 2)
+    ; [ 1; 1; 2; 2 ], Some (1, 1)
+    ]
+;;
+
+let%test_unit _ = [%test_result: int option] (random_element [||]) ~expect:None
+let%test_unit _ = [%test_result: int option] (random_element [| 0 |]) ~expect:(Some 0)
+
+let%test_unit _ =
+  List.iter
+    [ [||]; [| 1 |]; [| 1; 2; 3; 4; 5 |] ]
+    ~f:(fun t -> [%test_result: int array] (Sequence.to_array (to_sequence t)) ~expect:t)
+;;
+
+let test_fold_map array ~init ~f ~expect =
+  [%test_result: int array] (folding_map array ~init ~f) ~expect:(snd expect);
+  [%test_result: int * int array] (fold_map array ~init ~f) ~expect
+;;
+
+let test_fold_mapi array ~init ~f ~expect =
+  [%test_result: int array] (folding_mapi array ~init ~f) ~expect:(snd expect);
+  [%test_result: int * int array] (fold_mapi array ~init ~f) ~expect
+;;
+
+let%test_unit _ =
+  test_fold_map
+    [| 1; 2; 3; 4 |]
+    ~init:0
+    ~f:(fun acc x ->
+      let y = acc + x in
+      y, y)
+    ~expect:(10, [| 1; 3; 6; 10 |])
+;;
+
+let%test_unit _ =
+  test_fold_map
+    [||]
+    ~init:0
+    ~f:(fun acc x ->
+      let y = acc + x in
+      y, y)
+    ~expect:(0, [||])
+;;
+
+let%test_unit _ =
+  test_fold_mapi
+    [| 1; 2; 3; 4 |]
+    ~init:0
+    ~f:(fun i acc x ->
+      let y = acc + (i * x) in
+      y, y)
+    ~expect:(20, [| 0; 2; 8; 20 |])
+;;
+
+let%test_unit _ =
+  test_fold_mapi
+    [||]
+    ~init:0
+    ~f:(fun i acc x ->
+      let y = acc + (i * x) in
+      y, y)
+    ~expect:(0, [||])
+;;
+
+let%test_module "permute" =
+  (module struct
+    module Int_list = struct
+      type t = int list [@@deriving compare, sexp_of]
+
+      include (val Comparator.make ~compare ~sexp_of_t)
+    end
+
+    let test_permute initial_contents ~pos ~len =
+      let all_permutations =
+        let pos, len =
+          Ordered_collection_common.get_pos_len_exn
+            ?pos
+            ?len
+            ~total_length:(List.length initial_contents)
+            ()
+        in
+        let left = List.take initial_contents pos in
+        let middle = List.sub initial_contents ~pos ~len in
+        let right = List.drop initial_contents (pos + len) in
+        Set.of_list
+          (module Int_list)
+          (List_helpers.permutations middle
+           |> List.map ~f:(fun middle -> left @ middle @ right))
+      in
+      let not_yet_seen = ref all_permutations in
+      while not (Set.is_empty !not_yet_seen) do
+        let array = of_list initial_contents in
+        permute ?pos ?len array;
+        let permutation = to_list array in
+        if not (Set.mem all_permutations permutation)
+        then
+          raise_s
+            [%sexp
+              "invalid permutation"
+              , { array_length = (List.length initial_contents : int)
+                ; permutation : int list
+                ; pos : int option
+                ; len : int option
+                }];
+        not_yet_seen := Set.remove !not_yet_seen permutation
+      done
+    ;;
+
+    let%expect_test "permute different array lengths and subranges" =
+      let indices = None :: List.map [ 0; 1; 2; 3; 4 ] ~f:Option.some in
+      for array_length = 0 to 4 do
+        let initial_contents = List.init array_length ~f:Int.succ in
+        List.iter indices ~f:(fun pos ->
+          List.iter indices ~f:(fun len ->
+            match
+              Ordered_collection_common.get_pos_len
+                ?pos
+                ?len
+                ~total_length:array_length
+                ()
+            with
+            | Ok _ -> test_permute initial_contents ~pos ~len
+            | Error _ ->
+              require
+                [%here]
+                (Exn.does_raise (fun () ->
+                   permute ?pos ?len (Array.of_list initial_contents)))))
+      done;
+      [%expect {| |}]
+    ;;
+  end)
+;;
+
+let%expect_test "create_float_uninitialized" =
+  let array = create_float_uninitialized ~len:10 in
+  (* make sure reading/writing the array is safe *)
+  Array.permute array;
+  (* sanity check without depending on specific contents *)
+  print_s [%sexp (Array.length array : int)];
+  [%expect {| 10 |}]
+;;
+
+module Int_array = struct
+  type t = int array [@@deriving equal, sexp_of]
+end
+
+module Int_list = struct
+  type t = int list [@@deriving equal, sexp_of]
+end
+
+let%expect_test "swap" =
+  let array = [| 0; 1; 2; 3 |] in
+  print_s [%sexp (array : int array)];
+  [%expect {| (0 1 2 3) |}];
+  swap array 0 0;
+  print_s [%sexp (array : int array)];
+  [%expect {| (0 1 2 3) |}];
+  swap array 0 3;
+  print_s [%sexp (array : int array)];
+  [%expect {| (3 1 2 0) |}]
+;;
+
+let%expect_test "rev and rev_inplace" =
+  let test ordered_list =
+    let ordered_array = of_list ordered_list in
+    let reversed_array =
+      let array = copy ordered_array in
+      rev_inplace array;
+      array
+    in
+    require_equal
+      [%here]
+      (module Int_list)
+      (to_list reversed_array)
+      (List.rev ordered_list);
+    require_equal [%here] (module Int_array) reversed_array (rev ordered_array);
+    print_s [%sexp (reversed_array : int array)]
+  in
+  test [];
+  [%expect {| () |}];
+  test [ 0 ];
+  [%expect {| (0) |}];
+  test (List.init 10 ~f:Fn.id);
+  [%expect {| (9 8 7 6 5 4 3 2 1 0) |}]
+;;
+
+let%expect_test "map_inplace" =
+  let test list =
+    let f x = x * x in
+    let array = of_list list in
+    map_inplace array ~f;
+    require_equal [%here] (module Int_list) (to_list array) (List.map list ~f);
+    print_s [%sexp (array : int array)]
+  in
+  test [];
+  [%expect {| () |}];
+  test [ 0 ];
+  [%expect {| (0) |}];
+  test (List.init 10 ~f:Fn.id);
+  [%expect {| (0 1 4 9 16 25 36 49 64 81) |}]
+;;
+
+let%expect_test "cartesian_product" =
+  require [%here] (is_empty (cartesian_product [||] [||]));
+  require [%here] (is_empty (cartesian_product [||] [| 13 |]));
+  require [%here] (is_empty (cartesian_product [| 13 |] [||]));
+  print_s [%sexp (cartesian_product [| 1; 2; 3 |] [| "a"; "b" |] : (int * string) array)];
+  [%expect {|
+    ((1 a)
+     (1 b)
+     (2 a)
+     (2 b)
+     (3 a)
+     (3 b))
+    |}]
+;;
+
+let%expect_test "create_local" =
+  let len = 10 in
+  let array = create_local ~len (-1) in
+  for i = 0 to len - 1 do
+    assert (get array i = -1);
+    set array i i
+  done;
+  let array = init len ~f:(fun i -> get array i) in
+  print_s (sexp_of_t sexp_of_int array);
+  [%expect {| (0 1 2 3 4 5 6 7 8 9) |}]
+;;

unikernel/duniverse/base/test/test_array.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_array_local.mlt

@@ -0,0 +1,24 @@
+open! Base
+
+(* first test that we only allow global elements *)
+let local_id (local_ x) = x;;
+
+let k = local_id 42 in
+Array.create_local ~len:10 k
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: This value escapes its region
+|}]
+;;
+
+(* then check that the array is indeed local *)
+let arr = Array.create_local ~len:10 42 in
+ref arr
+
+[%%expect
+  {|
+Line _, characters _-_:
+Error: This value escapes its region
+|}]

unikernel/duniverse/base/test/test_backtrace.ml

@@ -0,0 +1,14 @@
+open! Import
+open! Backtrace
+
+let%test_unit (_ [@tags "no-js"]) =
+  let t = get () in
+  assert (String.length (to_string t) > 0)
+;;
+
+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 {| ("<backtrace elided in test>") |}]
+;;

unikernel/duniverse/base/test/test_backtrace.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_base.ml

@@ -0,0 +1,17 @@
+open! Import
+
+let%expect_test _ =
+  let f x = x * 2 in
+  let g x = x + 3 in
+  print_s [%sexp (f @@ 5 : int)];
+  [%expect {| 10 |}];
+  print_s [%sexp (g @@ f @@ 5 : int)];
+  [%expect {| 13 |}];
+  print_s [%sexp (f @@ g @@ 5 : int)];
+  [%expect {| 16 |}]
+;;
+
+let%expect_test "exp is present at the toplevel" =
+  print_s [%sexp (2 ** 8 : int)];
+  [%expect {| 256 |}]
+;;

unikernel/duniverse/base/test/test_base.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/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]
+    |}]
+;;

unikernel/duniverse/base/test/test_base_containers_mono.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_base_containers_poly.ml

@@ -0,0 +1,227 @@
+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)
+
+(* Quickcheck-based expect tests *)
+
+let%expect_test "Array" =
+  Base_container_tests.test_indexed_container_s1_with_creators
+    (module struct
+      include Array
+
+      type 'a t = 'a array [@@deriving quickcheck]
+
+      (* [Array.concat] has a slightly different type than S1 expects *)
+      let concat array = concat (Array.to_list array)
+    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]
+    |}]
+;;
+
+let%expect_test "List" =
+  Base_container_tests.test_indexed_container_s1_with_creators
+    (module struct
+      include List
+
+      type 'a t = 'a list [@@deriving quickcheck]
+    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]
+    |}]
+;;
+
+let%expect_test "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 Set
+
+      type t = Set.M(Int).t [@@deriving sexp_of]
+
+      let quickcheck_generator = Generator.set_t_m (module Elt) Elt.quickcheck_generator
+      let quickcheck_observer = Observer.set_t Elt.quickcheck_observer
+      let quickcheck_shrinker = Shrinker.set_t Elt.quickcheck_shrinker
+      let min_elt t ~compare:_ = min_elt t
+      let max_elt t ~compare:_ = max_elt t
+
+      (* [find] and [find_map] use pre-order traversals (root -> left -> right), while all
+         the other traversals are in-order (left -> root -> right). We patch them up here
+         to behave like pre-order, while still using [Set.find] and [Set.find_map] for the
+         searching so we're actually testing those functions. *)
+
+      let rec find t ~f =
+        match Set.find t ~f with
+        | None -> None
+        | Some elt as some ->
+          let lt, _ = Set.split_lt_ge t elt in
+          Option.first_some (find lt ~f) some
+      ;;
+
+      let rec find_map t ~f =
+        match Set.find_map t ~f:(fun elt -> Option.map (f elt) ~f:(fun x -> elt, x)) with
+        | None -> None
+        | Some (elt, x) ->
+          let lt, _ = Set.split_lt_ge t elt in
+          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 "Queue" =
+  Base_container_tests.test_indexed_container_s1
+    (module struct
+      include Queue
+      open Base_quickcheck
+
+      let quickcheck_generator quickcheck_generator_elt =
+        [%generator: elt list] |> Generator.map ~f:Queue.of_list
+      ;;
+
+      let quickcheck_observer quickcheck_observer_elt =
+        [%observer: elt list] |> Observer.unmap ~f:Queue.to_list
+      ;;
+
+      let quickcheck_shrinker quickcheck_shrinker_elt =
+        [%shrinker: elt list] |> Shrinker.map ~f:Queue.of_list ~f_inverse:Queue.to_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 [foldi]
+    Container: testing [iteri]
+    Container: testing [existsi]
+    Container: testing [for_alli]
+    Container: testing [counti]
+    Container: testing [findi]
+    Container: testing [find_mapi]
+    |}]
+;;

unikernel/duniverse/base/test/test_base_containers_poly.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_base_stack.ml

@@ -0,0 +1,22 @@
+open! Import
+open Stack
+include Test_container.Test_S1 (Stack)
+include Test_stack.Test (Test_stack.Debug (Stack))
+
+let capacity = capacity
+let set_capacity = set_capacity
+
+let%test_unit _ =
+  let t = create () in
+  [%test_result: int] (capacity t) ~expect:0;
+  set_capacity t (-1);
+  [%test_result: int] (capacity t) ~expect:0;
+  set_capacity t 10;
+  [%test_result: int] (capacity t) ~expect:10;
+  set_capacity t 0;
+  [%test_result: int] (capacity t) ~expect:0;
+  push t ();
+  set_capacity t 0;
+  [%test_result: int] (length t) ~expect:1;
+  [%test_pred: int] (fun c -> c >= 1) (capacity t)
+;;

unikernel/duniverse/base/test/test_base_stack.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_blit.ml

@@ -0,0 +1,89 @@
+open! Import
+open! Blit
+
+(* This unit test checks that when [blit] calls [unsafe_blit], the slices are valid.
+   It also checks that [blit] doesn't call [unsafe_blit] when there is a range error. *)
+let%test_module _ =
+  (module struct
+    let blit_was_called = ref false
+    let slices_are_valid = ref (Ok ())
+
+    module B = Make (struct
+      type t = bool array
+
+      let create ~len = Array.create false ~len
+      let length = Array.length
+
+      let unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len =
+        blit_was_called := true;
+        slices_are_valid
+          := Or_error.try_with (fun () ->
+               assert (len >= 0);
+               assert (src_pos >= 0);
+               assert (src_pos + len <= Array.length src);
+               assert (dst_pos >= 0);
+               assert (dst_pos + len <= Array.length dst));
+        Array.blit ~src ~src_pos ~dst ~dst_pos ~len
+      ;;
+    end)
+
+    let%test_module "Bool" =
+      (module Test_blit.Test
+                (struct
+                  type t = bool
+
+                  let equal = Bool.equal
+                  let of_bool = Fn.id
+                end)
+                (struct
+                  type t = bool array [@@deriving sexp_of]
+
+                  let create ~len = Array.create false ~len
+                  let length = Array.length
+                  let get = Array.get
+                  let set = Array.set
+                end)
+                (B))
+    ;;
+
+    let%test_unit _ =
+      let opts = [ None; Some (-1); Some 0; Some 1; Some 2 ] in
+      List.iter [ 0; 1; 2 ] ~f:(fun src ->
+        List.iter [ 0; 1; 2 ] ~f:(fun dst ->
+          List.iter opts ~f:(fun src_pos ->
+            List.iter opts ~f:(fun src_len ->
+              List.iter opts ~f:(fun dst_pos ->
+                try
+                  let check f =
+                    blit_was_called := false;
+                    slices_are_valid := Ok ();
+                    match Or_error.try_with f with
+                    | Error _ -> assert (not !blit_was_called)
+                    | Ok () -> ok_exn !slices_are_valid
+                  in
+                  check (fun () ->
+                    B.blito
+                      ~src:(Array.create ~len:src false)
+                      ?src_pos
+                      ?src_len
+                      ~dst:(Array.create ~len:dst false)
+                      ?dst_pos
+                      ());
+                  check (fun () ->
+                    ignore
+                      (B.subo (Array.create ~len:src false) ?pos:src_pos ?len:src_len
+                        : bool array))
+                with
+                | exn ->
+                  raise_s
+                    [%message
+                      "failure"
+                        (exn : exn)
+                        (src : int)
+                        (src_pos : int option)
+                        (src_len : int option)
+                        (dst : int)
+                        (dst_pos : int option)])))))
+    ;;
+  end)
+;;

unikernel/duniverse/base/test/test_blit.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_bool.ml

@@ -0,0 +1,47 @@
+open! Import
+
+let%expect_test "hash coherence" =
+  check_hash_coherence [%here] (module Bool) [ false; true ];
+  [%expect {| |}]
+;;
+
+let%expect_test "Bool.Non_short_circuiting.(||)" =
+  let ( || ) = Bool.Non_short_circuiting.( || ) in
+  assert (true || true);
+  assert (true || false);
+  assert (false || true);
+  assert (not (false || false));
+  assert (
+    true
+    ||
+    (print_endline "rhs";
+     true));
+  [%expect {| rhs |}];
+  assert (
+    false
+    ||
+    (print_endline "rhs";
+     true));
+  [%expect {| rhs |}]
+;;
+
+let%expect_test "Bool.Non_short_circuiting.(&&)" =
+  let ( && ) = Bool.Non_short_circuiting.( && ) in
+  assert (true && true);
+  assert (not (true && false));
+  assert (not (false && true));
+  assert (not (false && false));
+  assert (
+    true
+    &&
+    (print_endline "rhs";
+     true));
+  [%expect {| rhs |}];
+  assert (
+    not
+      (false
+       &&
+       (print_endline "rhs";
+        true)));
+  [%expect {| rhs |}]
+;;

unikernel/duniverse/base/test/test_bool.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_bytes.ml

@@ -0,0 +1,106 @@
+open! Import
+open! Bytes
+
+let%test_module "Blit" =
+  (module Test_blit.Test
+            (struct
+              include Char
+
+              let of_bool b = if b then 'a' else 'b'
+            end)
+            (struct
+              include Bytes
+
+              let create ~len = create len
+            end)
+            (Bytes))
+;;
+
+let%expect_test "local" =
+  let bytes = Bytes.create_local 10 in
+  printf "%d\n" (Bytes.length bytes);
+  [%expect {| 10 |}];
+  for i = 0 to 9 do
+    Bytes.set bytes i (Int.to_string i).[0]
+  done;
+  let string = Bytes.unsafe_to_string ~no_mutation_while_string_reachable:bytes in
+  for i = 0 to 9 do
+    printf "%c" string.[i]
+  done;
+  [%expect {| 0123456789 |}];
+  Expect_test_helpers_base.require_does_raise [%here] (fun () ->
+    ignore (Bytes.create_local (Sys.max_string_length + 1) : Bytes.t));
+  [%expect {| (Invalid_argument Bytes.create_local) |}]
+;;
+
+let%test_module "Unsafe primitives" =
+  (module struct
+    let%expect_test "16-bit primitives" =
+      let buffer = create 10 in
+      (* Ensure that writing the biggest possible 16-bit value works. *)
+      Bytes.unsafe_set_int16 buffer 2 0xFFFF;
+      printf "0x%04x" (Bytes.unsafe_get_int16 buffer 2);
+      [%expect {| 0xffff |}];
+      (* Ensure that [16-bit] operations are indeed 16-bit, meaning it doesn't affect
+         anything other than x[pos] and x[pos + 1]. *)
+      Bytes.unsafe_set_int16 buffer 4 0;
+      Bytes.unsafe_set_int16 buffer 2 ((1 lsl 16) + 1);
+      printf "0x%04x" (Bytes.unsafe_get_int16 buffer 2);
+      [%expect {| 0x0001 |}];
+      printf "0x%04x" (Bytes.unsafe_get_int16 buffer 4);
+      [%expect {| 0x0000 |}]
+    ;;
+
+    let%expect_test "32-bit primitives" =
+      let buffer = create 10 in
+      Bytes.unsafe_set_int32 buffer 0 0xdeadbeefl;
+      printf "%lx" (Bytes.unsafe_get_int32 buffer 0);
+      [%expect {| deadbeef |}];
+      (* Ensure that Bytes.get will retrieve the individual positions byte values as
+         written by Bytes.unsafe_set_int32. *)
+      for i = 0 to 3 do
+        let chr = Bytes.get buffer i in
+        printf "buffer[%d] = 0x%02x\n" i (Char.to_int chr)
+      done;
+      [%expect
+        {|
+        buffer[0] = 0xef
+        buffer[1] = 0xbe
+        buffer[2] = 0xad
+        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);
+      [%expect {| 178293 |}]
+    ;;
+
+    let%expect_test "64-bit primitives" =
+      let buffer = create 10 in
+      Bytes.unsafe_set_int64 buffer 0 0x12345678_deadbeefL;
+      printf "%Lx" (Bytes.unsafe_get_int64 buffer 0);
+      [%expect {| 12345678deadbeef |}];
+      (* Ensure that Bytes.get will retrieve the individual positions byte values as
+         written by Bytes.unsafe_set_int64. *)
+      for i = 0 to 7 do
+        let chr = Bytes.get buffer i in
+        printf "buffer[%d] = 0x%02x\n" i (Char.to_int chr)
+      done;
+      [%expect
+        {|
+        buffer[0] = 0xef
+        buffer[1] = 0xbe
+        buffer[2] = 0xad
+        buffer[3] = 0xde
+        buffer[4] = 0x78
+        buffer[5] = 0x56
+        buffer[6] = 0x34
+        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);
+      [%expect {| 12345678deadbeef |}]
+    ;;
+  end)
+;;

unikernel/duniverse/base/test/test_bytes.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_char.ml

@@ -0,0 +1,160 @@
+open! Import
+open! Char
+
+let%test _ = not (is_whitespace '\008')
+
+(* backspace *)
+let%test _ = is_whitespace '\009'
+
+(* '\t': horizontal tab *)
+let%test _ = is_whitespace '\010'
+
+(* '\n': line feed *)
+let%test _ = is_whitespace '\011'
+
+(* '\v': vertical tab *)
+let%test _ = is_whitespace '\012'
+
+(* '\f': form feed *)
+let%test _ = is_whitespace '\013'
+
+(* '\r': carriage return *)
+let%test _ = not (is_whitespace '\014')
+
+(* shift out *)
+let%test _ = is_whitespace '\032'
+
+(* space *)
+
+let%expect_test "hash coherence" =
+  check_hash_coherence [%here] (module Char) [ min_value; 'a'; max_value ];
+  [%expect {| |}]
+;;
+
+let%test_module "int to char conversion" =
+  (module struct
+    let%test_unit "of_int bounds" =
+      let bounds_check i =
+        [%test_result: t option] (of_int i) ~expect:None ~message:(Int.to_string i)
+      in
+      for i = 1 to 100 do
+        bounds_check (-i);
+        bounds_check (255 + i)
+      done
+    ;;
+
+    let%test_unit "of_int_exn vs of_int" =
+      for i = -100 to 300 do
+        [%test_eq: t option]
+          (of_int i)
+          (Option.try_with (fun () -> of_int_exn i))
+          ~message:(Int.to_string i)
+      done
+    ;;
+
+    let%test_unit "unsafe_of_int vs of_int_exn" =
+      for i = 0 to 255 do
+        [%test_eq: t] (unsafe_of_int i) (of_int_exn i) ~message:(Int.to_string i)
+      done
+    ;;
+  end)
+;;
+
+let%expect_test "all" =
+  Ref.set_temporarily sexp_style To_string_hum ~f:(fun () ->
+    print_s [%sexp (all : t list)]);
+  [%expect
+    {|
+    ("\000" "\001" "\002" "\003" "\004" "\005" "\006" "\007" "\b" "\t" "\n"
+     "\011" "\012" "\r" "\014" "\015" "\016" "\017" "\018" "\019" "\020" "\021"
+     "\022" "\023" "\024" "\025" "\026" "\027" "\028" "\029" "\030" "\031" " " !
+     "\"" # $ % & ' "(" ")" * + , - . / 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 { | } ~ "\127" "\128" "\129" "\130"
+     "\131" "\132" "\133" "\134" "\135" "\136" "\137" "\138" "\139" "\140" "\141"
+     "\142" "\143" "\144" "\145" "\146" "\147" "\148" "\149" "\150" "\151" "\152"
+     "\153" "\154" "\155" "\156" "\157" "\158" "\159" "\160" "\161" "\162" "\163"
+     "\164" "\165" "\166" "\167" "\168" "\169" "\170" "\171" "\172" "\173" "\174"
+     "\175" "\176" "\177" "\178" "\179" "\180" "\181" "\182" "\183" "\184" "\185"
+     "\186" "\187" "\188" "\189" "\190" "\191" "\192" "\193" "\194" "\195" "\196"
+     "\197" "\198" "\199" "\200" "\201" "\202" "\203" "\204" "\205" "\206" "\207"
+     "\208" "\209" "\210" "\211" "\212" "\213" "\214" "\215" "\216" "\217" "\218"
+     "\219" "\220" "\221" "\222" "\223" "\224" "\225" "\226" "\227" "\228" "\229"
+     "\230" "\231" "\232" "\233" "\234" "\235" "\236" "\237" "\238" "\239" "\240"
+     "\241" "\242" "\243" "\244" "\245" "\246" "\247" "\248" "\249" "\250" "\251"
+     "\252" "\253" "\254" "\255")
+    |}]
+;;
+
+let%expect_test "predicates" =
+  Ref.set_temporarily sexp_style To_string_hum ~f:(fun () ->
+    print_s [%sexp (List.filter all ~f:is_digit : t list)];
+    [%expect {| (0 1 2 3 4 5 6 7 8 9) |}];
+    print_s [%sexp (List.filter all ~f:is_lowercase : t list)];
+    [%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) |}];
+    print_s [%sexp (List.filter all ~f:is_uppercase : t list)];
+    [%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) |}];
+    print_s [%sexp (List.filter all ~f:is_alpha : t list)];
+    [%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)
+      |}];
+    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)
+      |}];
+    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 { | } ~)
+      |}];
+    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)];
+    [%expect {| (0 1 2 3 4 5 6 7 8 9 A B C D E F a b c d e f) |}];
+    print_s [%sexp (List.filter all ~f:is_hex_digit_lower : t list)];
+    [%expect {| (0 1 2 3 4 5 6 7 8 9 a b c d e f) |}];
+    print_s [%sexp (List.filter all ~f:is_hex_digit_upper : t list)];
+    [%expect {| (0 1 2 3 4 5 6 7 8 9 A B C D E F) |}])
+;;
+
+let%expect_test "get_hex_digit" =
+  Ref.set_temporarily sexp_style To_string_hum ~f:(fun () ->
+    let hex_digit_alist =
+      List.filter_map Char.all ~f:(fun char ->
+        Option.map (get_hex_digit char) ~f:(fun digit -> char, digit))
+    in
+    print_s [%sexp (hex_digit_alist : (char * int) list)];
+    [%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))
+      |}];
+    require_equal
+      [%here]
+      (module struct
+        type t = (char * int) list [@@deriving equal, sexp_of]
+      end)
+      (Char.all
+       |> List.filter ~f:is_hex_digit
+       |> List.map ~f:(fun char -> char, get_hex_digit_exn char))
+      hex_digit_alist;
+    [%expect {| |}];
+    require_does_raise [%here] (fun () -> get_hex_digit_exn Char.min_value);
+    [%expect {| ("Char.get_hex_digit_exn: not a hexadecimal digit" (char "\000")) |}])
+;;
+
+let%test_module "Caseless Comparable" =
+  (module struct
+    (* examples from docs *)
+    let%test _ = Caseless.equal 'A' 'a'
+    let%test _ = Caseless.('a' < 'B')
+    let%test _ = Int.( <> ) (Caseless.compare 'a' 'B') (compare 'a' 'B')
+    let%test _ = List.is_sorted ~compare:Caseless.compare [ 'A'; 'b'; 'C' ]
+  end)
+;;

unikernel/duniverse/base/test/test_char.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_clz_ctz.ml

@@ -0,0 +1,112 @@
+open! Import
+
+module E = struct
+  type t =
+    { clz : int
+    ; ctz : int
+    }
+  [@@deriving compare, sexp_of]
+end
+
+module type T = sig
+  type t [@@deriving sexp_of]
+
+  val one : t
+  val ( lsl ) : t -> int -> t
+  val clz : t -> int
+  val ctz : t -> int
+  val num_bits : int
+end
+
+module Make (Int : T) = struct
+  let%expect_test "one-hot" =
+    let clz_and_ctz int = { E.clz = Int.clz int; ctz = Int.ctz int } in
+    for i = 0 to Int.num_bits - 1 do
+      [%test_result: E.t]
+        ~expect:{ E.clz = Int.num_bits - 1 - i; ctz = i }
+        (clz_and_ctz Int.(one lsl i))
+    done
+  ;;
+end
+
+include Make (Nativeint)
+include Make (Int63)
+include Make (Int63.Private.Emul)
+
+include Make (struct
+  include Int
+
+  let%expect_test "zero" =
+    (* [clz 0] is guaranteed to be num_bits for int. We compute clz on the tagged
+         representation of int's, and the binary representation of the int [0] is
+         num_bits 0's followed by a 1 (the tag bit). *)
+    [%test_result: int] ~expect:num_bits (clz 0)
+  ;;
+
+  (* [ctz 0] is unspecified. On linux it seems to be stable and equal to the system
+       word size (which is num_bits + 1).
+       ran 2019-02-11 on linux:
+       {v
+        [%test_result: int] ~expect:(num_bits + 1) (ctz 0)
+       v}
+
+       in javascript, it is 32 (which is num_bits):
+       ran 2019-02-11 on javascript:
+       {v
+        [%test_result: int] ~expect:(num_bits) (ctz 0)
+       v}
+    *)
+end)
+
+include Make (struct
+  include Int32
+
+  let clz_and_ctz i32 = { E.clz = clz i32; ctz = ctz i32 }
+
+  let%expect_test "extra examples" =
+    [%test_result: E.t] ~expect:{ clz = 31; ctz = 0 } (clz_and_ctz 0b1l);
+    [%test_result: E.t] ~expect:{ clz = 30; ctz = 1 } (clz_and_ctz 0b10l);
+    [%test_result: E.t] ~expect:{ clz = 30; ctz = 0 } (clz_and_ctz 0b11l);
+    [%test_result: E.t] ~expect:{ clz = 25; ctz = 1 } (clz_and_ctz 0b1000010l);
+    [%test_result: E.t]
+      ~expect:{ clz = 8; ctz = 6 }
+      (clz_and_ctz 0b100000010000001001000000l);
+    [%test_result: E.t]
+      ~expect:{ clz = 0; ctz = 31 }
+      (clz_and_ctz 0b10000000000000000000000000000000l);
+    [%test_result: E.t]
+      ~expect:{ clz = 9; ctz = 6 }
+      (clz_and_ctz 0b00000000010000000100000001000000l);
+    [%test_result: E.t]
+      ~expect:{ clz = 0; ctz = 6 }
+      (clz_and_ctz 0b10000000010000000100000001000000l)
+  ;;
+end)
+
+include Make (struct
+  include Int64
+
+  let clz_and_ctz i64 = { E.clz = clz i64; ctz = ctz i64 }
+
+  let%expect_test "extra examples" =
+    [%test_result: E.t] ~expect:{ clz = 63; ctz = 0 } (clz_and_ctz 0b1L);
+    [%test_result: E.t] ~expect:{ clz = 62; ctz = 1 } (clz_and_ctz 0b10L);
+    [%test_result: E.t] ~expect:{ clz = 62; ctz = 0 } (clz_and_ctz 0b11L);
+    [%test_result: E.t] ~expect:{ clz = 57; ctz = 1 } (clz_and_ctz 0b1000010L);
+    [%test_result: E.t]
+      ~expect:{ clz = 40; ctz = 6 }
+      (clz_and_ctz 0b100000010000001001000000L);
+    [%test_result: E.t]
+      ~expect:{ clz = 0; ctz = 63 }
+      (clz_and_ctz 0b1000000000000000000000000000000000000000000000000000000000000000L);
+    [%test_result: E.t]
+      ~expect:{ clz = 32; ctz = 31 }
+      (clz_and_ctz 0b0000000000000000000000000000000010000000000000000000000000000000L);
+    [%test_result: E.t]
+      ~expect:{ clz = 32; ctz = 6 }
+      (clz_and_ctz 0b0000000000000000000000000000000010000000010000000100000001000000L);
+    [%test_result: E.t]
+      ~expect:{ clz = 33; ctz = 6 }
+      (clz_and_ctz 0b0000000000000000000000000000000001000000010000000100000001000000L)
+  ;;
+end)

unikernel/duniverse/base/test/test_clz_ctz.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_compare.ml

@@ -0,0 +1,176 @@
+open! Base
+open Expect_test_helpers_base
+
+module type S = sig
+  type t [@@deriving sexp_of]
+
+  include Comparable.Comparisons with type t := t
+end
+
+(* Test the consistency of derived comparison operators with [compare] because many of
+   them are hand-optimized in [Base]. *)
+let test (type a) here (module T : S with type t = a) list =
+  let op (type b) (module Result : S with type t = b) operator ~actual ~expect =
+    With_return.with_return (fun failed ->
+      List.iter list ~f:(fun arg1 ->
+        List.iter list ~f:(fun arg2 ->
+          let actual = actual arg1 arg2 in
+          let expect = expect arg1 arg2 in
+          if not (Result.compare actual expect = 0)
+          then (
+            print_cr
+              here
+              [%message
+                "comparison failed"
+                  (operator : string)
+                  (arg1 : T.t)
+                  (arg2 : T.t)
+                  (actual : Result.t)
+                  (expect : Result.t)];
+            failed.return ()))))
+  in
+  let module C = Comparable.Make (T) in
+  op (module Bool) "equal" ~actual:T.equal ~expect:C.equal;
+  op (module T) "min" ~actual:T.min ~expect:C.min;
+  op (module T) "max" ~actual:T.max ~expect:C.max;
+  op (module Bool) "(=)" ~actual:T.( = ) ~expect:C.( = );
+  op (module Bool) "(<)" ~actual:T.( < ) ~expect:C.( < );
+  op (module Bool) "(>)" ~actual:T.( > ) ~expect:C.( > );
+  op (module Bool) "(<>)" ~actual:T.( <> ) ~expect:C.( <> );
+  op (module Bool) "(<=)" ~actual:T.( <= ) ~expect:C.( <= );
+  op (module Bool) "(>=)" ~actual:T.( >= ) ~expect:C.( >= );
+  op
+    (module Bool)
+    "Comparable.equal"
+    ~actual:(fun a b -> Comparable.equal T.compare a b)
+    ~expect:C.equal;
+  op
+    (module T)
+    "Comparable.min"
+    ~actual:(fun a b -> Comparable.min T.compare a b)
+    ~expect:C.min;
+  op
+    (module T)
+    "Comparable.max"
+    ~actual:(fun a b -> Comparable.max T.compare a b)
+    ~expect:C.max
+;;
+
+let%expect_test "Base" =
+  test
+    [%here]
+    (module struct
+      include Base
+
+      type t = int [@@deriving sexp_of]
+    end)
+    Int.[ min_value; minus_one; zero; one; max_value ];
+  [%expect {| |}]
+;;
+
+let%expect_test "Unit" =
+  test [%here] (module Unit) Unit.all;
+  [%expect {| |}]
+;;
+
+let%expect_test "Bool" =
+  test [%here] (module Bool) Bool.all;
+  [%expect {| |}]
+;;
+
+let%expect_test "Char" =
+  test [%here] (module Char) Char.all;
+  [%expect {| |}]
+;;
+
+let%expect_test "Float" =
+  test [%here] (module Float) Float.[ min_value; minus_one; zero; one; max_value ];
+  [%expect {| |}]
+;;
+
+let%expect_test "Int" =
+  test [%here] (module Int) Int.[ min_value; minus_one; zero; one; max_value ];
+  [%expect {| |}]
+;;
+
+let%expect_test "Int32" =
+  test [%here] (module Int32) Int32.[ min_value; minus_one; zero; one; max_value ];
+  [%expect {| |}]
+;;
+
+let%expect_test "Int64" =
+  test [%here] (module Int64) Int64.[ min_value; minus_one; zero; one; max_value ];
+  [%expect {| |}]
+;;
+
+let%expect_test "Nativeint" =
+  test [%here] (module Nativeint) Nativeint.[ min_value; minus_one; zero; one; max_value ];
+  [%expect {| |}]
+;;
+
+let%expect_test "Int63" =
+  test [%here] (module Int63) Int63.[ min_value; minus_one; zero; one; max_value ];
+  [%expect {| |}]
+;;
+
+let%test_module "lexicographic" =
+  (module struct
+    let%expect_test "single" =
+      Ref.set_temporarily sexp_style To_string_hum ~f:(fun () ->
+        List.iter
+          [ 1, 2; 1, 1; 2, 1 ]
+          ~f:(fun (a, b) ->
+            let ordering = Ordering.of_int (compare a b) in
+            print_s [%message (a : int) (b : int) (ordering : Ordering.t)];
+            require_equal
+              [%here]
+              (module Ordering)
+              (Ordering.of_int (compare a b))
+              (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))
+          |}])
+    ;;
+
+    let%expect_test "three comparisons" =
+      Ref.set_temporarily sexp_style To_string_hum ~f:(fun () ->
+        let compare_first_three_elts a_1 b_1 =
+          Comparable.lexicographic
+            (List.init 3 ~f:(fun i a b -> compare a.(i) b.(i)))
+            a_1
+            b_1
+        in
+        let test a b =
+          let a = Array.of_list a in
+          let b = Array.of_list b in
+          let ordering = Ordering.of_int (compare_first_three_elts a b) in
+          print_s [%message (a : int array) (b : int array) (ordering : Ordering.t)]
+        in
+        test [ 1; 2; 3; 4 ] [ 1; 2; 4; 9 ];
+        [%expect {| ((a (1 2 3 4)) (b (1 2 4 9)) (ordering Less)) |}];
+        test [ 1; 2; 3; 4 ] [ 1; 2; 3; 9 ];
+        [%expect {| ((a (1 2 3 4)) (b (1 2 3 9)) (ordering Equal)) |}];
+        test [ 1; 2; 3; 4 ] [ 1; 1; 4; 9 ];
+        [%expect {| ((a (1 2 3 4)) (b (1 1 4 9)) (ordering Greater)) |}])
+    ;;
+  end)
+;;
+
+let%expect_test "reversed" =
+  let list = [ 3; 1; 4; 1; 5; 9; 2; 6; 5; 3; 5; 9 ] in
+  let sort_asc1 = List.sort ~compare:[%compare: int] list in
+  let sort_desc = List.sort ~compare:[%compare: int Comparable.reversed] list in
+  let sort_asc2 =
+    List.sort ~compare:[%compare: int Comparable.reversed Comparable.reversed] list
+  in
+  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)))
+    |}]
+;;

unikernel/duniverse/base/test/test_compare.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_container_module_types.ml

@@ -0,0 +1,227 @@
+(** This file tests the consistency of [Container] and [Indexed_container] module types.
+
+    We compare each module type S to the most generic version G that exports the same set
+    of values. We create a module type I by instantiating G to mimic S, such as by
+    dropping a type parameter. We then test that S = I by writing two identity functors,
+    one from S to I and one from I to S. *)
+
+open! Base
+
+module _ : module type of Container = struct
+  (* The most generic interface that everything else implements. *)
+  module type Generic = Container.Generic
+
+  (* The generic interface with creator functions. Ensure it implements Generic. *)
+  module type Generic_with_creators = Container.Generic_with_creators
+
+  module _ (M : Container.Generic_with_creators) : Container.Generic = M
+
+  (* Ensure that S0 is Generic with no type arguments. *)
+  module type S0 = Container.S0
+
+  open struct
+    module type Generic0 = sig
+      type elt
+      type t
+
+      include Generic with type _ elt := elt and type (_, _, _) t := t
+
+      val mem : t -> elt -> bool
+    end
+  end
+
+  module _ (M : S0) : Generic0 = M
+  module _ (M : Generic0) : S0 = M
+
+  (* Ensure that S0_phantom is Generic with a fixed element type. *)
+  module type S0_phantom = Container.S0_phantom
+
+  open struct
+    module type Generic0_phantom = sig
+      type elt
+      type _ t
+
+      include Container.Generic with type _ elt := elt and type (_, 'p, _) t := 'p t
+
+      val mem : _ t -> elt -> bool
+    end
+  end
+
+  module _ (M : S0_phantom) : Generic0_phantom = M
+  module _ (M : Generic0_phantom) : S0_phantom = M
+
+  (* Ensure that S0_with_creators is Generic_with_creators with no type arguments. *)
+  module type S0_with_creators = Container.S0_with_creators
+
+  open struct
+    module type Generic0_with_creators = sig
+      type elt
+      type t
+
+      include
+        Generic_with_creators
+          with type _ elt := elt
+           and type (_, _, _) t := t
+           and type ('a, _, _) concat := 'a list
+
+      val mem : t -> elt -> bool
+    end
+  end
+
+  module _ (M : S0_with_creators) : Generic0_with_creators = M
+  module _ (M : Generic0_with_creators) : S0_with_creators = M
+
+  (* Ensure that S1 is Generic with no phantom type. *)
+  module type S1 = Container.S1
+
+  open struct
+    module type Generic1 = sig
+      type _ t
+
+      include Container.Generic with type 'a elt := 'a and type ('a, _, _) t := 'a t
+    end
+  end
+
+  module _ (M : S1) : Generic1 = M
+  module _ (M : Generic1) : S1 = M
+
+  (* Ensure that S1_phantom is Generic with a covariant phantom type. *)
+  module type S1_phantom = Container.S1_phantom
+
+  open struct
+    module type Generic1_phantom = sig
+      type (_, _) t
+
+      include Generic with type 'a elt := 'a and type ('a, 'p, _) t := ('a, 'p) t
+    end
+  end
+
+  module _ (M : S1_phantom) : Generic1_phantom = M
+  module _ (M : Generic1_phantom) : S1_phantom = M
+
+  (* Ensure that S1_with_creators is Generic_with_creators with no phantom type. *)
+  module type S1_with_creators = Container.S1_with_creators
+
+  open struct
+    module type Generic1_with_creators = sig
+      type 'a t
+
+      include
+        Generic_with_creators
+          with type 'a elt := 'a
+           and type ('a, _, _) t := 'a t
+           and type ('a, _, _) concat := 'a t
+    end
+  end
+
+  module _ (M : S1_with_creators) : Generic1_with_creators = M
+  module _ (M : Generic1_with_creators) : S1_with_creators = M
+
+  (* Other definitions that we are not testing: *)
+
+  module Continue_or_stop = Container.Continue_or_stop
+  module Make = Container.Make
+  module Make0 = Container.Make0
+  module Make_gen = Container.Make_gen
+  module Make_with_creators = Container.Make_with_creators
+  module Make0_with_creators = Container.Make0_with_creators
+  module Make_gen_with_creators = Container.Make_gen_with_creators
+
+  module type Derived = Container.Derived
+  module type Summable = Container.Summable
+
+  include (Container : Derived)
+end
+
+module _ : module type of Indexed_container = struct
+  (* The generic interface everything else implements. *)
+  module type Generic = Indexed_container.Generic
+
+  (* Ensure that S0 is Generic without type parameters. *)
+  module type S0 = Indexed_container.S0
+
+  open struct
+    module type Generic0 = sig
+      type elt
+      type t
+
+      include Generic with type _ elt := elt and type (_, _, _) t := t
+
+      val mem : t -> elt -> bool
+    end
+  end
+
+  module _ (M : S0) : Generic0 = M
+  module _ (M : Generic0) : S0 = M
+
+  (* Ensure that S1 is Generic without an abstract element type. *)
+  module type S1 = Indexed_container.S1
+
+  open struct
+    module type Generic1 = sig
+      type 'a t
+
+      include Generic with type 'a elt := 'a and type ('a, _, _) t := 'a t
+    end
+  end
+
+  module _ (M : S1) : Generic1 = M
+  module _ (M : Generic1) : S1 = M
+
+  (* Ensure that Generic_with_creators includes Generic. *)
+  module type Generic_with_creators = Indexed_container.Generic_with_creators
+
+  module _ (M : Indexed_container.Generic_with_creators) : Indexed_container.Generic = M
+
+  (* Ensure that S0_with_creators is Generic_with_creators with no type arguments. *)
+  module type S0_with_creators = Indexed_container.S0_with_creators
+
+  open struct
+    module type Generic0_with_creators = sig
+      type elt
+      type t
+
+      include
+        Generic_with_creators
+          with type _ elt := elt
+           and type (_, _, _) t := t
+           and type ('a, _, _) concat := 'a list
+
+      val mem : t -> elt -> bool
+    end
+  end
+
+  module _ (M : S0_with_creators) : Generic0_with_creators = M
+  module _ (M : Generic0_with_creators) : S0_with_creators = M
+
+  (* Ensure that S1_with_creators is Generic_with_creators with no phantom type. *)
+  module type S1_with_creators = Indexed_container.S1_with_creators
+
+  open struct
+    module type Generic1_with_creators = sig
+      type 'a t
+
+      include
+        Generic_with_creators
+          with type 'a elt := 'a
+           and type ('a, _, _) t := 'a t
+           and type ('a, _, _) concat := 'a t
+    end
+  end
+
+  module _ (M : S1_with_creators) : Generic1_with_creators = M
+  module _ (M : Generic1_with_creators) : S1_with_creators = M
+
+  (* Other definitions that we are not testing: *)
+
+  module Make = Indexed_container.Make
+  module Make0 = Indexed_container.Make0
+  module Make_gen = Indexed_container.Make_gen
+  module Make_with_creators = Indexed_container.Make_with_creators
+  module Make0_with_creators = Indexed_container.Make0_with_creators
+  module Make_gen_with_creators = Indexed_container.Make_gen_with_creators
+
+  module type Derived = Indexed_container.Derived
+
+  include (Indexed_container : Derived)
+end

unikernel/duniverse/base/test/test_container_module_types.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_dictionary_module_types.ml

@@ -0,0 +1,225 @@
+(** This file tests the consistency of [Dictionary_immutable] module types.
+
+    We compare each module type S to the most generic version G that exports the same set
+    of values. We create a module type I by instantiating G to mimic S, such as by
+    dropping a type parameter. We then test that S = I by writing two identity functors,
+    one from S to I and one from I to S. *)
+
+open! Base
+
+module _ : module type of Dictionary_immutable = struct
+  (* The generic interface for accessors. *)
+  module type Accessors = Dictionary_immutable.Accessors
+
+  (* Ensure that Accessors1 is Accessors with only a data type argument. *)
+  module type Accessors1 = Dictionary_immutable.Accessors1
+
+  open struct
+    module type Accessors_instance1 = sig
+      type key
+      type 'data t
+
+      include
+        Accessors
+          with type _ key := key
+           and type (_, 'data, _) t := 'data t
+           and type ('fn, _, _, _) accessor := 'fn
+    end
+  end
+
+  module _ (M : Accessors1) : Accessors_instance1 = M
+  module _ (M : Accessors_instance1) : Accessors1 = M
+
+  (* Ensure that Accessors2 is Accessors with no phantom type argument. *)
+  module type Accessors2 = Dictionary_immutable.Accessors2
+
+  open struct
+    module type Accessors_instance2 = sig
+      type ('key, 'data) t
+      type ('fn, 'key, 'data) accessor
+
+      include
+        Accessors
+          with type 'key key := 'key
+           and type ('key, 'data, _) t := ('key, 'data) t
+           and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor
+    end
+  end
+
+  module _ (M : Accessors2) : Accessors_instance2 = M
+  module _ (M : Accessors_instance2) : Accessors2 = M
+
+  (* Ensure that Accessors3 is Accessors with no [key] type. *)
+  module type Accessors3 = Dictionary_immutable.Accessors3
+
+  open struct
+    module type Accessors_instance3 = sig
+      type ('key, 'data, 'phantom) t
+      type ('fn, 'key, 'data, 'phantom) accessor
+
+      include
+        Accessors
+          with type 'key key := 'key
+           and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t
+           and type ('fn, 'key, 'data, 'phantom) accessor :=
+            ('fn, 'key, 'data, 'phantom) accessor
+    end
+  end
+
+  module _ (M : Accessors3) : Accessors_instance3 = M
+  module _ (M : Accessors_instance3) : Accessors3 = M
+
+  (* The generic interface for creators. *)
+  module type Creators = Dictionary_immutable.Creators
+
+  (* Ensure that Creators1 is Creators with only a data type argument. *)
+  module type Creators1 = Dictionary_immutable.Creators1
+
+  open struct
+    module type Creators_instance1 = sig
+      type key
+      type 'data t
+
+      include
+        Creators
+          with type _ key := key
+           and type (_, 'data, _) t := 'data t
+           and type ('fn, _, _, _) creator := 'fn
+    end
+  end
+
+  module _ (M : Creators1) : Creators_instance1 = M
+  module _ (M : Creators_instance1) : Creators1 = M
+
+  (* Ensure that Creators2 is Creators with no phantom type argument. *)
+  module type Creators2 = Dictionary_immutable.Creators2
+
+  open struct
+    module type Creators_instance2 = sig
+      type ('key, 'data) t
+      type ('fn, 'key, 'data) creator
+
+      include
+        Creators
+          with type 'key key := 'key
+           and type ('key, 'data, _) t := ('key, 'data) t
+           and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator
+    end
+  end
+
+  module _ (M : Creators2) : Creators_instance2 = M
+  module _ (M : Creators_instance2) : Creators2 = M
+
+  (* Ensure that Creators3 is Creators with no [key] type. *)
+  module type Creators3 = Dictionary_immutable.Creators3
+
+  open struct
+    module type Creators_instance3 = sig
+      type ('key, 'data, 'phantom) t
+      type ('fn, 'key, 'data, 'phantom) creator
+
+      include
+        Creators
+          with type 'key key := 'key
+           and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t
+           and type ('fn, 'key, 'data, 'phantom) creator :=
+            ('fn, 'key, 'data, 'phantom) creator
+    end
+  end
+
+  module _ (M : Creators3) : Creators_instance3 = M
+  module _ (M : Creators_instance3) : Creators3 = M
+
+  (* The generic type for creators + accessors. *)
+  module type S = Dictionary_immutable.S
+
+  open struct
+    module type Creators_and_accessors = sig
+      type 'key key
+      type ('key, 'data, 'phantom) t
+      type ('fn, 'key, 'data, 'phantom) accessor
+      type ('fn, 'key, 'data, 'phantom) creator
+
+      include
+        Accessors
+          with type 'key key := 'key key
+          with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t
+          with type ('fn, 'key, 'data, 'phantom) accessor :=
+            ('fn, 'key, 'data, 'phantom) accessor
+
+      include
+        Creators
+          with type 'key key := 'key key
+          with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t
+          with type ('fn, 'key, 'data, 'phantom) creator :=
+            ('fn, 'key, 'data, 'phantom) creator
+    end
+  end
+
+  module _ (M : S) : Creators_and_accessors = M
+  module _ (M : Creators_and_accessors) : S = M
+
+  (* Ensure that S1 is S with only a data type argument. *)
+  module type S1 = Dictionary_immutable.S1
+
+  open struct
+    module type S_instance1 = sig
+      type key
+      type 'data t
+
+      include
+        S
+          with type _ key := key
+           and type (_, 'data, _) t := 'data t
+           and type ('fn, _, _, _) accessor := 'fn
+           and type ('fn, _, _, _) creator := 'fn
+    end
+  end
+
+  module _ (M : S1) : S_instance1 = M
+  module _ (M : S_instance1) : S1 = M
+
+  (* Ensure that S2 is S with no phantom type argument. *)
+  module type S2 = Dictionary_immutable.S2
+
+  open struct
+    module type S_instance2 = sig
+      type ('key, 'data) t
+      type ('fn, 'key, 'data) accessor
+      type ('fn, 'key, 'data) creator
+
+      include
+        S
+          with type 'key key := 'key
+           and type ('key, 'data, _) t := ('key, 'data) t
+           and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor
+           and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator
+    end
+  end
+
+  module _ (M : S2) : S_instance2 = M
+  module _ (M : S_instance2) : S2 = M
+
+  (* Ensure that S3 is S with no [key] type. *)
+  module type S3 = Dictionary_immutable.S3
+
+  open struct
+    module type S_instance3 = sig
+      type ('key, 'data, 'phantom) t
+      type ('fn, 'key, 'data, 'phantom) accessor
+      type ('fn, 'key, 'data, 'phantom) creator
+
+      include
+        S
+          with type 'key key := 'key
+           and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t
+           and type ('fn, 'key, 'data, 'phantom) accessor :=
+            ('fn, 'key, 'data, 'phantom) accessor
+           and type ('fn, 'key, 'data, 'phantom) creator :=
+            ('fn, 'key, 'data, 'phantom) creator
+    end
+  end
+
+  module _ (M : S3) : S_instance3 = M
+  module _ (M : S_instance3) : S3 = M
+end

unikernel/duniverse/base/test/test_dictionary_module_types.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_either.ml

@@ -0,0 +1,100 @@
+open! Import
+
+type t = (int, string) Either.t [@@deriving sexp_of]
+
+let f : t = First 0
+let s : t = Second "str"
+
+let%expect_test "First.Monad.map" =
+  let open Either.First.Let_syntax in
+  let inc x =
+    let%map v = x in
+    v + 1
+  in
+  let f' = inc f in
+  let s' = inc s in
+  print_s [%message (f' : t) (s' : t)];
+  [%expect {|
+    ((f' (First  1))
+     (s' (Second str)))
+    |}]
+;;
+
+let%expect_test "Second.Monad.map" =
+  let open Either.Second.Let_syntax in
+  let add x =
+    let%map v = x in
+    String.concat [ v; "1" ]
+  in
+  let f' = add f in
+  let s' = add s in
+  print_s [%message (f' : t) (s' : t)];
+  [%expect {|
+    ((f' (First  0))
+     (s' (Second str1)))
+    |}]
+;;
+
+let%expect_test "First.Monad.bind" =
+  let open Either.First.Let_syntax in
+  let inc x =
+    let%bind v = x in
+    return (v + 1)
+  in
+  let f' = inc f in
+  let s' = inc s in
+  print_s [%message (f' : t) (s' : t)];
+  [%expect {|
+    ((f' (First  1))
+     (s' (Second str)))
+    |}]
+;;
+
+let%expect_test "Second.Monad.bind" =
+  let open Either.Second.Let_syntax in
+  let add x =
+    let%bind v = x in
+    return (String.concat [ v; "1" ])
+  in
+  let f' = add f in
+  let s' = add s in
+  print_s [%message (f' : t) (s' : t)];
+  [%expect {|
+    ((f' (First  0))
+     (s' (Second str1)))
+    |}]
+;;
+
+let%expect_test "First.map2" =
+  let m t1 t2 =
+    let result = Either.First.map2 ~f:(fun x y -> x + y) t1 t2 in
+    print_s [%sexp (result : (int, string) Either.t)]
+  in
+  let foo = "foo" in
+  let bar = "bar" in
+  m (Second foo) (Second bar);
+  [%expect {| (Second foo) |}];
+  m (First 1) (First 2);
+  [%expect {| (First 3) |}];
+  m (Second foo) (First 1);
+  [%expect {| (Second foo) |}];
+  m (First 1) (Second bar);
+  [%expect {| (Second bar) |}]
+;;
+
+let%expect_test "Second.map2" =
+  let m t1 t2 =
+    let result = Either.Second.map2 ~f:(fun x y -> x + y) t1 t2 in
+    print_s [%sexp (result : (string, int) Either.t)]
+  in
+  let foo = "foo" in
+  let bar = "bar" in
+  m (First foo) (First bar);
+  [%expect {| (First foo) |}];
+  m (Second 1) (Second 2);
+  [%expect {| (Second 3) |}];
+  m (First foo) (Second 1);
+  [%expect {| (First foo) |}];
+  m (Second 1) (First bar);
+  [%expect {| (First bar) |}]
+;;

unikernel/duniverse/base/test/test_either.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_error.ml

@@ -0,0 +1,28 @@
+open! Base
+open! Import
+
+let errors =
+  [ Error.of_string "ABC"
+  ; Error.tag ~tag:"DEF" (Error.of_thunk (fun () -> "GHI"))
+  ; Error.create_s [%message "foo" ~bar:(31 : int)]
+  ]
+;;
+
+let%expect_test _ =
+  List.iter errors ~f:(fun error -> show_raise (fun () -> Error.raise error));
+  [%expect {|
+    (raised ABC)
+    (raised (DEF GHI))
+    (raised (foo (bar 31)))
+    |}]
+;;
+
+let%expect_test _ =
+  List.iter errors ~f:(fun error ->
+    show_raise (fun () -> Error.raise_s [%sexp (error : Error.t)]));
+  [%expect {|
+    (raised ABC)
+    (raised (DEF GHI))
+    (raised (foo (bar 31)))
+    |}]
+;;

unikernel/duniverse/base/test/test_error.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_exn.ml

@@ -0,0 +1,15 @@
+open! Import
+open! Exn
+
+let%expect_test "[create_s]" =
+  print_s [%sexp (create_s [%message "foo"] : t)];
+  [%expect {| foo |}];
+  print_s [%sexp (create_s [%message "foo" "bar"] : t)];
+  [%expect {| (foo bar) |}];
+  let sexp = [%message "foo"] in
+  print_s [%sexp (phys_equal sexp (sexp_of_t (create_s sexp)) : bool)];
+  [%expect {| true |}]
+;;
+
+let%test _ = not (does_raise Fn.ignore)
+let%test _ = does_raise (fun () -> failwith "foo")

unikernel/duniverse/base/test/test_exn.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_exn_reraise.ml

@@ -0,0 +1,200 @@
+open! Import
+
+(* These methods miss part of the backtrace. *)
+
+let clobber_most_recent_backtrace () =
+  try failwith "clobbering" with
+  | _ -> ()
+;;
+
+let _Base_Exn_reraise exn = Exn.reraise exn "reraised"
+
+let _Base_Exn_reraise_after_clobbering_most_recent_backtrace exn =
+  clobber_most_recent_backtrace ();
+  Exn.reraise exn "reraised"
+;;
+
+external reraiser_raw : exn -> 'a = "%reraise"
+
+let external_reraise_unequal exn = reraiser_raw (Exn.Reraised ("reraised", exn))
+let vanilla_raise_unequal exn = raise (Exn.Reraised ("reraised", exn))
+
+(* These methods produce the full, desired backtrace. *)
+
+let vanilla_raise exn = raise exn
+
+let raise_with_original_backtrace exn =
+  let backtrace = Backtrace.Exn.most_recent () in
+  Exn.raise_with_original_backtrace (Exn.Reraised ("reraised", exn)) backtrace
+;;
+
+(* This ref causes [check_value] to appear in the backtrace, because the [raise_s] call is
+   no longer in tail position. *)
+let setter = ref 0
+
+let check_value x =
+  if x < 0 then raise_s [%message "bad value" (x : int)];
+  setter := x
+;;
+
+(* This function duplicates the functionality of [Exn.reraise_uncaught] with a custom
+   [reraiser] *)
+let reraise_uncaught reraiser f =
+  try f () with
+  | exn -> reraiser exn
+;;
+
+let callstacker ~reraise_uncaught =
+  let rec loop reraise_uncaught x =
+    reraise_uncaught (fun () -> check_value x);
+    loop reraise_uncaught (x - 1);
+    reraise_uncaught (fun () -> check_value x)
+  in
+  loop reraise_uncaught 1
+;;
+
+let with_backtraces_enabled f =
+  Backtrace.Exn.with_recording true ~f:(fun () ->
+    Ref.set_temporarily Backtrace.elide false ~f)
+;;
+
+let test_reraise_uncaught ~reraise_uncaught =
+  with_backtraces_enabled (fun () ->
+    Exn.handle_uncaught ~exit:false (fun () -> callstacker ~reraise_uncaught))
+;;
+
+let test_reraiser reraiser =
+  test_reraise_uncaught ~reraise_uncaught:(reraise_uncaught reraiser)
+;;
+
+(* If you want to see what the underlying backtraces look like, set this to true.
+   Otherwise, these tests extract small snippets from the backtraces so that they are
+   robust to compiler changes. *)
+let just_print = false
+
+let really_show_backtrace s =
+  if just_print
+  then print_endline s
+  else
+    printf
+      "Before re-raise: %b\nAfter  re-raise: %b"
+      (String.is_substring s ~substring:"check_value")
+      (String.is_substring s ~substring:"handle_uncaught")
+;;
+
+let%test_module ("Show native backtraces" [@tags "no-js"]) =
+  (module struct
+    (* good *)
+    let%expect_test "Base.Exn.reraise" =
+      test_reraiser _Base_Exn_reraise;
+      really_show_backtrace [%expect.output];
+      [%expect {|
+        Before re-raise: true
+        After  re-raise: true
+        |}]
+    ;;
+
+    (* bad, because the backtrace was clobbered *)
+    let%expect_test "Base.Exn.reraise" =
+      test_reraiser _Base_Exn_reraise_after_clobbering_most_recent_backtrace;
+      really_show_backtrace [%expect.output];
+      [%expect {|
+        Before re-raise: false
+        After  re-raise: true
+        |}]
+    ;;
+
+    (* bad, missing the backtrace before the reraise *)
+    let%expect_test "%reraise unequal" =
+      test_reraiser external_reraise_unequal;
+      really_show_backtrace [%expect.output];
+      [%expect {|
+        Before re-raise: false
+        After  re-raise: true
+        |}]
+    ;;
+
+    (* bad, missing the backtrace before the reraise *)
+    let%expect_test "raise unequal" =
+      test_reraiser vanilla_raise_unequal;
+      really_show_backtrace [%expect.output];
+      [%expect {|
+        Before re-raise: false
+        After  re-raise: true
+        |}]
+    ;;
+
+    (* good, but no additional info attached *)
+    let%expect_test "raise equal" =
+      test_reraiser vanilla_raise;
+      really_show_backtrace [%expect.output];
+      [%expect {|
+        Before re-raise: true
+        After  re-raise: true
+        |}]
+    ;;
+
+    (* good *)
+    let%expect_test "Caml.Printexc.raise_with_backtrace" =
+      test_reraiser raise_with_original_backtrace;
+      really_show_backtrace [%expect.output];
+      [%expect {|
+        Before re-raise: true
+        After  re-raise: true
+        |}]
+    ;;
+
+    (* good *)
+    let%expect_test "Exn.reraise_uncaught" =
+      test_reraise_uncaught ~reraise_uncaught:(Exn.reraise_uncaught "reraised");
+      really_show_backtrace [%expect.output];
+      [%expect {|
+        Before re-raise: true
+        After  re-raise: true
+        |}]
+    ;;
+  end)
+;;
+
+(* An example bad backtrace:
+   {v
+      Uncaught exception:
+
+        (exn.ml.Reraised reraised ("bad value" (x -1)))
+
+      Raised at Base_test__Test_exn_reraise.vanilla_raise_unequal in file "test_exn_reraise.ml" (inlined), line 10, characters 32-70
+      Called from Base_test__Test_exn_reraise.reraise_uncaught in file "test_exn_reraise.ml" (inlined), line 34, characters 11-23
+      Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml", line 39, characters 4-55
+      Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 38, characters 15-167
+      Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 40, characters 4-25
+      Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 38, characters 15-167
+      Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 40, characters 4-25
+      Called from Base_test__Test_exn_reraise.callstacker in file "test_exn_reraise.ml" (inlined), line 43, characters 2-17
+      Called from Base__Exn.handle_uncaught_aux in file "exn.ml" (inlined), line 113, characters 6-10
+      Called from Base__Exn.handle_uncaught in file "exn.ml" (inlined), line 139, characters 2-88
+      Called from Base_test__Test_exn_reraise.test.(fun) in file "test_exn_reraise.ml", line 53, characters 4-68
+   v}
+*)
+
+(* An example good backtrace:
+   {v
+      Uncaught exception:
+
+        (exn.ml.Reraised reraised ("bad value" (x -1)))
+
+      Raised at Base__Error.raise in file "error.ml" (inlined), line 9, characters 14-30
+      Called from Base__Error.raise_s in file "error.ml" (inlined), line 10, characters 19-40
+      Called from Base_test__Test_exn_reraise.check_value in file "test_exn_reraise.ml", line 26, characters 16-56
+      Called from Base_test__Test_exn_reraise.callstacker.loop.(fun) in file "test_exn_reraise.ml" (inlined), line 39, characters 41-54
+      Called from Base_test__Test_exn_reraise.reraise_uncaught in file "test_exn_reraise.ml" (inlined), line 33, characters 6-10
+      Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml", line 39, characters 4-55
+      Re-raised at Base_test__Test_exn_reraise._Caml_Printexc_raise_with_backtrace in file "test_exn_reraise.ml", line 18, characters 2-79
+      Called from Base_test__Test_exn_reraise.reraise_uncaught in file "test_exn_reraise.ml" (inlined), line 34, characters 11-23
+      Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml", line 39, characters 4-55
+      Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 40, characters 4-25
+      Called from Base_test__Test_exn_reraise.callstacker.loop in file "test_exn_reraise.ml" (inlined), line 40, characters 4-25
+      Called from Base_test__Test_exn_reraise.callstacker in file "test_exn_reraise.ml" (inlined), line 43, characters 2-17
+      Called from Base__Exn.handle_uncaught_aux in file "exn.ml" (inlined), line 113, characters 6-10
+      Called from Base__Exn.handle_uncaught in file "exn.ml" (inlined), line 139, characters 2-88
+      Called from Base_test__Test_exn_reraise.test.(fun) in file "test_exn_reraise.ml", line 53, characters 4-68
+   v}*)

unikernel/duniverse/base/test/test_exn_reraise.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)

unikernel/duniverse/base/test/test_exported_int_conversions.ml

@@ -0,0 +1,297 @@
+open! Import
+
+module type S = sig
+  type t [@@deriving compare, sexp_of]
+
+  val num_bits : int
+  val min_value : t
+  val minus_one : t
+  val zero : t
+  val one : t
+  val max_value : t
+  val to_int64 : t -> int64
+  val shift_right : t -> int -> t
+  val random : Random.State.t -> t -> t -> t
+end
+
+module I : S with type t = int = struct
+  include Int
+
+  let random = Random.State.int_incl
+end
+
+module Native : S with type t = nativeint = struct
+  include Nativeint
+
+  let random = Random.State.nativeint_incl
+end
+
+module I32 : S with type t = int32 = struct
+  include Int32
+
+  let random = Random.State.int32_incl
+end
+
+module I64 : S with type t = int64 = struct
+  include Int64
+
+  let random = Random.State.int64_incl
+end
+
+module I63 : S with type t = Int63.t = struct
+  include Int63
+
+  let random state lo hi = Int63.random_incl ~state lo hi
+end
+
+let iter (type a) (module M : S with type t = a) ~f =
+  let state = Random.State.make [| 0; 1; 2; 3; 4; 5 |] in
+  List.iter ~f [ M.min_value; M.minus_one; M.zero; M.one; M.max_value ];
+  for _ = 1 to 10_000 do
+    (* skew toward low numbers of bits so that, e.g., choosing a random int64 does
+       frequently find a value that can be converted to int32. *)
+    let strip_bits = Random.State.int_incl state 0 (M.num_bits - 1) in
+    let lo = M.shift_right M.min_value strip_bits in
+    let hi = M.shift_right M.max_value strip_bits in
+    f (M.random state lo hi)
+  done
+;;
+
+let try_with f x = Option.try_with (fun () -> f x)
+
+(* Checks that a conversion from [A.t] to [B.t] is total using [of] and [to]. *)
+let test_total
+  (type a b)
+  (module A : S with type t = a)
+  (module B : S with type t = b)
+  ~of_:b_of_a
+  ~to_:a_to_b
+  =
+  iter
+    (module A)
+    ~f:(fun a ->
+      require_compare_equal [%here] (module B) (b_of_a a) (a_to_b a);
+      require_compare_equal [%here] (module Int64) (A.to_int64 a) (B.to_int64 (b_of_a a)))
+;;
+
+let truncate int64 ~num_bits =
+  Int64.shift_right (Int64.shift_left int64 (64 - num_bits)) (64 - num_bits)
+;;
+
+(* Checks that a conversion from [A.t] to [B.t] is partial using [of] and [to], and the
+   [_exn] equivalents. In the case where the conversion fails, ensure that the value,
+   converted to an [Int64.t] is outside the representable range of [B.t] converted to an
+   [Int64.t] as well. *)
+let test_partial
+  (type a b)
+  (module A : S with type t = a)
+  (module B : S with type t = b)
+  ~of_:b_of_a
+  ~of_exn:b_of_a_exn
+  ~of_trunc:b_of_a_trunc
+  ~to_:a_to_b
+  ~to_exn:a_to_b_exn
+  ~to_trunc:a_to_b_trunc
+  =
+  let module B_option = struct
+    type t = B.t option [@@deriving compare, sexp_of]
+  end
+  in
+  let convertible_count = ref 0 in
+  iter
+    (module A)
+    ~f:(fun a ->
+      require_compare_equal [%here] (module B_option) (b_of_a a) (a_to_b a);
+      require_compare_equal [%here] (module B_option) (b_of_a a) (try_with b_of_a_exn a);
+      require_compare_equal [%here] (module B_option) (a_to_b a) (try_with a_to_b_exn a);
+      match b_of_a a with
+      | Some b ->
+        Int.incr convertible_count;
+        require_compare_equal [%here] (module B) b (b_of_a_trunc a);
+        require_compare_equal [%here] (module B) b (a_to_b_trunc a);
+        require_compare_equal [%here] (module Int64) (A.to_int64 a) (B.to_int64 b)
+      | None ->
+        let trunc = truncate (A.to_int64 a) ~num_bits:B.num_bits in
+        require_compare_equal [%here] (module Int64) trunc (B.to_int64 (b_of_a_trunc a));
+        require_compare_equal [%here] (module Int64) trunc (B.to_int64 (a_to_b_trunc a));
+        require
+          [%here]
+          (Int64.( > ) (A.to_int64 a) (B.to_int64 B.max_value)
+           || Int64.( < ) (A.to_int64 a) (B.to_int64 B.min_value))
+          ~if_false_then_print_s:(lazy [%message "failed to convert" ~_:(a : A.t)]));
+  (* Make sure we stress the conversion a nontrivial number of times. This makes sure the
+     random generation is useful and we aren't just testing the hard-coded examples. *)
+  require
+    [%here]
+    (!convertible_count > 100)
+    ~if_false_then_print_s:
+      (lazy
+        [%message
+          "did not test successful conversion often enough" (convertible_count : int ref)])
+;;
+
+let%expect_test "int <-> nativeint" =
+  test_total (module I) (module Native) ~of_:Nativeint.of_int ~to_:Int.to_nativeint;
+  [%expect {| |}];
+  test_partial
+    (module Native)
+    (module I)
+    ~of_:Int.of_nativeint
+    ~of_exn:Int.of_nativeint_exn
+    ~of_trunc:Int.of_nativeint_trunc
+    ~to_:Nativeint.to_int
+    ~to_exn:Nativeint.to_int_exn
+    ~to_trunc:Nativeint.to_int_trunc;
+  [%expect {| |}]
+;;
+
+let%expect_test "int <-> int32" =
+  test_partial
+    (module I)
+    (module I32)
+    ~of_:Int32.of_int
+    ~of_exn:Int32.of_int_exn
+    ~of_trunc:Int32.of_int_trunc
+    ~to_:Int.to_int32
+    ~to_exn:Int.to_int32_exn
+    ~to_trunc:Int.to_int32_trunc;
+  [%expect {| |}];
+  test_partial
+    (module I32)
+    (module I)
+    ~of_:Int.of_int32
+    ~of_exn:Int.of_int32_exn
+    ~of_trunc:Int.of_int32_trunc
+    ~to_:Int32.to_int
+    ~to_exn:Int32.to_int_exn
+    ~to_trunc:Int32.to_int_trunc;
+  [%expect {| |}]
+;;
+
+let%expect_test "nativeint <-> int32" =
+  test_partial
+    (module Native)
+    (module I32)
+    ~of_:Int32.of_nativeint
+    ~of_exn:Int32.of_nativeint_exn
+    ~of_trunc:Int32.of_nativeint_trunc
+    ~to_:Nativeint.to_int32
+    ~to_exn:Nativeint.to_int32_exn
+    ~to_trunc:Nativeint.to_int32_trunc;
+  [%expect {| |}];
+  test_total (module I32) (module Native) ~of_:Nativeint.of_int32 ~to_:Int32.to_nativeint;
+  [%expect {| |}]
+;;
+
+let%expect_test "int <-> int64" =
+  test_total (module I) (module I64) ~of_:Int64.of_int ~to_:Int.to_int64;
+  [%expect {| |}];
+  test_partial
+    (module I64)
+    (module I)
+    ~of_:Int.of_int64
+    ~of_exn:Int.of_int64_exn
+    ~of_trunc:Int.of_int64_trunc
+    ~to_:Int64.to_int
+    ~to_exn:Int64.to_int_exn
+    ~to_trunc:Int64.to_int_trunc;
+  [%expect {| |}]
+;;
+
+let%expect_test "nativeint <-> int64" =
+  test_total (module Native) (module I64) ~of_:Int64.of_nativeint ~to_:Nativeint.to_int64;
+  [%expect {| |}];
+  test_partial
+    (module I64)
+    (module Native)
+    ~of_:Nativeint.of_int64
+    ~of_exn:Nativeint.of_int64_exn
+    ~of_trunc:Nativeint.of_int64_trunc
+    ~to_:Int64.to_nativeint
+    ~to_exn:Int64.to_nativeint_exn
+    ~to_trunc:Int64.to_nativeint_trunc;
+  [%expect {| |}]
+;;
+
+let%expect_test "int32 <-> int64" =
+  test_total (module I32) (module I64) ~of_:Int64.of_int32 ~to_:Int32.to_int64;
+  [%expect {| |}];
+  test_partial
+    (module I64)
+    (module I32)
+    ~of_:Int32.of_int64
+    ~of_exn:Int32.of_int64_exn
+    ~of_trunc:Int32.of_int64_trunc
+    ~to_:Int64.to_int32
+    ~to_exn:Int64.to_int32_exn
+    ~to_trunc:Int64.to_int32_trunc;
+  [%expect {| |}]
+;;
+
+let%expect_test "int <-> int63" =
+  test_total (module I) (module I63) ~of_:Int63.of_int ~to_:Int63.of_int;
+  [%expect {| |}];
+  test_partial
+    (module I63)
+    (module I)
+    ~of_:Int63.to_int
+    ~of_exn:Int63.to_int_exn
+    ~of_trunc:Int63.to_int_trunc
+    ~to_:Int63.to_int
+    ~to_exn:Int63.to_int_exn
+    ~to_trunc:Int63.to_int_trunc;
+  [%expect {| |}]
+;;
+
+let%expect_test "nativeint <-> int63" =
+  test_partial
+    (module Native)
+    (module I63)
+    ~of_:Int63.of_nativeint
+    ~of_exn:Int63.of_nativeint_exn
+    ~of_trunc:Int63.of_nativeint_trunc
+    ~to_:Int63.of_nativeint
+    ~to_exn:Int63.of_nativeint_exn
+    ~to_trunc:Int63.of_nativeint_trunc;
+  [%expect {| |}];
+  test_partial
+    (module I63)
+    (module Native)
+    ~of_:Int63.to_nativeint
+    ~of_exn:Int63.to_nativeint_exn
+    ~of_trunc:Int63.to_nativeint_trunc
+    ~to_:Int63.to_nativeint
+    ~to_exn:Int63.to_nativeint_exn
+    ~to_trunc:Int63.to_nativeint_trunc;
+  [%expect {| |}]
+;;
+
+let%expect_test "int32 <-> int63" =
+  test_total (module I32) (module I63) ~of_:Int63.of_int32 ~to_:Int63.of_int32;
+  [%expect {| |}];
+  test_partial
+    (module I63)
+    (module I32)
+    ~of_:Int63.to_int32
+    ~of_exn:Int63.to_int32_exn
+    ~of_trunc:Int63.to_int32_trunc
+    ~to_:Int63.to_int32
+    ~to_exn:Int63.to_int32_exn
+    ~to_trunc:Int63.to_int32_trunc;
+  [%expect {| |}]
+;;
+
+let%expect_test "int64 <-> int63" =
+  test_partial
+    (module I64)
+    (module I63)
+    ~of_:Int63.of_int64
+    ~of_exn:Int63.of_int64_exn
+    ~of_trunc:Int63.of_int64_trunc
+    ~to_:Int63.of_int64
+    ~to_exn:Int63.of_int64_exn
+    ~to_trunc:Int63.of_int64_trunc;
+  [%expect {| |}];
+  test_total (module I63) (module I64) ~of_:Int63.to_int64 ~to_:Int63.to_int64;
+  [%expect {| |}]
+;;

unikernel/duniverse/base/test/test_exported_int_conversions.mli

@@ -0,0 +1 @@
+(*_ This signature is deliberately empty. *)