277 lines
10 KiB
OCaml
277 lines
10 KiB
OCaml
|
(*---------------------------------------------------------------------------
|
||
|
|
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 ();
|
||
|
|
()
|