This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
25
unikernel/duniverse/ptime/test/examples.ml
Normal file
25
unikernel/duniverse/ptime/test/examples.ml
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2024 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let get = function None -> assert false | Some v -> v
|
||||
let utc d t = get @@ Ptime.of_date_time (d, (t, 0))
|
||||
let t0 = utc (1998, 12, 31) (23, 59, 59)
|
||||
let t1 = utc (1999, 01, 01) (00, 00, 00)
|
||||
let one_s = Ptime.Span.of_int_s 1
|
||||
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t1)
|
||||
|
||||
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) one_s)
|
||||
|
||||
let t2 = utc (1998, 12, 31) (23, 59, 60)
|
||||
let () = assert (Ptime.equal t1 t2)
|
||||
|
||||
let y = 9999 (* hypothetical year were this happens *)
|
||||
let t0 = utc (y, 06, 30) (23, 59, 58)
|
||||
let t1 = utc (y, 07, 01) (00, 00, 00)
|
||||
let two_s = Ptime.Span.of_int_s 2
|
||||
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) two_s)
|
||||
|
||||
let t2 = utc (y, 06, 30) (23, 59, 59)
|
||||
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t2)
|
||||
33
unikernel/duniverse/ptime/test/min_clock.ml
Normal file
33
unikernel/duniverse/ptime/test/min_clock.ml
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
(*
|
||||
Compile with:
|
||||
|
||||
ocamlfind ocamlopt \
|
||||
-package ptime.clock -linkpkg -o min_clock.native min_clock.ml
|
||||
|
||||
ocamlfind ocamlc \
|
||||
-package ptime.clock -linkpkg -o min_clock.byte min_clock.ml
|
||||
|
||||
js_of_ocaml \
|
||||
$(ocamlfind query -format "%+(jsoo_runtime)" -r ptime.clock) \
|
||||
min_clock.byte
|
||||
*)
|
||||
|
||||
let pp_period ppf = function
|
||||
| None -> Format.fprintf ppf "unknown"
|
||||
| Some p -> Ptime.Span.pp ppf p
|
||||
|
||||
let pp_tz ppf = function
|
||||
| None -> Format.fprintf ppf "unknown"
|
||||
| Some tz -> Format.fprintf ppf "%ds" tz
|
||||
|
||||
let main () =
|
||||
let now = Ptime_clock.now () in
|
||||
let tz_offset_s = Ptime_clock.current_tz_offset_s () in
|
||||
let period = Ptime_clock.period () in
|
||||
Format.printf "Clock period: %a@." pp_period period;
|
||||
Format.printf " TZ offset: %a@." pp_tz tz_offset_s;
|
||||
Format.printf " Now UTC : %a@." Ptime.pp now;
|
||||
Format.printf " Now local: %a@." Ptime.(pp_human ?tz_offset_s ()) now;
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else main ()
|
||||
144
unikernel/duniverse/ptime/test/test_base.ml
Normal file
144
unikernel/duniverse/ptime/test/test_base.ml
Normal file
|
|
@ -0,0 +1,144 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let span_of_d_ps ?__POS__ s = Ptime.Span.of_d_ps s |> Test.get_some ?__POS__
|
||||
|
||||
let test_base () =
|
||||
Test.test "stamp constants and base constructors" @@ fun () ->
|
||||
let of_span s = Ptime.(of_span (span_of_d_ps s)) in
|
||||
let get_of_span s = match of_span s with None -> assert false | Some s -> s in
|
||||
let to_raw_span t = Ptime.(Span.to_d_ps (to_span t)) in
|
||||
T.raw_span ~__POS__
|
||||
(to_raw_span Ptime.epoch) (0, 0L);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (0, 0L)) (Some Ptime.epoch);
|
||||
T.raw_span ~__POS__
|
||||
(to_raw_span Ptime.min) (-719528, 0L);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (-719528, 0L)) (Some Ptime.min);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (-719529, 86_399_999_999_999_999L)) None;
|
||||
T.raw_span ~__POS__
|
||||
(to_raw_span Ptime.max) (2932896, 86_399_999_999_999_999L);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (2932896, 86_399_999_999_999_999L)) (Some Ptime.max);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (2932897, 0L)) None;
|
||||
Test.float ~__POS__
|
||||
(Ptime.to_float_s Ptime.epoch) 0.;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s 0.) (Some Ptime.epoch);
|
||||
Test.float ~__POS__
|
||||
(Ptime.to_float_s Ptime.min) ~-.62167219200.;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s ~-.62167219200.) (Some Ptime.min);
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s ~-.62167219201.) None;
|
||||
Test.float ~__POS__
|
||||
(Ptime.to_float_s (Ptime.truncate ~frac_s:0 Ptime.max)) 253402300799.;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s 253402300799.)
|
||||
(Some (Ptime.truncate ~frac_s:0 Ptime.max));
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s 253402300800.) None;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s nan) None;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s infinity) None;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s ~-.infinity) None;
|
||||
T.raw_span ~__POS__
|
||||
Ptime.(Span.to_d_ps (frac_s Ptime.max)) (0, 999_999_999_999L);
|
||||
T.span ~__POS__
|
||||
(Ptime.frac_s @@ get_of_span (0, 100_000_000_000L))
|
||||
(span_of_d_ps (0, 100_000_000_000L));
|
||||
T.span ~__POS__
|
||||
(Ptime.frac_s @@ get_of_span (-1, 100_000_000_000L))
|
||||
(span_of_d_ps (0, 100_000_000_000L));
|
||||
()
|
||||
|
||||
let test_predicates () =
|
||||
Test.test "stamp predicates" @@ fun () ->
|
||||
Test.bool ~__POS__ Ptime.(is_earlier min ~than:min) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier min ~than:epoch) true;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier min ~than:max) true;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier epoch ~than:min) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier epoch ~than:epoch) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier epoch ~than:max) true;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier max ~than:min) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier max ~than:epoch) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier max ~than:max) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later min ~than:min) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later min ~than:epoch) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later min ~than:max) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later epoch ~than:min) true;
|
||||
Test.bool ~__POS__ Ptime.(is_later epoch ~than:epoch) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later epoch ~than:max) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later max ~than:min) true;
|
||||
Test.bool ~__POS__ Ptime.(is_later max ~than:epoch) true;
|
||||
Test.bool ~__POS__ Ptime.(is_later max ~than:max) false;
|
||||
()
|
||||
|
||||
let test_posix_arithmetic () =
|
||||
Test.test "stamp POSIX arithmetic" @@ fun () ->
|
||||
let span ps = span_of_d_ps (0, ps) in
|
||||
let nspan ps = Ptime.Span.(neg (span_of_d_ps (0, ps))) in
|
||||
(* Test limits *)
|
||||
T.stamp_option ~__POS__ Ptime.(add_span max (span 1L)) None;
|
||||
T.stamp_option ~__POS__ Ptime.(add_span min (nspan (1L))) None;
|
||||
T.stamp_option ~__POS__ Ptime.(sub_span min (span 1L)) None;
|
||||
T.stamp_option ~__POS__ Ptime.(sub_span max (nspan (1L))) None;
|
||||
(* Test arithmetic *)
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_span (span 10L)) Ptime.(add_span epoch (span 10L));
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_span (nspan 10L)) Ptime.(sub_span epoch (span 10L));
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_span (nspan (10L))) Ptime.(sub_span epoch (span 10L));
|
||||
Test.block @@ fun () ->
|
||||
let of_span ps =
|
||||
let s = span_of_d_ps (0, Int64.abs ps) in
|
||||
Ptime.of_span (if ps < 0L then Ptime.Span.neg s else s)
|
||||
in
|
||||
let get ?__POS__ s = of_span s |> Test.get_some ?__POS__ in
|
||||
let t0 = get ~__POS__ 20L in
|
||||
let t1 = get ~__POS__ 10L in
|
||||
let t2 = get ~__POS__ (-10L) in
|
||||
T.span ~__POS__ (Ptime.diff t0 t1) (span 10L);
|
||||
T.span ~__POS__ (Ptime.diff t1 t0) (nspan 10L);
|
||||
T.span ~__POS__ (Ptime.diff t2 t0) (nspan 30L);
|
||||
T.span ~__POS__ (Ptime.diff t0 t2) (span 30L);
|
||||
()
|
||||
|
||||
let test_truncation () =
|
||||
Test.test "stamp truncation" @@ fun () ->
|
||||
let p ~frac_s t =
|
||||
let d1 = Ptime.(diff t min) |> Ptime.Span.truncate ~frac_s
|
||||
and d2 = Ptime.diff (Ptime.truncate ~frac_s t) Ptime.min in
|
||||
T.span ~__POS__ d1 d2
|
||||
in
|
||||
let t ~frac_s ps =
|
||||
p ~frac_s (Ptime.v (0, ps));
|
||||
p ~frac_s (Ptime.v (1, ps));
|
||||
p ~frac_s (Ptime.v (-1, ps));
|
||||
p ~frac_s (Ptime.v (2932896, ps));
|
||||
p ~frac_s (Ptime.v (-719528, ps));
|
||||
in
|
||||
for i = 0 to 12 do
|
||||
t ~frac_s:i 0L;
|
||||
t ~frac_s:i 86_399_999_999_999_999L;
|
||||
t ~frac_s:i 86_399_000_000_000_000L;
|
||||
done;
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_base ();
|
||||
test_predicates ();
|
||||
test_posix_arithmetic ();
|
||||
test_truncation ();
|
||||
()
|
||||
133
unikernel/duniverse/ptime/test/test_date.ml
Normal file
133
unikernel/duniverse/ptime/test/test_date.ml
Normal file
|
|
@ -0,0 +1,133 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let test_bounds () =
|
||||
Test.test "calendar date field bounds" @@ fun () ->
|
||||
let valid_date ?__POS__ d =
|
||||
Test.holds ?__POS__ (Option.is_some (Ptime.of_date ?tz_offset_s:None d))
|
||||
in
|
||||
let wrong_date ?__POS__ d =
|
||||
Test.holds ?__POS__ (Option.is_none (Ptime.of_date ?tz_offset_s:None d))
|
||||
in
|
||||
(* Check year bounds *)
|
||||
wrong_date ~__POS__ (-1, 01, 01);
|
||||
valid_date ~__POS__ (0, 01, 01);
|
||||
valid_date ~__POS__ (1, 01, 01);
|
||||
valid_date ~__POS__ (9999, 01, 01);
|
||||
wrong_date ~__POS__ (10000, 01, 01);
|
||||
wrong_date ~__POS__ (10001, 01, 01);
|
||||
(* Check month bounds *)
|
||||
wrong_date ~__POS__ (0, 00, 01);
|
||||
valid_date ~__POS__ (0, 01, 01);
|
||||
valid_date ~__POS__ (0, 12, 01);
|
||||
wrong_date ~__POS__ (0, 13, 01);
|
||||
(* Check day bounds in 2015 (month lengths) *)
|
||||
(* Jan 2015 *)
|
||||
wrong_date ~__POS__ (2015, 01, -1);
|
||||
valid_date ~__POS__ (2015, 01, 01);
|
||||
valid_date ~__POS__ (2015, 01, 31);
|
||||
wrong_date ~__POS__ (2015, 01, 32);
|
||||
(* Feb 2015, is not leap *)
|
||||
wrong_date ~__POS__ (2015, 02, -1);
|
||||
valid_date ~__POS__ (2015, 02, 01);
|
||||
valid_date ~__POS__ (2015, 02, 28);
|
||||
wrong_date ~__POS__ (2015, 02, 29);
|
||||
(* Mar 2015 *)
|
||||
wrong_date ~__POS__ (2015, 03, -1);
|
||||
valid_date ~__POS__ (2015, 03, 01);
|
||||
valid_date ~__POS__ (2015, 03, 31);
|
||||
wrong_date ~__POS__ (2015, 03, 32);
|
||||
(* Apr 2015 *)
|
||||
wrong_date ~__POS__ (2015, 04, -1);
|
||||
valid_date ~__POS__ (2015, 04, 01);
|
||||
valid_date ~__POS__ (2015, 04, 30);
|
||||
wrong_date ~__POS__ (2015, 04, 31);
|
||||
(* May 2015 *)
|
||||
wrong_date ~__POS__ (2015, 05, -1);
|
||||
valid_date ~__POS__ (2015, 05, 01);
|
||||
valid_date ~__POS__ (2015, 05, 31);
|
||||
wrong_date ~__POS__ (2015, 05, 32);
|
||||
(* June 2015 *)
|
||||
wrong_date ~__POS__ (2015, 06, -1);
|
||||
valid_date ~__POS__ (2015, 06, 01);
|
||||
valid_date ~__POS__ (2015, 06, 30);
|
||||
wrong_date ~__POS__ (2015, 06, 31);
|
||||
(* July 2015 *)
|
||||
wrong_date ~__POS__ (2015, 07, -1);
|
||||
valid_date ~__POS__ (2015, 07, 01);
|
||||
valid_date ~__POS__ (2015, 07, 31);
|
||||
wrong_date ~__POS__ (2015, 07, 32);
|
||||
(* Aug 2015 *)
|
||||
wrong_date ~__POS__ (2015, 08, -1);
|
||||
valid_date ~__POS__ (2015, 08, 01);
|
||||
valid_date ~__POS__ (2015, 08, 31);
|
||||
wrong_date ~__POS__ (2015, 08, 32);
|
||||
(* Sept 2015 *)
|
||||
wrong_date ~__POS__ (2015, 09, -1);
|
||||
valid_date ~__POS__ (2015, 09, 01);
|
||||
valid_date ~__POS__ (2015, 09, 30);
|
||||
wrong_date ~__POS__ (2015, 09, 31);
|
||||
(* Oct 2015 *)
|
||||
wrong_date ~__POS__ (2015, 10, -1);
|
||||
valid_date ~__POS__ (2015, 10, 01);
|
||||
valid_date ~__POS__ (2015, 10, 31);
|
||||
wrong_date ~__POS__ (2015, 10, 32);
|
||||
(* Nov 2015 *)
|
||||
wrong_date ~__POS__ (2015, 11, -1);
|
||||
valid_date ~__POS__ (2015, 11, 01);
|
||||
valid_date ~__POS__ (2015, 11, 30);
|
||||
wrong_date ~__POS__ (2015, 11, 31);
|
||||
(* Dec 2015 *)
|
||||
wrong_date ~__POS__ (2015, 12, -1);
|
||||
valid_date ~__POS__ (2015, 12, 01);
|
||||
valid_date ~__POS__ (2015, 12, 31);
|
||||
wrong_date ~__POS__ (2015, 12, 32);
|
||||
(* 1500 is not leap *)
|
||||
valid_date ~__POS__ (1500, 02, 28);
|
||||
wrong_date ~__POS__ (1500, 02, 29);
|
||||
(* 1700 is not leap *)
|
||||
valid_date ~__POS__ (1700, 02, 28);
|
||||
wrong_date ~__POS__ (1700, 02, 29);
|
||||
(* 1800 is not leap *)
|
||||
valid_date ~__POS__ (1800, 02, 28);
|
||||
wrong_date ~__POS__ (1800, 02, 29);
|
||||
(* 1900 is not leap, Lotus 1-2-3 & Excel bug *)
|
||||
valid_date ~__POS__ (1900, 02, 28);
|
||||
wrong_date ~__POS__ (1900, 02, 29);
|
||||
(* 2000 is leap *)
|
||||
valid_date ~__POS__ (2000, 02, 28);
|
||||
valid_date ~__POS__ (2000, 02, 29);
|
||||
wrong_date ~__POS__ (2000, 02, 30);
|
||||
(* 2010 is not leap *)
|
||||
valid_date ~__POS__ (2010, 02, 28);
|
||||
wrong_date ~__POS__ (2010, 02, 29);
|
||||
(* 2012 is leap *)
|
||||
valid_date ~__POS__ (2012, 02, 29);
|
||||
valid_date ~__POS__ (2012, 02, 29);
|
||||
wrong_date ~__POS__ (2012, 02, 30);
|
||||
(* 2100 is not leap *)
|
||||
valid_date ~__POS__ (2100, 02, 28);
|
||||
wrong_date ~__POS__ (2100, 02, 29);
|
||||
()
|
||||
|
||||
let test_stamp_trips () =
|
||||
Test.test "random valid dates to stamps round trips" @@ fun () ->
|
||||
let of_date ?__POS__ d =
|
||||
Ptime.of_date ?tz_offset_s:None d |> Test.get_some ?__POS__
|
||||
in
|
||||
for i = 1 to Rand.loop_len () do
|
||||
let date = Rand.date () in
|
||||
let trip = Ptime.to_date (of_date date) in
|
||||
T.date ~__POS__ date trip
|
||||
done;
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_bounds ();
|
||||
test_stamp_trips ();
|
||||
()
|
||||
211
unikernel/duniverse/ptime/test/test_date_time.ml
Normal file
211
unikernel/duniverse/ptime/test/test_date_time.ml
Normal file
|
|
@ -0,0 +1,211 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let stamp_of_date_time ?__POS__ d =
|
||||
Ptime.of_date_time d |> Test.get_some ?__POS__
|
||||
|
||||
let valid_date_time ?__POS__ d =
|
||||
Test.holds ?__POS__ (Option.is_some (Ptime.of_date_time d))
|
||||
|
||||
let wrong_date_time ?__POS__ d =
|
||||
Test.holds ?__POS__ (Option.is_none (Ptime.of_date_time d))
|
||||
|
||||
let test_time_bounds () =
|
||||
Test.test "date-time time field bounds" @@ fun () ->
|
||||
let min_date = Ptime.to_date Ptime.min in
|
||||
let min_utc t = min_date, (t, 0) in
|
||||
(* Check hour bounds *)
|
||||
wrong_date_time ~__POS__ (min_utc (-2, 00, 00));
|
||||
wrong_date_time ~__POS__ (min_utc (-1, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (01, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (23, 00, 00));
|
||||
wrong_date_time ~__POS__ (min_utc (24, 00, 00));
|
||||
(* Check minute bounds *)
|
||||
wrong_date_time ~__POS__ (min_utc (00, -2, 00));
|
||||
wrong_date_time ~__POS__ (min_utc (00, -1, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 01, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 59, 00));
|
||||
wrong_date_time ~__POS__ (min_utc (00, 60, 00));
|
||||
(* Check second bounds *)
|
||||
wrong_date_time ~__POS__ (min_utc (00, 00, -2));
|
||||
wrong_date_time ~__POS__ (min_utc (00, 00, -1));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 01));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 59));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 60));
|
||||
wrong_date_time ~__POS__ (min_utc (00, 00, 61));
|
||||
()
|
||||
|
||||
let test_tz () =
|
||||
Test.test "testing date-time time zone calculations" @@ fun () ->
|
||||
(* Timestamps with tz offsets around Ptime.{max,min} *)
|
||||
wrong_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), +1));
|
||||
valid_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), +0));
|
||||
valid_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), -1));
|
||||
wrong_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 59), -1));
|
||||
wrong_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 60), +0));
|
||||
valid_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 60), +1));
|
||||
(* Convert time zones *)
|
||||
let nyc_tz = -4 * 3600 in
|
||||
let cam_tz = +1 * 3600 in
|
||||
let lau_tz = +2 * 3600 in
|
||||
let new_york = ((2015, 06, 27), ((18, 30, 01), nyc_tz)) in
|
||||
let cambridge = ((2015, 06, 27), ((23, 30, 01), cam_tz)) in
|
||||
let lausanne = ((2015, 06, 28), ((00, 30, 01), lau_tz)) in
|
||||
let nyc_stamp = stamp_of_date_time new_york in
|
||||
let cam_stamp = stamp_of_date_time cambridge in
|
||||
let lau_stamp = stamp_of_date_time lausanne in
|
||||
T.stamp ~__POS__ nyc_stamp cam_stamp;
|
||||
T.stamp ~__POS__ cam_stamp lau_stamp;
|
||||
T.date_time ~__POS__
|
||||
(Ptime.to_date_time ~tz_offset_s:nyc_tz nyc_stamp) new_york;
|
||||
T.date_time ~__POS__
|
||||
(Ptime.to_date_time ~tz_offset_s:cam_tz nyc_stamp) cambridge;
|
||||
T.date_time ~__POS__
|
||||
(Ptime.to_date_time ~tz_offset_s:lau_tz nyc_stamp) lausanne;
|
||||
()
|
||||
|
||||
let test_subsecond () =
|
||||
Test.test "subsecond stamp to date-time" @@ fun () ->
|
||||
let span_of_d_ps ?__POS__ s =
|
||||
Ptime.Span.of_d_ps s |> Test.get_some ?__POS__
|
||||
in
|
||||
let add, sub =
|
||||
let add t ps = Ptime.(add_span t (span_of_d_ps (0, ps))) |> Test.get_some in
|
||||
let sub t ps = Ptime.(sub_span t (span_of_d_ps (0, ps))) |> Test.get_some in
|
||||
add, sub
|
||||
in
|
||||
let b0 = sub Ptime.epoch 750_000_000_000L in
|
||||
let b1 = sub Ptime.epoch 500_000_000_000L in
|
||||
let b2 = sub Ptime.epoch 250_000_000_000L in
|
||||
let b = (1969, 12, 31), ((23, 59, 59), +0) in
|
||||
T.date_time ~__POS__ b (Ptime.to_date_time b0);
|
||||
T.date_time ~__POS__ b (Ptime.to_date_time b1);
|
||||
T.date_time ~__POS__ b (Ptime.to_date_time b2);
|
||||
let a0 = add Ptime.epoch 750_000_000_000L in
|
||||
let a1 = add Ptime.epoch 500_000_000_000L in
|
||||
let a2 = add Ptime.epoch 250_000_000_000L in
|
||||
let a = (1970, 01, 01), ((00, 00, 00), +0) in
|
||||
T.date_time ~__POS__ a (Ptime.to_date_time a0);
|
||||
T.date_time ~__POS__ a (Ptime.to_date_time a1);
|
||||
T.date_time ~__POS__ a (Ptime.to_date_time a2);
|
||||
()
|
||||
|
||||
let test_leap_sec () =
|
||||
Test.test "testing leap second date-times" @@ fun () ->
|
||||
let after_leap_sec = (1999, 01, 01), ((00, 00, 00), 0) in
|
||||
let t0 = stamp_of_date_time ((1998, 12, 31), ((23, 59, 59), 0)) in
|
||||
let t1 = stamp_of_date_time ((1998, 12, 31), ((23, 59, 60), 0)) in
|
||||
let t2 = stamp_of_date_time after_leap_sec in
|
||||
T.stamp ~__POS__ t1 t2
|
||||
(* leap sec is represented by second that comes after *);
|
||||
T.stamp_option ~__POS__ (Some t1) Ptime.(add_span t0 (Span.of_int_s 1));
|
||||
T.date_time ~__POS__ after_leap_sec (Ptime.to_date_time t1);
|
||||
T.date_time ~__POS__ after_leap_sec (Ptime.to_date_time t2);
|
||||
T.span ~__POS__ (Ptime.diff t2 t0) (Ptime.Span.of_int_s 1);
|
||||
T.span ~__POS__ (Ptime.diff t1 t0) (Ptime.Span.of_int_s 1);
|
||||
T.span ~__POS__ (Ptime.diff t2 t1) (Ptime.Span.of_int_s 0);
|
||||
()
|
||||
|
||||
let test_stamp_trips () =
|
||||
Test.test "random stamps to date-time round trips" @@ fun () ->
|
||||
let stamp_of_posix_s s = Ptime.of_float_s s |> Test.get_some in
|
||||
let trip ?tz_offset_s t =
|
||||
let back = stamp_of_posix_s (floor (Ptime.to_float_s t)) in
|
||||
let trip = stamp_of_date_time (Ptime.to_date_time ?tz_offset_s t) in
|
||||
T.stamp ~__POS__ back trip
|
||||
in
|
||||
for i = 1 to Rand.loop_len () do
|
||||
trip ~tz_offset_s:0 (* UTC *) (Rand.float_stamp ());
|
||||
trip ~tz_offset_s:(Rand.tz_offset_s ()) (Rand.float_stamp ())
|
||||
done
|
||||
|
||||
let test_round_trips () =
|
||||
Test.test "random valid date-times to stamp round trips" @@ fun () ->
|
||||
let is_leap_sec = function
|
||||
| (_, _, _), ((_, _, 60), _) -> true
|
||||
| _ -> false
|
||||
in
|
||||
let rec rand_date_time_stamp () = (* biased *)
|
||||
let date = Rand.date () in
|
||||
let time = Rand.time () in
|
||||
let tz = Rand.tz_offset_s () in
|
||||
let dt = (date, (time, tz)) in
|
||||
match Ptime.of_date_time dt with
|
||||
| Some _ -> dt
|
||||
| None ->
|
||||
let dt = date, (time, 0) (* try in UTC *) in
|
||||
begin match Ptime.of_date_time dt with
|
||||
| None -> rand_date_time_stamp () (* start again *)
|
||||
| Some _ -> dt
|
||||
end
|
||||
in
|
||||
let add_posix_s =
|
||||
let span s = Ptime.Span.of_float_s s |> Test.get_some in
|
||||
let add_posix_s t s = Ptime.(add_span t (span s)) |> Test.get_some in
|
||||
add_posix_s
|
||||
in
|
||||
for i = 1 to Rand.loop_len () do
|
||||
let (_, (_, tz_offset_s) as dt) = rand_date_time_stamp () in
|
||||
let stamp = stamp_of_date_time dt in
|
||||
if not (is_leap_sec dt)
|
||||
then begin
|
||||
let ((y, _, _), _ as dt') = Ptime.to_date_time ~tz_offset_s stamp in
|
||||
assert (Ptime.to_year ~tz_offset_s stamp = y);
|
||||
T.date_time ~__POS__ dt dt'
|
||||
end
|
||||
else begin
|
||||
(* Verify we map the leap sec on the the second after. *)
|
||||
let before_leap_dt = match dt with
|
||||
| date, ((hh, ss, 60), tz) -> date, ((hh, ss, 59), tz)
|
||||
| _ -> assert false
|
||||
in
|
||||
let stamp' = add_posix_s (stamp_of_date_time before_leap_dt) 1. in
|
||||
T.stamp ~__POS__ stamp stamp'
|
||||
end
|
||||
done;
|
||||
()
|
||||
|
||||
let test_weekday () =
|
||||
Test.test "Ptime.{weekday_num,weekday}" @@ fun () ->
|
||||
let module Weekday = struct
|
||||
type t = Ptime.weekday
|
||||
let equal = ( = )
|
||||
let pp ppf v = Format.pp_print_string ppf @@ match v with
|
||||
| `Mon -> "`Mon" | `Tue -> "`Tue" | `Wed -> "`Wed" | `Thu -> "`Thu"
|
||||
| `Fri -> "`Fri" | `Sat -> "`Sat" | `Sun -> "`Sun"
|
||||
end
|
||||
in
|
||||
let weekday ?__POS__ = Test.eq ?__POS__ (module Weekday) in
|
||||
let eq ?__POS__ ?tz_offset_s c wday =
|
||||
let s = stamp_of_date_time (c, ((0, 0, 0), 0)) in
|
||||
weekday ?__POS__ (Ptime.weekday ?tz_offset_s s) wday
|
||||
in
|
||||
eq ~__POS__ (1970, 01, 01) `Thu;
|
||||
eq ~__POS__ ~tz_offset_s:(-1) (1970, 01, 01) `Wed;
|
||||
eq ~__POS__ ~tz_offset_s:86400 (1970, 01, 01) `Fri;
|
||||
eq ~__POS__ (1871, 03, 18) `Sat;
|
||||
eq ~__POS__ ~tz_offset_s:(-1) (1871, 03, 18) `Fri;
|
||||
eq ~__POS__ ~tz_offset_s:86400 (1871, 03, 18) `Sun;
|
||||
eq ~__POS__ (1995, 09, 12) `Tue;
|
||||
eq ~__POS__ ~tz_offset_s:(-1) (1995, 09, 12) `Mon;
|
||||
eq ~__POS__ ~tz_offset_s:86400 (1995, 09, 12) `Wed;
|
||||
eq ~__POS__ ~tz_offset_s:172800 (1995, 09, 12) `Thu;
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_time_bounds ();
|
||||
test_tz ();
|
||||
test_subsecond ();
|
||||
test_leap_sec ();
|
||||
test_stamp_trips ();
|
||||
test_round_trips ();
|
||||
test_weekday ();
|
||||
()
|
||||
26
unikernel/duniverse/ptime/test/test_gmtime.ml
Normal file
26
unikernel/duniverse/ptime/test/test_gmtime.ml
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let test_stamp_to_date_time () =
|
||||
Test.test "random Ptime-valid stamps to date-time" @@ fun () ->
|
||||
if Sys.word_size > 32 then begin
|
||||
T.date_time_gmtime_witness ~__POS__ Ptime.min;
|
||||
T.date_time_gmtime_witness ~__POS__ Ptime.(truncate ~frac_s:0 max);
|
||||
end;
|
||||
for i = 1 to Rand.loop_len () do
|
||||
T.date_time_gmtime_witness ~__POS__ (Rand.stamp ())
|
||||
done;
|
||||
()
|
||||
|
||||
let main () =
|
||||
Test.main @@ fun () ->
|
||||
Test.Cli.parse ();
|
||||
test_stamp_to_date_time ();
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
30
unikernel/duniverse/ptime/test/test_gmtime_all.ml
Normal file
30
unikernel/duniverse/ptime/test/test_gmtime_all.ml
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let exhaustive_min_max =
|
||||
if Sys.word_size > 32
|
||||
then Ptime.(to_float_s min), Ptime.(to_float_s (truncate ~frac_s:0 max))
|
||||
else Int32.(to_float min_int), Int32.(to_float max_int)
|
||||
|
||||
let test_exhaustive () =
|
||||
Test.test "each Ptime-valid second stamp to date-time" @@ fun () ->
|
||||
let min, max = exhaustive_min_max in
|
||||
let rec loop t =
|
||||
if t > max then () else
|
||||
let stamp = Ptime.of_float_s t |> Option.get in
|
||||
T.date_time_gmtime_witness ~__POS__ stamp;
|
||||
loop (t +. 1.0)
|
||||
in
|
||||
loop min
|
||||
|
||||
let main () =
|
||||
Test.main @@ fun () ->
|
||||
test_exhaustive ();
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
18
unikernel/duniverse/ptime/test/test_ptime.ml
Normal file
18
unikernel/duniverse/ptime/test/test_ptime.ml
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
|
||||
let main () =
|
||||
Test.main @@ fun () ->
|
||||
Test.Cli.parse ();
|
||||
Test_span.tests ();
|
||||
Test_base.tests ();
|
||||
Test_date.tests ();
|
||||
Test_date_time.tests ();
|
||||
Test_rfc3339.tests ();
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
276
unikernel/duniverse/ptime/test/test_rfc3339.ml
Normal file
276
unikernel/duniverse/ptime/test/test_rfc3339.ml
Normal file
|
|
@ -0,0 +1,276 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let stamp_of_s ?__POS__ v = Ptime.of_float_s v |> Test.get_some ?__POS__
|
||||
|
||||
let test_stamp_conversions () =
|
||||
Test.test "stamp to RFC 3339 conversions" @@ fun () ->
|
||||
let stamp_of_date_time ?__POS__ v =
|
||||
Ptime.of_date_time v |> Test.get_some ?__POS__
|
||||
in
|
||||
let dt ?space ?frac_s ?tz_offset_s dt =
|
||||
Ptime.to_rfc3339 ?space ?frac_s ?tz_offset_s (stamp_of_date_time dt)
|
||||
in
|
||||
let stamp ?space ?frac_s ?tz_offset_s s =
|
||||
Ptime.to_rfc3339 ?space ?frac_s ?tz_offset_s s
|
||||
in
|
||||
let dt0 = (1999, 01, 02), ((01, 02, 03), 0) in
|
||||
Test.string ~__POS__ "1999-01-02T01:02:03Z"
|
||||
(dt ~tz_offset_s:0 dt0);
|
||||
Test.string ~__POS__ "1999-01-02 01:02:03Z"
|
||||
(dt ~tz_offset_s:0 ~space:true dt0);
|
||||
Test.string ~__POS__ "1999-01-02T01:02:03-00:00"
|
||||
(dt dt0);
|
||||
Test.string ~__POS__ "1999-01-02 01:02:03-00:00"
|
||||
(dt ~space:true dt0);
|
||||
Test.string ~__POS__ "1999-01-02T02:03:03+01:01"
|
||||
(dt ~tz_offset_s:3660 dt0);
|
||||
Test.string ~__POS__ "1999-01-02T00:01:03-01:01"
|
||||
(dt ~tz_offset_s:(-3660) dt0);
|
||||
Test.string ~__POS__ "1999-01-02T01:02:03-00:00"
|
||||
(dt ~tz_offset_s:1 dt0);
|
||||
Test.string ~__POS__ "1999-01-02T01:02:03-00:00"
|
||||
(dt ~tz_offset_s:12960000 dt0);
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.75Z"
|
||||
(stamp ~frac_s:2 ~tz_offset_s:0 (stamp_of_s (-.(1. /. 4.))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.25Z"
|
||||
(stamp ~frac_s:2 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. 4.))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:01.001953125Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s ( 1. +. (1. /. (2. ** 9.)))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.001953125Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. (2. ** 9.)))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:01.125Z"
|
||||
(stamp ~frac_s:3 ~tz_offset_s:0 (stamp_of_s ( 1. +. (1. /. (2. ** 3.)))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.125Z"
|
||||
(stamp ~frac_s:3 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. (2. ** 3.)))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:01.5Z"
|
||||
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s ( 1. +. (1. /. (2. ** 1.)))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.5Z"
|
||||
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. (2. ** 1.)))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:02.001953125Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s ( 2. +. (1. /. (2. ** 9.)))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58.001953125Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s (-2. +. (1. /. (2. ** 9.)))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:02.000000000Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s ( 2.)));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58.000000000Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s (-2.)));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:02.0Z"
|
||||
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s ( 2.)));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58.0Z"
|
||||
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s (-2.)));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:02Z"
|
||||
(stamp ~frac_s:0 ~tz_offset_s:0 (stamp_of_s ( 2.)));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58Z"
|
||||
(stamp ~frac_s:0 ~tz_offset_s:0 (stamp_of_s (-2.)));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58Z"
|
||||
(stamp ~frac_s:(-1) ~tz_offset_s:0 (stamp_of_s (-2.)));
|
||||
Test.string ~__POS__ "9999-12-31T23:59:59.999999999999Z"
|
||||
(stamp ~frac_s:12 ~tz_offset_s:0 Ptime.max);
|
||||
Test.string ~__POS__ "0000-01-01T00:00:00.000000000000Z"
|
||||
(stamp ~frac_s:12 ~tz_offset_s:0 Ptime.min);
|
||||
Test.string ~__POS__ "0000-01-01T00:00:00.000000000000Z"
|
||||
(stamp ~frac_s:13 ~tz_offset_s:0 Ptime.min);
|
||||
()
|
||||
|
||||
let test_parse () =
|
||||
Test.test "RFC 3339 to stamp conversions" @@ fun () ->
|
||||
let test_result =
|
||||
let ok =
|
||||
let equal (t, tz, c) (t', tz',c') =
|
||||
Ptime.equal t t' && tz = tz' && c = c'
|
||||
in
|
||||
let pp ppf (t, tz, count) =
|
||||
Fmt.pf ppf "(%a, %a, %d)"
|
||||
Ptime.dump t (Test.Fmt.option Fmt.int) tz count
|
||||
in
|
||||
Test.Eq.make ~equal ~pp ()
|
||||
in
|
||||
let error =
|
||||
let pp ppf = function `RFC3339 ((s, e), err) ->
|
||||
Fmt.pf ppf "@[<1>%d-%d:@ @[%a@]@]" s e Ptime.pp_rfc3339_error err
|
||||
in
|
||||
Test.Eq.make ~pp ()
|
||||
in
|
||||
fun ?__POS__ -> Test.result' ?__POS__ ~ok ~error
|
||||
in
|
||||
let edigit = `Exp_chars ['0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'] in
|
||||
let etz = `Exp_chars ['+'; '-'; 'Z'; 'z'] in
|
||||
let etz_strict = `Exp_chars ['+'; '-'; 'Z'] in
|
||||
let edtsep = `Exp_chars ['T';'t';' '] in
|
||||
let edtsep_strict = `Exp_chars ['T'] in
|
||||
let p ?strict ?sub ?start ?len s = Ptime.of_rfc3339 ?strict ?sub ?start s in
|
||||
let err (s,e) err = Error (`RFC3339 ((s, e), err)) in
|
||||
let err_pos pos e = err (pos, pos) e in
|
||||
let ok s ~tz ~count = Ok (stamp_of_s s, tz, count) in
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:02.001953125Z")
|
||||
(ok ( 2. +. (1. /. (2. ** 9.))) ~tz:(Some 0) ~count:30);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:02.001953125-00:00")
|
||||
(ok ( 2. +. (1. /. (2. ** 9.))) ~tz:None ~count:35);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.001953125Z")
|
||||
(ok (-2. +. (1. /. (2. ** 9.))) ~tz:(Some 0) ~count:30);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.001953125-00:00")
|
||||
(ok (-2. +. (1. /. (2. ** 9.))) ~tz:None ~count:35);
|
||||
test_result ~__POS__
|
||||
(p "1969-13-31T23:59:58.5Z")
|
||||
(err (0, 21) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.Z")
|
||||
(err_pos 20 edigit);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.5")
|
||||
(err_pos 20 `Eoi);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.5a")
|
||||
(err_pos 21 etz);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.5Za")
|
||||
(err_pos 22 `Trailing_input);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31t23:59:58.5Z")
|
||||
(ok (-1.5) ~tz:(Some 0) ~count:22);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31 23:59:58.5z")
|
||||
(ok (-1.5) ~tz:(Some 0) ~count:22);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.5Z")
|
||||
(ok (-1.5) ~tz:(Some 0) ~count:22);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31a23:59:58.5Z")
|
||||
(err_pos 10 edtsep);
|
||||
test_result ~__POS__
|
||||
(p ~strict:true "1969-12-31 23:59:58.5Z")
|
||||
(err_pos 10 edtsep_strict);
|
||||
test_result ~__POS__
|
||||
(p ~strict:true "1969-12-31t23:59:58.5Z")
|
||||
(err_pos 10 edtsep_strict);
|
||||
test_result ~__POS__
|
||||
(p ~strict:true "1969-12-31T23:59:58.5z")
|
||||
(err_pos 21 etz_strict);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5+00:01")
|
||||
(ok (-59.5) ~tz:(Some 60) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5+01:01")
|
||||
(ok (-3659.5) ~tz:(Some 3660) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5-00:01")
|
||||
(ok (60.5) ~tz:(Some ~-60) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.00+01:01")
|
||||
(ok (-3660.00) ~tz:(Some 3660) ~count:28);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.25+01:01")
|
||||
(ok (-3659.75) ~tz:(Some 3660) ~count:28);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.25-00:01")
|
||||
(ok (60.25) ~tz:(Some ~-60) ~count:28);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00-23:59")
|
||||
(ok (86340.) ~tz:(Some ~-86340) ~count:25);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00-23:59")
|
||||
(ok (86340.) ~tz:(Some ~-86340) ~count:25);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00+23:59")
|
||||
(ok (-86340.) ~tz:(Some 86340) ~count:25);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00+23:59")
|
||||
(ok (-86340.) ~tz:(Some 86340) ~count:25);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5-01:01")
|
||||
(ok (3660.5) ~tz:(Some ~-3660) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5-24:01")
|
||||
(err (22, 23) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5-01:60")
|
||||
(err (25, 26) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p ~sub:true ~start:1 "X1969-12-31T23:59:58.5ZX")
|
||||
(ok (-1.5) ~tz:(Some 0) ~count:22);
|
||||
test_result ~__POS__
|
||||
(p ~start:1 "X1969-12-31T23:59:58.5ZX")
|
||||
(err_pos 23 `Trailing_input);
|
||||
test_result ~__POS__
|
||||
(p "1969X12-31T23:59:58Z")
|
||||
(err_pos 4 (`Exp_chars ['-']));
|
||||
test_result ~__POS__
|
||||
(p "1969-12X31T23:59:58Z")
|
||||
(err_pos 7 (`Exp_chars ['-']));
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23X59:58Z")
|
||||
(err_pos 13 (`Exp_chars [':']));
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59X58Z")
|
||||
(err_pos 16 (`Exp_chars [':']));
|
||||
test_result ~__POS__
|
||||
(p ~strict:true "1969-12-31T23:59:58+00X00")
|
||||
(err_pos 22 (`Exp_chars [':']));
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58+00X00")
|
||||
(err_pos 22 `Trailing_input);
|
||||
test_result ~__POS__
|
||||
(p ~start:(-1) "1970-01-01")
|
||||
(err_pos (-1) `Eoi);
|
||||
test_result ~__POS__
|
||||
(p ~start:11 "1970-01-01")
|
||||
(err_pos 11 `Eoi);
|
||||
test_result ~__POS__
|
||||
(p "")
|
||||
(err_pos 0 `Eoi);
|
||||
test_result ~__POS__
|
||||
(p "0000-01-01T00:00:00+00:01")
|
||||
(err (0, 24) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "9999-12-31T23:59:59-00:01")
|
||||
(err (0, 24) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "1900-02-29T01:02:03Z")
|
||||
(err (0, 19) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "01-02-29T01:02:03Z")
|
||||
(err_pos 2 edigit);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.00+0101")
|
||||
(ok (-3660.00) ~tz:(Some 3660) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.00+01")
|
||||
(ok (-3600.00) ~tz:(Some 3600) ~count:25);
|
||||
()
|
||||
|
||||
let test_stamp_trips () =
|
||||
Test.test "random stamps to RFC 3339 round trips" @@ fun () ->
|
||||
let stamp_of_rfc3339 ?__POS__ s =
|
||||
Ptime.of_rfc3339 s |> Ptime.rfc3339_string_error |> Test.get_ok ?__POS__
|
||||
in
|
||||
let trip ?__POS__:pos ?tz_offset_s t =
|
||||
let back = stamp_of_s ?__POS__:pos (floor (Ptime.to_float_s t)) in
|
||||
let trip, tz, _ =
|
||||
stamp_of_rfc3339 ?__POS__:pos (Ptime.to_rfc3339 ?tz_offset_s t)
|
||||
in
|
||||
T.stamp ~__POS__ back trip;
|
||||
in
|
||||
for i = 1 to Rand.loop_len () do
|
||||
trip ~__POS__ ?tz_offset_s:(Some 0)(* UTC *) (Rand.float_stamp ());
|
||||
trip ~__POS__ ?tz_offset_s:None (* Unknown *) (Rand.float_stamp ());
|
||||
trip ~__POS__ ?tz_offset_s:(Some (Rand.tz_offset_s ()))
|
||||
(Rand.float_stamp ())
|
||||
done;
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_stamp_conversions ();
|
||||
test_parse ();
|
||||
test_stamp_trips ();
|
||||
()
|
||||
337
unikernel/duniverse/ptime/test/test_span.ml
Normal file
337
unikernel/duniverse/ptime/test/test_span.ml
Normal file
|
|
@ -0,0 +1,337 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let p s = Ptime.Span.of_d_ps s |> Test.get_some
|
||||
let n s = Ptime.Span.(neg (p s))
|
||||
let pps ps = p (0, ps)
|
||||
let nps ps = n (0, ps)
|
||||
|
||||
let test_conversions () =
|
||||
Test.test "span constants and conversions" @@ fun () ->
|
||||
(* Ints *)
|
||||
let trip_int ?__POS__ secs =
|
||||
Test.option ?__POS__ ~some:Test.Eq.int
|
||||
Ptime.Span.(to_int_s (of_int_s secs)) (Some secs)
|
||||
in
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s 0) Ptime.Span.zero;
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s 1) (pps 1_000_000_000_000L);
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s (-1)) (nps 1_000_000_000_000L);
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s 86_400) (p (1, 0L));
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s (-86_400)) (n (1, 0L));
|
||||
trip_int ~__POS__ (86_400);
|
||||
trip_int ~__POS__ (-86_400);
|
||||
trip_int ~__POS__ (234_322_342);
|
||||
trip_int ~__POS__ (-234_322_352);
|
||||
trip_int ~__POS__ (1);
|
||||
trip_int ~__POS__ (-1);
|
||||
trip_int ~__POS__ (0);
|
||||
(* Floats *)
|
||||
let trip_float ?__POS__ secs =
|
||||
let of_float secs = Ptime.Span.of_float_s secs |> Test.get_some ?__POS__ in
|
||||
Test.float ?__POS__ (Ptime.Span.to_float_s (of_float secs)) secs
|
||||
in
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s 1.0000000000005) (Some (pps 1_000_000_000_000L));
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (-1.0000000000005)) (Some (nps 1_000_000_000_000L));
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s 0.) (Some Ptime.Span.zero);
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (min_float)) (Some Ptime.Span.zero);
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (-.min_float))(Some Ptime.Span.zero);
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s max_float) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (-.max_float)) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s nan) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s infinity) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (-.infinity)) None;
|
||||
trip_float ~__POS__ 0.;
|
||||
trip_float ~__POS__ (-0.);
|
||||
trip_float ~__POS__ 1.;
|
||||
trip_float ~__POS__ (-1.);
|
||||
trip_float ~__POS__ (float (1 lsl 30 - 1));
|
||||
trip_float ~__POS__ (float (- (1 lsl 30)));
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_d_ps (23, -1L)) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_d_ps (23, 86_400_000_000_000_000L)) None;
|
||||
()
|
||||
|
||||
let test_predicates () =
|
||||
Test.test "span predicates" @@ fun () ->
|
||||
Test.bool ~__POS__ (Ptime.Span.equal Ptime.Span.zero Ptime.Span.zero) true;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal Ptime.Span.zero (pps 1L)) false;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal Ptime.Span.zero (nps 1L)) false;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (p (30, 3434L)) (p (30, 3434L))) true;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (p (30, 3434L)) (p (30, 3435L))) false;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (n (30, 3434L)) (n (30, 3434L))) true;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (n (30, 3434L)) (n (30, 3435L))) false;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (n (30, 3434L)) (p (30, 3434L))) false;
|
||||
Test.int ~__POS__ (Ptime.Span.compare Ptime.Span.zero Ptime.Span.zero) 0;
|
||||
Test.int ~__POS__ (Ptime.Span.compare Ptime.Span.zero (pps 1L)) (-1);
|
||||
Test.int ~__POS__ (Ptime.Span.compare Ptime.Span.zero (nps 1L)) 1;
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (n (30, 3434L))) 0;
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (n (30, 3435L))) 1;
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (p (30, 3435L))) (-1);
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (n (30, 3433L))) (-1);
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (p (30, 3433L))) (-1);
|
||||
()
|
||||
|
||||
let test_arithmetic () =
|
||||
Test.test "span arithmetic" @@ fun () ->
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.add (pps 86_399_999_999_999_999L) (pps 1L)) (p (1, 0L));
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.add (nps 86_399_999_999_999_999L) (nps 1L)) (n (1, 0L));
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.sub Ptime.Span.zero (pps 1L)) (nps 1L);
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.sub Ptime.Span.zero (nps 1L)) (pps 1L);
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.add (nps 1L) (pps 1L)) Ptime.Span.zero;
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.abs (n (3, 342L))) (p (3, 342L));
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.abs (p (3, 342L))) (p (3, 342L));
|
||||
()
|
||||
|
||||
let test_rounding () =
|
||||
Test.test "span rounding" @@ fun () ->
|
||||
let r ~frac a b =
|
||||
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (3, b));
|
||||
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (3, b))
|
||||
in
|
||||
let r_carry ~frac a =
|
||||
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (4, 0L));
|
||||
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (4, 0L))
|
||||
in
|
||||
let t ~frac a b =
|
||||
T.span ~__POS__ (Ptime.Span.truncate ~frac_s:frac (p (3, a))) (p (3, b));
|
||||
T.span ~__POS__ (Ptime.Span.truncate ~frac_s:frac (n (3, a))) (n (3, b))
|
||||
in
|
||||
for i = 0 to 12 do r ~frac:i 0L 0L done;
|
||||
r_carry ~frac:(-1) 86_399_500_000_000_000L;
|
||||
r_carry ~frac:0 86_399_500_000_000_000L;
|
||||
r ~frac:0 86_399_499_999_999_999L 86_399_000_000_000_000L;
|
||||
r ~frac:0 10_001_500_000_000_000L 10_002_000_000_000_000L;
|
||||
r ~frac:0 10_001_499_999_999_999L 10_001_000_000_000_000L;
|
||||
r_carry ~frac:1 86_399_950_000_000_000L;
|
||||
r ~frac:1 86_399_949_999_999_999L 86_399_900_000_000_000L;
|
||||
r ~frac:1 10_001_150_000_000_000L 10_001_200_000_000_000L;
|
||||
r ~frac:1 10_001_149_999_999_999L 10_001_100_000_000_000L;
|
||||
r_carry ~frac:2 86_399_995_000_000_000L;
|
||||
r ~frac:2 86_399_994_999_999_999L 86_399_990_000_000_000L;
|
||||
r ~frac:2 10_001_115_000_000_000L 10_001_120_000_000_000L;
|
||||
r ~frac:2 10_001_114_999_999_999L 10_001_110_000_000_000L;
|
||||
r_carry ~frac:3 86_399_999_500_000_000L;
|
||||
r ~frac:3 86_399_999_499_999_999L 86_399_999_000_000_000L;
|
||||
r ~frac:3 10_001_111_500_000_000L 10_001_112_000_000_000L;
|
||||
r ~frac:3 10_001_111_499_999_999L 10_001_111_000_000_000L;
|
||||
r_carry ~frac:4 86_399_999_950_000_000L;
|
||||
r ~frac:4 86_399_999_949_999_999L 86_399_999_900_000_000L;
|
||||
r ~frac:4 10_001_111_150_000_000L 10_001_111_200_000_000L;
|
||||
r ~frac:4 10_001_111_149_999_999L 10_001_111_100_000_000L;
|
||||
r_carry ~frac:5 86_399_999_995_000_000L;
|
||||
r ~frac:5 86_399_999_994_999_999L 86_399_999_990_000_000L;
|
||||
r ~frac:5 10_001_111_115_000_000L 10_001_111_120_000_000L;
|
||||
r ~frac:5 10_001_111_114_999_999L 10_001_111_110_000_000L;
|
||||
r_carry ~frac:6 86_399_999_999_500_000L;
|
||||
r ~frac:6 86_399_999_999_499_999L 86_399_999_999_000_000L;
|
||||
r ~frac:6 10_001_111_111_500_000L 10_001_111_112_000_000L;
|
||||
r ~frac:6 10_001_111_111_499_999L 10_001_111_111_000_000L;
|
||||
r_carry ~frac:7 86_399_999_999_950_000L;
|
||||
r ~frac:7 86_399_999_999_949_999L 86_399_999_999_900_000L;
|
||||
r ~frac:7 10_001_111_111_150_000L 10_001_111_111_200_000L;
|
||||
r ~frac:7 10_001_111_111_149_999L 10_001_111_111_100_000L;
|
||||
r_carry ~frac:8 86_399_999_999_995_000L;
|
||||
r ~frac:8 86_399_999_999_994_999L 86_399_999_999_990_000L;
|
||||
r ~frac:8 10_001_111_111_115_000L 10_001_111_111_120_000L;
|
||||
r ~frac:8 10_001_111_111_114_999L 10_001_111_111_110_000L;
|
||||
r_carry ~frac:9 86_399_999_999_999_500L;
|
||||
r ~frac:9 86_399_999_999_999_499L 86_399_999_999_999_000L;
|
||||
r ~frac:9 10_001_111_111_111_500L 10_001_111_111_112_000L;
|
||||
r ~frac:9 10_001_111_111_111_499L 10_001_111_111_111_000L;
|
||||
r_carry ~frac:10 86_399_999_999_999_950L;
|
||||
r ~frac:10 86_399_999_999_999_949L 86_399_999_999_999_900L;
|
||||
r ~frac:10 10_001_111_111_111_150L 10_001_111_111_111_200L;
|
||||
r ~frac:10 10_001_111_111_111_149L 10_001_111_111_111_100L;
|
||||
r_carry ~frac:11 86_399_999_999_999_995L;
|
||||
r ~frac:11 86_399_999_999_999_994L 86_399_999_999_999_990L;
|
||||
r ~frac:11 10_001_111_111_111_115L 10_001_111_111_111_120L;
|
||||
r ~frac:11 10_001_111_111_111_114L 10_001_111_111_111_110L;
|
||||
r ~frac:12 86_399_999_999_999_999L 86_399_999_999_999_999L;
|
||||
r ~frac:12 10_001_111_111_111_115L 10_001_111_111_111_115L;
|
||||
r ~frac:12 10_001_111_111_111_114L 10_001_111_111_111_114L;
|
||||
r ~frac:13 10_001_111_111_111_114L 10_001_111_111_111_114L;
|
||||
for i = 0 to 12 do t ~frac:i 0L 0L done;
|
||||
t ~frac:(-1) 86_399_999_999_999_999L 86_399_000_000_000_000L;
|
||||
t ~frac:0 86_399_999_999_999_999L 86_399_000_000_000_000L;
|
||||
t ~frac:1 86_399_999_999_999_999L 86_399_900_000_000_000L;
|
||||
t ~frac:2 86_399_999_999_999_999L 86_399_990_000_000_000L;
|
||||
t ~frac:3 86_399_999_999_999_999L 86_399_999_000_000_000L;
|
||||
t ~frac:4 86_399_999_999_999_999L 86_399_999_900_000_000L;
|
||||
t ~frac:5 86_399_999_999_999_999L 86_399_999_990_000_000L;
|
||||
t ~frac:6 86_399_999_999_999_999L 86_399_999_999_000_000L;
|
||||
t ~frac:7 86_399_999_999_999_999L 86_399_999_999_900_000L;
|
||||
t ~frac:8 86_399_999_999_999_999L 86_399_999_999_990_000L;
|
||||
t ~frac:9 86_399_999_999_999_999L 86_399_999_999_999_000L;
|
||||
t ~frac:10 86_399_999_999_999_999L 86_399_999_999_999_900L;
|
||||
t ~frac:11 86_399_999_999_999_999L 86_399_999_999_999_990L;
|
||||
t ~frac:12 86_399_999_999_999_999L 86_399_999_999_999_999L;
|
||||
t ~frac:13 86_399_999_999_999_999L 86_399_999_999_999_999L;
|
||||
()
|
||||
|
||||
let test_pretty_printing () =
|
||||
Test.test "span retty printing" @@ fun () ->
|
||||
let fmt s = Format.asprintf "%a" Ptime.Span.pp s in
|
||||
let n s = fmt @@ Ptime.Span.(neg (p s)) in
|
||||
let p s = fmt @@ p s in
|
||||
let pps ps = p (0, ps) in
|
||||
let nps ps = n (0, ps) in
|
||||
(* y d *)
|
||||
Test.string ~__POS__ (p (366, 0L)) "1y1d";
|
||||
Test.string ~__POS__ (n (366, 0L)) "-1y1d";
|
||||
Test.string ~__POS__ (p (1461, 0L)) "4y";
|
||||
Test.string ~__POS__ (n (1461, 0L)) "-4y";
|
||||
Test.string ~__POS__ (p (1461, 43_200_000_000_000_000L)) "4y1d";
|
||||
Test.string ~__POS__ (n (1461, 43_200_000_000_000_000L)) "-4y1d";
|
||||
Test.string ~__POS__ (p (1461, 43_199_199_199_199_199L)) "4y";
|
||||
Test.string ~__POS__ (n (1461, 43_199_199_199_199_199L)) "-4y";
|
||||
Test.string ~__POS__ (p (1462, 43_200_000_000_000_000L)) "4y2d";
|
||||
Test.string ~__POS__ (n (1462, 43_200_000_000_000_000L)) "-4y2d";
|
||||
Test.string ~__POS__ (p (1462, 43_199_199_199_199_199L)) "4y1d";
|
||||
Test.string ~__POS__ (n (1462, 43_199_199_199_199_199L)) "-4y1d";
|
||||
(* d h *)
|
||||
Test.string ~__POS__ (p (365, 84_600_000_000_000_000L)) "1y1d";
|
||||
Test.string ~__POS__ (n (365, 84_600_000_000_000_000L)) "-1y1d";
|
||||
Test.string ~__POS__ (p (365, 84_599_999_999_999_999L)) "1y";
|
||||
Test.string ~__POS__ (n (365, 84_599_999_999_999_999L)) "-1y";
|
||||
Test.string ~__POS__ (p (365, 19_800_000_000_000_000L)) "1y";
|
||||
Test.string ~__POS__ (n (365, 19_800_000_000_000_000L)) "-1y";
|
||||
Test.string ~__POS__ (p (365, 19_799_999_999_999_999L)) "365d5h";
|
||||
Test.string ~__POS__ (n (365, 19_799_999_999_999_999L)) "-365d5h";
|
||||
Test.string ~__POS__ (p (1, 84_600_000_000_000_000L)) "2d";
|
||||
Test.string ~__POS__ (n (1, 84_600_000_000_000_000L)) "-2d";
|
||||
Test.string ~__POS__ (p (1, 84_599_999_999_999_999L)) "1d23h";
|
||||
Test.string ~__POS__ (n (1, 84_599_999_999_999_999L)) "-1d23h";
|
||||
Test.string ~__POS__ (p (2, 0L)) "2d";
|
||||
Test.string ~__POS__ (n (2, 0L)) "-2d";
|
||||
(* h m *)
|
||||
Test.string ~__POS__ (pps 86_370_000_000_000_000L) "1d";
|
||||
Test.string ~__POS__ (nps 86_370_000_000_000_000L) "-1d";
|
||||
Test.string ~__POS__ (pps 86_369_999_999_999_999L) "23h59min";
|
||||
Test.string ~__POS__ (nps 86_369_999_999_999_999L) "-23h59min";
|
||||
Test.string ~__POS__ (pps 3660_000_000_000_000L) "1h1min";
|
||||
Test.string ~__POS__ (nps 3660_000_000_000_000L) "-1h1min";
|
||||
Test.string ~__POS__ (pps 3630_000_000_000_000L) "1h1min";
|
||||
Test.string ~__POS__ (pps 3629_999_999_999_999L) "1h";
|
||||
Test.string ~__POS__ (nps 3629_999_999_999_999L) "-1h";
|
||||
Test.string ~__POS__ (pps 3600_000_000_000_000L) "1h";
|
||||
Test.string ~__POS__ (nps 3600_000_000_000_000L) "-1h";
|
||||
(* m s *)
|
||||
Test.string ~__POS__ (pps 3599_500_000_000_000L) "1h";
|
||||
Test.string ~__POS__ (nps 3599_500_000_000_000L) "-1h";
|
||||
Test.string ~__POS__ (pps 3599_499_999_999_999L) "59min59s";
|
||||
Test.string ~__POS__ (nps 3599_499_999_999_999L) "-59min59s";
|
||||
Test.string ~__POS__ (pps 60_500_000_000_000L) "1min1s";
|
||||
Test.string ~__POS__ (nps 60_500_000_000_000L) "-1min1s";
|
||||
Test.string ~__POS__ (pps 60_499_000_000_000L) "1min";
|
||||
Test.string ~__POS__ (nps 60_499_000_000_000L) "-1min";
|
||||
Test.string ~__POS__ (pps 60_000_000_000_000L) "1min";
|
||||
Test.string ~__POS__ (nps 60_000_000_000_000L) "-1min";
|
||||
(* s *)
|
||||
Test.string ~__POS__ (pps 59_999_500_000_000L) "1min";
|
||||
Test.string ~__POS__ (nps 59_999_500_000_000L) "-1min";
|
||||
Test.string ~__POS__ (pps 59_999_499_999_999L) "59.999s";
|
||||
Test.string ~__POS__ (nps 59_999_499_999_999L) "-59.999s";
|
||||
Test.string ~__POS__ (pps 1_999_500_000_000L) "2s";
|
||||
Test.string ~__POS__ (nps 1_999_500_000_000L) "-2s";
|
||||
Test.string ~__POS__ (pps 1_999_499_999_999L) "1.999s";
|
||||
Test.string ~__POS__ (nps 1_999_499_999_999L) "-1.999s";
|
||||
Test.string ~__POS__ (pps 1_534_500_000_000L) "1.535s";
|
||||
Test.string ~__POS__ (nps 1_534_500_000_000L) "-1.535s";
|
||||
Test.string ~__POS__ (pps 1_534_499_999_999L) "1.534s";
|
||||
Test.string ~__POS__ (nps 1_534_499_999_999L) "-1.534s";
|
||||
Test.string ~__POS__ (pps 1_000_000_000_000L) "1s";
|
||||
Test.string ~__POS__ (nps 1_000_000_000_000L) "-1s";
|
||||
Test.string ~__POS__ (pps 1_136_000_000_000L) "1.136s";
|
||||
Test.string ~__POS__ (nps 1_136_000_000_000L) "-1.136s";
|
||||
Test.string ~__POS__ (pps 1_036_000_000_000L) "1.036s";
|
||||
Test.string ~__POS__ (nps 1_036_000_000_000L) "-1.036s";
|
||||
(* ms *)
|
||||
Test.string ~__POS__ (pps 999_500_000_000L) "1s";
|
||||
Test.string ~__POS__ (nps 999_500_000_000L) "-1s";
|
||||
Test.string ~__POS__ (pps 999_499_999_999L) "999ms";
|
||||
Test.string ~__POS__ (nps 999_499_999_999L) "-999ms";
|
||||
Test.string ~__POS__ (pps 1_999_500_000L) "2ms";
|
||||
Test.string ~__POS__ (nps 1_999_500_000L) "-2ms";
|
||||
Test.string ~__POS__ (pps 1_999_499_999L) "1.999ms";
|
||||
Test.string ~__POS__ (nps 1_999_499_999L) "-1.999ms";
|
||||
Test.string ~__POS__ (pps 1_332_500_000L) "1.333ms";
|
||||
Test.string ~__POS__ (nps 1_332_500_000L) "-1.333ms";
|
||||
Test.string ~__POS__ (pps 1_332_499_999L) "1.332ms";
|
||||
Test.string ~__POS__ (nps 1_332_499_999L) "-1.332ms";
|
||||
Test.string ~__POS__ (pps 1_036_000_000L) "1.036ms";
|
||||
Test.string ~__POS__ (nps 1_036_000_000L) "-1.036ms";
|
||||
Test.string ~__POS__ (pps 1_000_000_000L) "1ms";
|
||||
Test.string ~__POS__ (nps 1_000_000_000L) "-1ms";
|
||||
(* us *)
|
||||
Test.string ~__POS__ (pps 999_500_000L) "1ms";
|
||||
Test.string ~__POS__ (nps 999_500_000L) "-1ms";
|
||||
Test.string ~__POS__ (pps 999_499_999L) "999us";
|
||||
Test.string ~__POS__ (nps 999_499_999L) "-999us";
|
||||
Test.string ~__POS__ (pps 1_999_500L) "2us";
|
||||
Test.string ~__POS__ (nps 1_999_500L) "-2us";
|
||||
Test.string ~__POS__ (pps 1_999_499L) "1.999us";
|
||||
Test.string ~__POS__ (nps 1_999_499L) "-1.999us";
|
||||
Test.string ~__POS__ (pps 1_332_500L) "1.333us";
|
||||
Test.string ~__POS__ (nps 1_332_500L) "-1.333us";
|
||||
Test.string ~__POS__ (pps 1_332_499L) "1.332us";
|
||||
Test.string ~__POS__ (nps 1_332_499L) "-1.332us";
|
||||
Test.string ~__POS__ (pps 1_036_000L) "1.036us";
|
||||
Test.string ~__POS__ (nps 1_036_000L) "-1.036us";
|
||||
Test.string ~__POS__ (pps 1_000_000L) "1us";
|
||||
Test.string ~__POS__ (nps 1_000_000L) "-1us";
|
||||
(* ns *)
|
||||
Test.string ~__POS__ (pps 999_500L) "1us";
|
||||
Test.string ~__POS__ (nps 999_500L) "-1us";
|
||||
Test.string ~__POS__ (pps 999_499L) "999ns";
|
||||
Test.string ~__POS__ (nps 999_499L) "-999ns";
|
||||
Test.string ~__POS__ (pps 1_995L) "1.995ns";
|
||||
Test.string ~__POS__ (nps 1_995L) "-1.995ns";
|
||||
Test.string ~__POS__ (pps 1_994L) "1.994ns";
|
||||
Test.string ~__POS__ (nps 1_994L) "-1.994ns";
|
||||
Test.string ~__POS__ (pps 1_332L) "1.332ns";
|
||||
Test.string ~__POS__ (nps 1_332L) "-1.332ns";
|
||||
Test.string ~__POS__ (pps 1_036L) "1.036ns";
|
||||
Test.string ~__POS__ (nps 1_036L) "-1.036ns";
|
||||
Test.string ~__POS__ (pps 1_000L) "1ns";
|
||||
Test.string ~__POS__ (nps 1_000L) "-1ns";
|
||||
(* ps *)
|
||||
Test.string ~__POS__ (pps 999L) "999ps";
|
||||
Test.string ~__POS__ (nps 999L) "-999ps";
|
||||
Test.string ~__POS__ (pps 50L) "50ps";
|
||||
Test.string ~__POS__ (nps 50L) "-50ps";
|
||||
Test.string ~__POS__ (pps 1L) "1ps";
|
||||
Test.string ~__POS__ (nps 1L) "-1ps";
|
||||
Test.string ~__POS__ (pps 0L) "0ps";
|
||||
Test.string ~__POS__ (nps 0L) "0ps";
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_conversions ();
|
||||
test_predicates ();
|
||||
test_arithmetic ();
|
||||
test_rounding ();
|
||||
test_pretty_printing ();
|
||||
()
|
||||
139
unikernel/duniverse/ptime/test/testing_ptime.ml
Normal file
139
unikernel/duniverse/ptime/test/testing_ptime.ml
Normal file
|
|
@ -0,0 +1,139 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Ptime test unit comonalities *)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
|
||||
module T = struct
|
||||
|
||||
(* Time spans *)
|
||||
|
||||
let eq_raw_span =
|
||||
let raw_span ppf (d, ps) = Fmt.pf ppf "@[<1>(%d,@ %Ld)@]" d ps in
|
||||
Test.Eq.make ~pp:raw_span ()
|
||||
|
||||
let raw_span ?__POS__ = Test.eq ?__POS__ eq_raw_span
|
||||
|
||||
let eq_span = Test.Eq.make ~equal:Ptime.Span.equal ~pp:Ptime.Span.dump ()
|
||||
let span ?__POS__ = Test.eq ?__POS__ eq_span
|
||||
let span_option ?__POS__ = Test.option ?__POS__ ~some:eq_span
|
||||
|
||||
(* Timestamps *)
|
||||
|
||||
let eq_stamp = Test.Eq.make ~equal:Ptime.equal ~pp:Ptime.dump ()
|
||||
let stamp ?__POS__ = Test.eq ?__POS__ eq_stamp
|
||||
let stamp_option ?__POS__ = Test.option ?__POS__ ~some:eq_stamp
|
||||
|
||||
(* Dates *)
|
||||
|
||||
module Date = struct
|
||||
type t = Ptime.date
|
||||
let equal = ( = )
|
||||
let pp ppf (y,m,d) = Fmt.pf ppf "(%d, %d, %d)" y m d
|
||||
end
|
||||
|
||||
let date ?__POS__ = Test.eq ?__POS__ (module Date)
|
||||
|
||||
(* Date time *)
|
||||
|
||||
module Date_time = struct
|
||||
type t = Ptime.date * Ptime.time
|
||||
let equal = ( = )
|
||||
let pp ppf ((y, m, d), ((hh, mm, ss), tz)) =
|
||||
Fmt.pf ppf "(%d, %d, %d), ((%d, %d, %d), %d)" y m d hh mm ss tz
|
||||
end
|
||||
|
||||
let date_time ?__POS__ = Test.eq ?__POS__ (module Date_time)
|
||||
|
||||
let gmtime_to_date_time t =
|
||||
let t = Ptime.to_float_s t in
|
||||
let t = floor t (* see https://github.com/ocaml/ocaml/issues/6921 *) in
|
||||
let tm = Unix.gmtime t in
|
||||
let d = (tm.Unix.tm_year + 1900), (tm.Unix.tm_mon + 1), (tm.Unix.tm_mday) in
|
||||
let t = tm.Unix.tm_hour, tm.Unix.tm_min, tm.Unix.tm_sec in
|
||||
(d, (t, 0)), tm.Unix.tm_wday
|
||||
|
||||
let date_time_gmtime_witness ?__POS__:pos t =
|
||||
let fail ?__POS__ n ~checks:_ =
|
||||
Test.log_fail ?__POS__ "On stamp %g" (Ptime.to_float_s t)
|
||||
in
|
||||
Test.block ?__POS__:pos ~fail @@ fun () ->
|
||||
let dt, wday = gmtime_to_date_time t in
|
||||
let ut = Ptime.to_date_time t in
|
||||
Test.eq ~__POS__ (module Date_time) dt ut;
|
||||
Test.int ~__POS__ (Ptime.weekday_num t) wday
|
||||
end
|
||||
|
||||
module Rand = struct
|
||||
|
||||
(* Random loop length *)
|
||||
|
||||
let loop_len = ref 100_000
|
||||
let loop_len () = !loop_len
|
||||
|
||||
(* Random Ptime-valid stamps from floats *)
|
||||
|
||||
let float_stamp_range min max =
|
||||
let bound = max -. min in
|
||||
fun () ->
|
||||
let r = Random.State.float (Test.Rand.state ()) bound (* inclusive *) in
|
||||
let stamp = min +. r in
|
||||
match Ptime.(of_float_s stamp) with
|
||||
| None -> Fmt.failwith "cannot convert valid random stamp %f" stamp
|
||||
| Some t -> t
|
||||
|
||||
let float_stamp_32bits =
|
||||
let min_stamp = Int32.(to_float min_int) in
|
||||
let max_stamp = Int32.(to_float max_int) in
|
||||
float_stamp_range min_stamp max_stamp
|
||||
|
||||
let float_stamp : unit -> Ptime.t =
|
||||
let min_stamp = Ptime.(to_float_s min) in
|
||||
let max_stamp = Ptime.(to_float_s max) in
|
||||
float_stamp_range min_stamp max_stamp
|
||||
|
||||
let stamp =
|
||||
if Sys.word_size = 32 then float_stamp_32bits else float_stamp
|
||||
|
||||
(* Random Ptime-valid dates *)
|
||||
|
||||
let date : unit -> (int * int * int) =
|
||||
let month_len = [|31; 28; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31 |] in
|
||||
let is_leap y = (y mod 4 = 0) && (y mod 100 <> 0 || y mod 400 = 0) in
|
||||
fun () ->
|
||||
let rstate = Test.Rand.state () in
|
||||
let rint bound = Random.State.int rstate bound in
|
||||
let y = rint 10_000 in
|
||||
let m = 1 + rint 11 in
|
||||
let m_len = if (m = 2 && is_leap y) then 29 else month_len.(m - 1) in
|
||||
let d = 1 + rint m_len in
|
||||
(y, m, d)
|
||||
|
||||
(* Random times *)
|
||||
|
||||
let tz_interval_s = (1 lsl 30 - 1) (* max of Random.int *)
|
||||
let tz_offset_s : unit -> int =
|
||||
fun () ->
|
||||
let rstate = Test.Rand.state () in
|
||||
(* N.B. We don't cover the whole spectrum *)
|
||||
(Random.State.int rstate tz_interval_s) - (tz_interval_s / 2)
|
||||
|
||||
let min_tz_interval_s = 2000
|
||||
let min_tz_offset_s : unit -> int =
|
||||
fun () ->
|
||||
let rstate = Test.Rand.state () in
|
||||
((Random.State.int rstate min_tz_interval_s) - (min_tz_interval_s / 2)) * 60
|
||||
|
||||
let time : unit -> (int * int * int) =
|
||||
fun () ->
|
||||
let rstate = Test.Rand.state () in
|
||||
let rint bound = Random.State.int rstate bound in
|
||||
let hh = rint 24 in
|
||||
let mm = rint 60 in
|
||||
let ss = rint 61 in
|
||||
(hh, mm, ss)
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue