255 lines
7.1 KiB
OCaml
255 lines
7.1 KiB
OCaml
open! Import
|
|
open! Int_conversions
|
|
|
|
let%test_module "pretty" =
|
|
(module struct
|
|
let check input output =
|
|
List.for_all [ ""; "+"; "-" ] ~f:(fun prefix ->
|
|
let input = prefix ^ input in
|
|
let output = prefix ^ output in
|
|
[%compare.equal: string] output (insert_underscores input))
|
|
;;
|
|
|
|
let%test _ = check "1" "1"
|
|
let%test _ = check "12" "12"
|
|
let%test _ = check "123" "123"
|
|
let%test _ = check "1234" "1_234"
|
|
let%test _ = check "12345" "12_345"
|
|
let%test _ = check "123456" "123_456"
|
|
let%test _ = check "1234567" "1_234_567"
|
|
let%test _ = check "12345678" "12_345_678"
|
|
let%test _ = check "123456789" "123_456_789"
|
|
let%test _ = check "1234567890" "1_234_567_890"
|
|
end)
|
|
;;
|
|
|
|
let%test_module "conversions" =
|
|
(module struct
|
|
module type S = sig
|
|
include Int.S
|
|
|
|
val module_name : string
|
|
end
|
|
|
|
let test_conversion (type a b) loc ma mb a_to_b_or_error a_to_b_trunc b_to_a_trunc =
|
|
let (module A : S with type t = a) = ma in
|
|
let (module B : S with type t = b) = mb in
|
|
let examples =
|
|
[ A.min_value
|
|
; A.minus_one
|
|
; A.zero
|
|
; A.one
|
|
; A.max_value
|
|
; B.min_value |> b_to_a_trunc
|
|
; B.max_value |> b_to_a_trunc
|
|
]
|
|
|> List.concat_map ~f:(fun a -> [ A.pred a; a; A.succ a ])
|
|
|> List.dedup_and_sort ~compare:A.compare
|
|
|> List.sort ~compare:A.compare
|
|
in
|
|
List.iter examples ~f:(fun a ->
|
|
let b' = a_to_b_trunc a in
|
|
let a' = b_to_a_trunc b' in
|
|
match a_to_b_or_error a with
|
|
| Ok b ->
|
|
require
|
|
loc
|
|
(B.equal b b')
|
|
~if_false_then_print_s:
|
|
(lazy
|
|
[%message
|
|
"conversion produced wrong value"
|
|
~from:(A.module_name : string)
|
|
~to_:(B.module_name : string)
|
|
~input:(a : A.t)
|
|
~output:(b : B.t)
|
|
~expected:(b' : B.t)]);
|
|
require
|
|
loc
|
|
(A.equal a a')
|
|
~if_false_then_print_s:
|
|
(lazy
|
|
[%message
|
|
"conversion does not round-trip"
|
|
~from:(A.module_name : string)
|
|
~to_:(B.module_name : string)
|
|
~input:(a : A.t)
|
|
~output:(b : B.t)
|
|
~round_trip:(a' : A.t)])
|
|
| Error error ->
|
|
require
|
|
loc
|
|
(not (A.equal a a'))
|
|
~if_false_then_print_s:
|
|
(lazy
|
|
[%message
|
|
"conversion failed"
|
|
~from:(A.module_name : string)
|
|
~to_:(B.module_name : string)
|
|
~input:(a : A.t)
|
|
~expected_output:(b' : B.t)
|
|
~error:(error : Error.t)]))
|
|
;;
|
|
|
|
let test loc ma mb (a_to_b_trunc, a_to_b_or_error) (b_to_a_trunc, b_to_a_or_error) =
|
|
test_conversion loc ma mb a_to_b_or_error a_to_b_trunc b_to_a_trunc;
|
|
test_conversion loc mb ma b_to_a_or_error b_to_a_trunc a_to_b_trunc
|
|
;;
|
|
|
|
module Int = struct
|
|
include Int
|
|
|
|
let module_name = "Int"
|
|
end
|
|
|
|
module Int32 = struct
|
|
include Int32
|
|
|
|
let module_name = "Int32"
|
|
end
|
|
|
|
module Int64 = struct
|
|
include Int64
|
|
|
|
let module_name = "Int64"
|
|
end
|
|
|
|
module Nativeint = struct
|
|
include Nativeint
|
|
|
|
let module_name = "Nativeint"
|
|
end
|
|
|
|
let with_exn f x = Or_error.try_with (fun () -> f x)
|
|
let optional f x = Or_error.try_with (fun () -> Option.value_exn (f x))
|
|
let alwaysok f x = Ok (f x)
|
|
|
|
let%expect_test "int <-> int32" =
|
|
test
|
|
[%here]
|
|
(module Int)
|
|
(module Int32)
|
|
(Stdlib.Int32.of_int, with_exn int_to_int32_exn)
|
|
(Stdlib.Int32.to_int, with_exn int32_to_int_exn);
|
|
[%expect {| |}];
|
|
test
|
|
[%here]
|
|
(module Int)
|
|
(module Int32)
|
|
(Stdlib.Int32.of_int, optional int_to_int32)
|
|
(Stdlib.Int32.to_int, optional int32_to_int);
|
|
[%expect {| |}]
|
|
;;
|
|
|
|
let%expect_test "int <-> int64" =
|
|
test
|
|
[%here]
|
|
(module Int)
|
|
(module Int64)
|
|
(Stdlib.Int64.of_int, alwaysok int_to_int64)
|
|
(Stdlib.Int64.to_int, with_exn int64_to_int_exn);
|
|
[%expect {| |}];
|
|
test
|
|
[%here]
|
|
(module Int)
|
|
(module Int64)
|
|
(Stdlib.Int64.of_int, alwaysok int_to_int64)
|
|
(Stdlib.Int64.to_int, optional int64_to_int);
|
|
[%expect {| |}]
|
|
;;
|
|
|
|
let%expect_test "int <-> nativeint" =
|
|
test
|
|
[%here]
|
|
(module Int)
|
|
(module Nativeint)
|
|
(Stdlib.Nativeint.of_int, alwaysok int_to_nativeint)
|
|
(Stdlib.Nativeint.to_int, with_exn nativeint_to_int_exn);
|
|
[%expect {| |}];
|
|
test
|
|
[%here]
|
|
(module Int)
|
|
(module Nativeint)
|
|
(Stdlib.Nativeint.of_int, alwaysok int_to_nativeint)
|
|
(Stdlib.Nativeint.to_int, optional nativeint_to_int);
|
|
[%expect {| |}]
|
|
;;
|
|
|
|
let%expect_test "int32 <-> int64" =
|
|
test
|
|
[%here]
|
|
(module Int32)
|
|
(module Int64)
|
|
(Stdlib.Int64.of_int32, alwaysok int32_to_int64)
|
|
(Stdlib.Int64.to_int32, with_exn int64_to_int32_exn);
|
|
[%expect {| |}];
|
|
test
|
|
[%here]
|
|
(module Int32)
|
|
(module Int64)
|
|
(Stdlib.Int64.of_int32, alwaysok int32_to_int64)
|
|
(Stdlib.Int64.to_int32, optional int64_to_int32);
|
|
[%expect {| |}]
|
|
;;
|
|
|
|
let%expect_test "int32 <-> nativeint" =
|
|
test
|
|
[%here]
|
|
(module Int32)
|
|
(module Nativeint)
|
|
(Stdlib.Nativeint.of_int32, alwaysok int32_to_nativeint)
|
|
(Stdlib.Nativeint.to_int32, with_exn nativeint_to_int32_exn);
|
|
[%expect {| |}];
|
|
test
|
|
[%here]
|
|
(module Int32)
|
|
(module Nativeint)
|
|
(Stdlib.Nativeint.of_int32, alwaysok int32_to_nativeint)
|
|
(Stdlib.Nativeint.to_int32, optional nativeint_to_int32);
|
|
[%expect {| |}]
|
|
;;
|
|
|
|
let%expect_test "int64 <-> nativeint" =
|
|
test
|
|
[%here]
|
|
(module Int64)
|
|
(module Nativeint)
|
|
(Stdlib.Int64.to_nativeint, with_exn int64_to_nativeint_exn)
|
|
(Stdlib.Int64.of_nativeint, alwaysok nativeint_to_int64);
|
|
[%expect {| |}];
|
|
test
|
|
[%here]
|
|
(module Int64)
|
|
(module Nativeint)
|
|
(Stdlib.Int64.to_nativeint, optional int64_to_nativeint)
|
|
(Stdlib.Int64.of_nativeint, alwaysok nativeint_to_int64);
|
|
[%expect {| |}]
|
|
;;
|
|
end)
|
|
;;
|
|
|
|
let%test_module "Make_hex" =
|
|
(module struct
|
|
module Hex_int = struct
|
|
type t = int [@@deriving quickcheck]
|
|
|
|
module M = Make_hex (struct
|
|
type nonrec t = int [@@deriving sexp, compare ~localize, hash, quickcheck]
|
|
|
|
let to_string = Int.Hex.to_string
|
|
let of_string = Int.Hex.of_string
|
|
let zero = 0
|
|
let ( < ) = ( < )
|
|
let neg = Int.neg
|
|
let module_name = "Hex_int"
|
|
end)
|
|
|
|
include (M.Hex : module type of M.Hex with type t := t)
|
|
end
|
|
|
|
let%expect_test "validate sexp grammar" =
|
|
require_ok [%here] (Sexp_grammar_validation.validate_grammar (module Hex_int));
|
|
[%expect {| String |}]
|
|
;;
|
|
end)
|
|
;;
|