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)))
+    |}]
+;;