1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
open! Import
open! Ppx_compare_lib
module Unit = struct
type t = unit [@@deriving compare, sexp_of]
end
module type T = sig
type t [@@deriving compare, sexp_of]
end
let test (type a) (module T : T with type t = a) ordered =
List.iteri ordered ~f:(fun i ti ->
List.iteri ordered ~f:(fun j tj ->
require
[%here]
(Ordering.equal
(Ordering.of_int (T.compare ti tj))
(Ordering.of_int (Int.compare i j)))
~if_false_then_print_s:(lazy [%message "" ~_:(ti : T.t) ~_:(tj : T.t)])))
;;
let%expect_test "bool, char, unit" =
test (module Bool) [ false; true ];
test (module Char) [ '\000'; 'a'; 'b' ];
[%expect {| |}];
test (module Unit) [ () ];
[%expect {| |}]
;;
module type Min_zero_max = sig
include T
val min_value : t
val max_value : t
val zero : t
end
let test_min_zero_max (type a) (module T : Min_zero_max with type t = a) =
test (module T) [ T.min_value; T.zero; T.max_value ]
;;
let%expect_test _ =
test_min_zero_max (module Float);
test_min_zero_max (module Int);
test_min_zero_max (module Int32);
test_min_zero_max (module Int64);
test_min_zero_max (module Nativeint)
;;
let%expect_test "option" =
test
(module struct
type t = int option [@@deriving compare, sexp_of]
end)
[ None; Some 0; Some 1 ]
;;
let%expect_test "ref" =
test
(module struct
type t = int ref [@@deriving compare, sexp_of]
end)
([ -1; 0; 1 ] |> List.map ~f:ref)
;;
module type Sequence = sig
type 'a t [@@deriving compare, sexp_of]
val of_list : 'a list -> 'a t
end
let test_sequence (module T : Sequence) ordered =
test
(module struct
type t = int T.t [@@deriving compare, sexp_of]
end)
(ordered |> List.map ~f:T.of_list)
;;
let%expect_test "array, list" =
test_sequence (module Array) [ []; [ 1 ]; [ 2 ]; [ 1; 2 ]; [ 2; 1 ] ];
test_sequence (module List) [ []; [ 1 ]; [ 1; 2 ]; [ 2 ]; [ 2; 1 ] ]
;;
let%expect_test "[compare_abstract]" =
show_raise (fun () -> compare_abstract ~type_name:"TY" () ());
[%expect
{|
(raised (
Failure
"Compare called on the type TY, which is abstract in an implementation.")) |}]
;;
|
