My working unpac space for OCaml projects in development
Merge opam/patches/ptime
+3577
+1
vendor/opam/ptime/.ocp-indent
+1
vendor/opam/ptime/.ocp-indent
···
1
+
strict_with=always,match_clause=4,strict_else=never
+93
vendor/opam/ptime/B0.ml
+93
vendor/opam/ptime/B0.ml
···
1
+
open B0_kit.V000
2
+
open Result.Syntax
3
+
4
+
(* OCaml library names *)
5
+
6
+
let b0_std = B0_ocaml.libname "b0.std"
7
+
let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel"
8
+
let unix = B0_ocaml.libname "unix"
9
+
10
+
let ptime = B0_ocaml.libname "ptime"
11
+
let ptime_clock = B0_ocaml.libname "ptime.clock"
12
+
let ptime_clock_os = B0_ocaml.libname "ptime.clock.os"
13
+
let ptime_top = B0_ocaml.libname "ptime.top"
14
+
15
+
(* Libraries *)
16
+
17
+
let ptime_lib =
18
+
let srcs = [`Dir ~/"src"; `X ~/"src/ptime_top_init.ml" ] in
19
+
B0_ocaml.lib ptime ~srcs
20
+
21
+
let ptime_clock_lib =
22
+
let srcs = [`Dir ~/"src/clock"] in
23
+
B0_ocaml.lib ptime_clock ~srcs ~requires:[ptime] ~exports:[ptime]
24
+
25
+
let ptime_clock_os_lib =
26
+
B0_ocaml.deprecated_lib ~exports:[ptime_clock] ptime_clock_os
27
+
28
+
let ptime_top_lib =
29
+
let srcs = [`Dir ~/"src/top"] in
30
+
B0_ocaml.lib ptime_top ~srcs ~requires:[ptime; compiler_libs_toplevel]
31
+
32
+
(* Tests *)
33
+
34
+
let test ?(requires = []) =
35
+
B0_ocaml.test ~requires:(ptime :: b0_std :: requires)
36
+
37
+
let testing_ptime = `File ~/"test/testing_ptime.ml"
38
+
39
+
let test_ptime =
40
+
let srcs =
41
+
[ testing_ptime;
42
+
`File ~/"test/test_span.ml"; `File ~/"test/test_base.ml";
43
+
`File ~/"test/test_date.ml"; `File ~/"test/test_date_time.ml";
44
+
`File ~/"test/test_rfc3339.ml"; `File ~/"test/test_ptime.ml" ]
45
+
in
46
+
test ~/"test/test_ptime.ml" ~srcs ~requires:[unix]
47
+
48
+
let test_gmtime =
49
+
let doc = "Test stamps against Unix.gmtime" in
50
+
let srcs = [testing_ptime] in
51
+
test ~/"test/test_gmtime.ml" ~srcs ~requires:[unix] ~doc
52
+
53
+
let min_clock =
54
+
let doc = "Minimal clock example" in
55
+
test ~/"test/min_clock.ml" ~run:false ~doc ~requires:[ptime_clock]
56
+
57
+
(* FIXME b0 this makes the whole build bytecode. *)
58
+
(* let min_clock_jsoo =
59
+
let doc = "Minimal clock example in JavaScript" in
60
+
let srcs = [`File ~/"test/min_clock.ml"] in
61
+
let meta = B0_meta.(empty |> tag test) in
62
+
let requires = [ptime; ptime_clock] in
63
+
B0_jsoo.html_page "min-clock-jsoo" ~doc ~srcs ~meta ~requires *)
64
+
65
+
let examples =
66
+
test ~/"test/examples.ml" ~run:false ~doc:"Examples from the API docs"
67
+
68
+
(* Packs *)
69
+
70
+
let default =
71
+
let meta =
72
+
B0_meta.empty
73
+
|> ~~ B0_meta.authors ["The ptime programmers"]
74
+
|> ~~ B0_meta.maintainers ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
75
+
|> ~~ B0_meta.homepage "https://erratique.ch/software/ptime"
76
+
|> ~~ B0_meta.online_doc "https://erratique.ch/software/ptime/doc/"
77
+
|> ~~ B0_meta.licenses ["ISC"]
78
+
|> ~~ B0_meta.repo "git+https://erratique.ch/repos/ptime.git"
79
+
|> ~~ B0_meta.issues "https://github.com/dbuenzli/ptime/issues"
80
+
|> ~~ B0_meta.description_tags ["time"; "posix"; "system"; "org:erratique"]
81
+
|> ~~ B0_opam.depends
82
+
[ "ocaml", {|>= "4.08.0"|};
83
+
"ocamlfind", {|build|};
84
+
"ocamlbuild", {|build & != "0.9.0"|};
85
+
"topkg", {|build & >= "1.1.0"|};
86
+
]
87
+
|> ~~ B0_opam.build
88
+
{|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|}
89
+
|> B0_meta.tag B0_opam.tag
90
+
|> B0_meta.tag B0_release.tag
91
+
in
92
+
B0_pack.make "default" ~doc:"ptime package" ~meta ~locked:true @@
93
+
B0_unit.list ()
+1
vendor/opam/ptime/BRZO
+1
vendor/opam/ptime/BRZO
···
1
+
(srcs-x myocamlbuild.ml pkg test src/ptime_top_init.ml)
+102
vendor/opam/ptime/CHANGES.md
+102
vendor/opam/ptime/CHANGES.md
···
1
+
v1.2.0 2024-09-10 Zagreb
2
+
------------------------
3
+
4
+
- Fix fractional renderings of `Ptime.Span.pp` with leading zeros. For
5
+
example 1.036s would render as 1.36s. This is a *rendering* bug in a
6
+
function for human display, not a bug in the computations or
7
+
conversion functions of `Ptime`.
8
+
- Add `Ptime.weekday` type for naming the result of the `Ptime.weekday`
9
+
function.
10
+
- Regularize naming structure. The `ptime.clock.os` library is deprecated.
11
+
Use `ptime.clock` instead.
12
+
- Make the library `ptime.clock` export `ptime`.
13
+
14
+
v1.1.0 2022-12-02 Zagreb
15
+
------------------------
16
+
17
+
- `Ptime.of_rfc3339` timezone offset parsing. Be even more lenient
18
+
in non-strict parsing mode: allow `hhmm` and `hh` timezone offsets.
19
+
(strict is `hh:mm`). Allows to parse an even larger subset of
20
+
ISO 8601 than RFC 3339 (#31).
21
+
- Add `Ptime.{to,of}_year`. Less costly than extracting the first
22
+
component of `Ptime.to_date_time`. Useful for example to find
23
+
out which DST rules a timestamp is subjected to for rendering.
24
+
- Add `?tz_offset_s` optional argument to `Ptime.{of,to}_date` (#32).
25
+
- Add `Ptime.weekday_num`. An integer is often more convenient
26
+
than the enum value of `Ptime.weekday` (#30).
27
+
- Add `Ptime.rfc3339_string_error` convenience function.
28
+
- Use the new `js_of_ocaml` META `ocamlfind` standard to link
29
+
JavaScript stubs (#28).
30
+
- No longer install interfaces in the `ptime.clock` package,
31
+
this package is now empty.
32
+
33
+
v1.0.0 2022-02-16 La Forclaz
34
+
----------------------------
35
+
36
+
* Change the `js_of_ocaml` strategy for `Ptime_clock`'s JavaScript
37
+
implementation. Primitives of `ptime.clock.os` are now implemented
38
+
in pure JavaScript and linked by `js_of_ocaml`. This means that the
39
+
`ptime.clock.jsoo` library no longer exists, simply link against
40
+
`ptime.clock.os` instead. Thanks to Hugo Heuzard for suggesting and
41
+
implementing this.
42
+
43
+
* Require OCaml >= 4.08
44
+
* Correct a potential overflow in Ptime.Span.of_float_s (#26).
45
+
46
+
v0.8.6 2021-11-28 Zagreb
47
+
------------------------
48
+
49
+
* Require OCaml >= 4.03
50
+
* Drop dependency on `result` compatibility package.
51
+
* Alter install structure. `ptime/{os,jsoo}` are now installed in
52
+
`ptime/clock/{os,jsoo}`. Also a `ptime_clock.cm[t]i` is now
53
+
installed in `ptime/clock/`. The `ocamlfind` packages are unchanged
54
+
except for `ptime.clock.os.top` which no longer exists.
55
+
* Handle `Pervasives` deprecation.
56
+
* Fix `Ptime.truncate` to always truncate down. Thanks to David
57
+
Kaloper Meršinjak for the report & fix.
58
+
* Allow compiling with MSVC compiler. Thanks to Jonah Beckford for the
59
+
patch.
60
+
61
+
v0.8.5 2019-05-02 La Forclaz (VS)
62
+
---------------------------------
63
+
64
+
* Make the package compatible with `js_of_ocaml` 3.3.0's
65
+
namespacing
66
+
67
+
v0.8.4 2018-07-26 Zagreb
68
+
------------------------
69
+
70
+
* `Ptime_clock`: Windows support. Thanks to IndiscriminateCoding
71
+
and David Allsopp for the contribution.
72
+
* Fix `Ptime.frac_s` on pre-epoch time stamps. The function computed a
73
+
span of `1s - f` instead of `f` on these. This function is not used
74
+
internally so this only affects users of this function that apply it
75
+
on pre-epoch time stamps (#12). Thanks to David Kaloper Meršinjak
76
+
for the report.
77
+
78
+
v0.8.3 2017-02-05 La Forclaz (VS)
79
+
---------------------------------
80
+
81
+
* Fix package for -custom linking.
82
+
83
+
v0.8.2 2016-07-22 Zagreb
84
+
------------------------
85
+
86
+
* Add `?tz_offset_s` optional argument to `Ptime.weekday`. Thanks
87
+
to Maxence Guesdon for suggesting.
88
+
89
+
v0.8.1 2015-07-14 Cambridge (UK)
90
+
--------------------------------
91
+
92
+
* Add `Ptime.v` and `Ptime.Span.v` to safely deal with trusted
93
+
inputs. Thanks to Matt Gray for suggesting.
94
+
* Add `Ptime.weekday`, to help conversions to denormalized
95
+
timestamp formats. Thanks to Romain Calascibetta for suggesting.
96
+
* Build depend on topkg.
97
+
* Relicense from BSD3 to ISC.
98
+
99
+
v0.8.0 2015-12-24 Cambridge (UK)
100
+
--------------------------------
101
+
102
+
First release. Thanks to Raphaël Proust for lodging support.
+13
vendor/opam/ptime/LICENSE.md
+13
vendor/opam/ptime/LICENSE.md
···
1
+
Copyright (c) 2014 The ptime programmers
2
+
3
+
Permission to use, copy, modify, and/or distribute this software for any
4
+
purpose with or without fee is hereby granted, provided that the above
5
+
copyright notice and this permission notice appear in all copies.
6
+
7
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+47
vendor/opam/ptime/README.md
+47
vendor/opam/ptime/README.md
···
1
+
Ptime — POSIX time for OCaml
2
+
============================
3
+
4
+
Ptime has platform independent POSIX time support in pure OCaml. It
5
+
provides a type to represent a well-defined range of POSIX timestamps
6
+
with picosecond precision, conversion with date-time values,
7
+
conversion with [RFC 3339 timestamps][rfc3339] and pretty printing to
8
+
a human-readable, locale-independent representation.
9
+
10
+
The additional Ptime_clock library provides access to a system POSIX
11
+
clock and to the system's current time zone offset.
12
+
13
+
Ptime is not a calendar library.
14
+
15
+
Ptime has no dependency. Ptime_clock depends on your system library or
16
+
JavaScript runtime system. Ptime and its libraries are distributed
17
+
under the ISC license.
18
+
19
+
[rfc3339]: http://tools.ietf.org/html/rfc3339
20
+
21
+
Home page: <http://erratique.ch/software/ptime>
22
+
23
+
# Installation
24
+
25
+
Ptime can be installed with `opam`:
26
+
27
+
opam install ptime
28
+
29
+
If you don't use `opam` consult the [`opam`](opam) file for build
30
+
instructions.
31
+
32
+
# Documentation
33
+
34
+
The documentation can be consulted [online] or via `odig doc mtime`.
35
+
36
+
Questions are welcome but better asked on the [OCaml forum] than on
37
+
the issue tracker.
38
+
39
+
[online]: http://erratique.ch/software/ptime/doc/
40
+
[OCaml forum]: https://discuss.ocaml.org/
41
+
42
+
# Sample programs
43
+
44
+
See [test/min_clock.ml](test/min_clock.ml).
45
+
46
+
If you installed ptime with `opam` sample programs are located in
47
+
the directory `opam var ptime:doc`.
+26
vendor/opam/ptime/doc/index.mld
+26
vendor/opam/ptime/doc/index.mld
···
1
+
{0 Ptime {%html: <span class="version">%%VERSION%%</span>%}}
2
+
3
+
{!Ptime} has platform independent support for POSIX time.
4
+
5
+
It provides a {{!Ptime.t}type} to represent a well-defined range of
6
+
POSIX timestamps with picosecond precision, conversion with
7
+
{{!Ptime.date_time}date-time values}, conversion with
8
+
{{!Ptime.rfc3339}RFC 3339 timestamps} and {{!Ptime.print}pretty
9
+
printing} to a human-readable, locale-independent representation.
10
+
11
+
{!Ptime_clock} provides access to a
12
+
{{!Ptime_clock.platform_support}system POSIX clock} and the system's
13
+
current time zone offset.
14
+
15
+
Ptime is not a calendar library.
16
+
17
+
{1:ptime Library [ptime]}
18
+
19
+
{!modules: Ptime}
20
+
21
+
{1:ptime_clock Library [ptime.clock]}
22
+
23
+
{!modules: Ptime_clock}
24
+
25
+
This library also works with JavaScript,
26
+
see the {{!Ptime_clock.platform_support}platform support}.
+43
vendor/opam/ptime/myocamlbuild.ml
+43
vendor/opam/ptime/myocamlbuild.ml
···
1
+
open Ocamlbuild_plugin
2
+
open Command
3
+
4
+
let os = try Sys.getenv "PTIME_OS" with
5
+
| Not_found -> Ocamlbuild_pack.My_unix.run_and_read "uname -s"
6
+
7
+
let system_support_lib = match os with
8
+
| "Linux\n" -> [A "-cclib"; A "-lrt"]
9
+
| _ -> []
10
+
11
+
let lib s =
12
+
match !Ocamlbuild_plugin.Options.ext_lib with
13
+
| "" -> s ^ ".a"
14
+
| x -> s ^ "." ^ x
15
+
16
+
let () =
17
+
dispatch begin function
18
+
| After_rules ->
19
+
20
+
(* ptime *)
21
+
22
+
ocaml_lib ~tag_name:"use_ptime" ~dir:"src" "src/ptime";
23
+
24
+
(* ptime_clock *)
25
+
26
+
flag_and_dep ["link"; "ocaml"; "link_ptime_clock_stubs"]
27
+
(A (lib "src/clock/libptime_clock_stubs"));
28
+
29
+
dep ["record_ptime_clock_stubs"]
30
+
[lib "src/clock/libptime_clock_stubs"];
31
+
32
+
flag ["library"; "ocaml"; "byte"; "record_ptime_clock_stubs"]
33
+
(S ([A "-dllib"; A "-lptime_clock_stubs"] @ system_support_lib));
34
+
flag ["library"; "ocaml"; "record_ptime_clock_stubs"] (* byt + nat *)
35
+
(S ([A "-cclib"; A "-lptime_clock_stubs"] @ system_support_lib));
36
+
37
+
ocaml_lib ~tag_name:"use_ptime_clock" ~dir:"src-clock"
38
+
"src/clock/ptime_clock";
39
+
40
+
flag ["link"; "ocaml"; "use_ptime_clock"]
41
+
(S [A "-ccopt"; A "-Lsrc-clock"]);
42
+
| _ -> ()
43
+
end
+37
vendor/opam/ptime/opam
+37
vendor/opam/ptime/opam
···
1
+
opam-version: "2.0"
2
+
name: "ptime"
3
+
synopsis: "POSIX time for OCaml"
4
+
description: """\
5
+
Ptime has platform independent POSIX time support in pure OCaml. It
6
+
provides a type to represent a well-defined range of POSIX timestamps
7
+
with picosecond precision, conversion with date-time values,
8
+
conversion with [RFC 3339 timestamps][rfc3339] and pretty printing to
9
+
a human-readable, locale-independent representation.
10
+
11
+
The additional Ptime_clock library provides access to a system POSIX
12
+
clock and to the system's current time zone offset.
13
+
14
+
Ptime is not a calendar library.
15
+
16
+
Ptime has no dependency. Ptime_clock depends on your system library or
17
+
JavaScript runtime system. Ptime and its libraries are distributed
18
+
under the ISC license.
19
+
20
+
[rfc3339]: http://tools.ietf.org/html/rfc3339
21
+
22
+
Home page: <http://erratique.ch/software/ptime>"""
23
+
maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
24
+
authors: "The ptime programmers"
25
+
license: "ISC"
26
+
tags: ["time" "posix" "system" "org:erratique"]
27
+
homepage: "https://erratique.ch/software/ptime"
28
+
doc: "https://erratique.ch/software/ptime/doc/"
29
+
bug-reports: "https://github.com/dbuenzli/ptime/issues"
30
+
depends: [
31
+
"ocaml" {>= "4.08.0"}
32
+
"ocamlfind" {build}
33
+
"ocamlbuild" {build & != "0.9.0"}
34
+
"topkg" {build & >= "1.1.0"}
35
+
]
36
+
build: ["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]
37
+
dev-repo: "git+https://erratique.ch/repos/ptime.git"
+42
vendor/opam/ptime/pkg/META
+42
vendor/opam/ptime/pkg/META
···
1
+
description = "POSIX time for OCaml"
2
+
version = "%%VERSION_NUM%%"
3
+
requires = ""
4
+
archive(byte) = "ptime.cma"
5
+
archive(native) = "ptime.cmxa"
6
+
plugin(byte) = "ptime.cma"
7
+
plugin(native) = "ptime.cmxs"
8
+
exists_if = "ptime.cma ptime.cmxa"
9
+
10
+
package "clock" (
11
+
directory = "clock"
12
+
description = "The ptime.clock library"
13
+
version = "%%VERSION_NUM%%"
14
+
requires = "ptime"
15
+
exports = "ptime"
16
+
archive(byte) = "ptime_clock.cma"
17
+
archive(native) = "ptime_clock.cmxa"
18
+
plugin(byte) = "ptime_clock.cma"
19
+
plugin(native) = "ptime_clock.cmxs"
20
+
jsoo_runtime = "runtime.js"
21
+
exists_if = "ptime_clock.cma ptime_clock.cmxa"
22
+
23
+
package "os" (
24
+
description = "The ptime.clock.os library (deprecated)"
25
+
version = "%%VERSION_NUM%%"
26
+
requires = "ptime.clock"
27
+
exports = "ptime.clock"
28
+
warning = "Deprecated, use the ptime.clock library."
29
+
)
30
+
)
31
+
32
+
package "top" (
33
+
directory = "top"
34
+
description = "The ptime.top library"
35
+
version = "%%VERSION_NUM%%"
36
+
requires = "ptime"
37
+
archive(byte) = "ptime_top.cma"
38
+
archive(native) = "ptime_top.cmxa"
39
+
plugin(byte) = "ptime_top.cma"
40
+
plugin(native) = "ptime_top.cmxs"
41
+
exists_if = "ptime_top.cma ptime_top.cmxa"
42
+
)
+15
vendor/opam/ptime/pkg/pkg.ml
+15
vendor/opam/ptime/pkg/pkg.ml
···
1
+
#!/usr/bin/env ocaml
2
+
#use "topfind"
3
+
#require "topkg"
4
+
open Topkg
5
+
6
+
let () =
7
+
Pkg.describe "ptime" @@ fun c ->
8
+
Ok [ Pkg.mllib "src/ptime.mllib";
9
+
Pkg.mllib "src/clock/ptime_clock.mllib" ~dst_dir:"clock/";
10
+
Pkg.clib "src/clock/libptime_clock_stubs.clib" ~lib_dst_dir:"clock/";
11
+
Pkg.lib "src/clock/runtime.js" ~dst:"clock/";
12
+
Pkg.mllib ~api:[] "src/top/ptime_top.mllib" ~dst_dir:"top/";
13
+
Pkg.lib "src/ptime_top_init.ml" ~dst:"ptime_top_init.ml";
14
+
Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld";
15
+
Pkg.doc "test/min_clock.ml"; ]
vendor/opam/ptime/ptime.opam
vendor/opam/ptime/ptime.opam
This is a binary file and will not be displayed.
+8
vendor/opam/ptime/src/clock/dune
+8
vendor/opam/ptime/src/clock/dune
+1
vendor/opam/ptime/src/clock/libptime_clock_stubs.clib
+1
vendor/opam/ptime/src/clock/libptime_clock_stubs.clib
···
1
+
ptime_clock_stubs.o
+29
vendor/opam/ptime/src/clock/ptime_clock.ml
+29
vendor/opam/ptime/src/clock/ptime_clock.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Stubs *)
7
+
8
+
external ptime_clock_now_d_ps : unit -> int * int64 =
9
+
"ocaml_ptime_clock_now_d_ps"
10
+
11
+
external ptime_clock_period_d_ps : unit -> (int * int64) option =
12
+
"ocaml_ptime_clock_period_d_ps"
13
+
14
+
external ptime_clock_current_tz_offset_s : unit -> int option =
15
+
"ocaml_ptime_clock_current_tz_offset_s"
16
+
17
+
(* POSIX clock *)
18
+
19
+
let now () = Ptime.unsafe_of_d_ps (ptime_clock_now_d_ps ())
20
+
let period () = Ptime.Span.unsafe_of_d_ps_option (ptime_clock_period_d_ps ())
21
+
22
+
(* System time zone offset *)
23
+
24
+
let current_tz_offset_s = ptime_clock_current_tz_offset_s
25
+
26
+
(* Raw interface *)
27
+
28
+
let now_d_ps = ptime_clock_now_d_ps
29
+
let period_d_ps = ptime_clock_period_d_ps
+80
vendor/opam/ptime/src/clock/ptime_clock.mli
+80
vendor/opam/ptime/src/clock/ptime_clock.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** POSIX time clock.
7
+
8
+
[Ptime_clock] provides access to a system POSIX time clock and to
9
+
the system's current time zone offset.
10
+
11
+
This time does not increase monotically and is subject to system
12
+
calendar time adjustments. Use {!Mtime} if you need monotonic
13
+
wall-clock time to measure time spans.
14
+
15
+
Consult important information about {{!err}error handling}
16
+
and {{!platform_support}platform support}. *)
17
+
18
+
(** {1:clock POSIX clock} *)
19
+
20
+
val now : unit -> Ptime.t
21
+
(** [now ()] is the current POSIX time, by definition always on the
22
+
UTC timeline.
23
+
24
+
Raises {!Sys_error}, see {{!err}error handling}. *)
25
+
26
+
val period : unit -> Ptime.span option
27
+
(** [period ()] is a positive POSIX time span representing
28
+
the clock's period (if available). *)
29
+
30
+
(** {1:tz System time zone offset} *)
31
+
32
+
val current_tz_offset_s : unit -> Ptime.tz_offset_s option
33
+
(** [current_tz_offset_s ()] is the system's current local time zone
34
+
offset to UTC in seconds, if known. This is the duration local
35
+
time - UTC time in seconds. *)
36
+
37
+
(** {1:raw POSIX clock raw interface} *)
38
+
39
+
val now_d_ps : unit -> int * int64
40
+
(** [now_d_ps ()] is [(d, ps)] representing POSIX time occuring at
41
+
[d] * 86'400e12 + [ps] POSIX picoseconds from the epoch
42
+
1970-01-01 00:00:00 UTC. [ps] is in the range
43
+
\[[0];[86_399_999_999_999_999L]\].
44
+
45
+
Raises {!Sys_error}, see {{!err}error handling} *)
46
+
47
+
val period_d_ps : unit -> (int * int64) option
48
+
(** [period_d_ps ()] is if available [Some (d, ps)] representing the
49
+
clock's picosecond period [d] * 86'400e12 + [ps]. [ps] is in the
50
+
range \[[0];[86_399_999_999_999_999L]\]. *)
51
+
52
+
(** {1:err Error handling}
53
+
54
+
The functions {!now} and {!now_d_ps} raise [Sys_error] whenever
55
+
they can't determine the current time or that it doesn't fit in
56
+
[Ptime]'s well-defined {{!Ptime.t}range}. This exception should
57
+
only be catched at the toplevel of your program to log it and
58
+
abort the program. It indicates a serious error condition in the
59
+
system.
60
+
61
+
All the other functions, whose functionality is less essential,
62
+
simply silently return [None] if they can't determine the
63
+
information either because it is unavailable or because an error
64
+
occured.
65
+
66
+
{1:platform_support Platform support}
67
+
68
+
{ul
69
+
{- Platforms with a POSIX clock (includes Linux) use
70
+
{{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]} with [CLOCK_REALTIME].}
71
+
{- On Darwin {{:http://pubs.opengroup.org/onlinepubs/9699919799/}
72
+
[gettimeofday]} is used.}
73
+
{- On Windows
74
+
{{:https://msdn.microsoft.com/en-us/library/windows/desktop/ms724390(v=vs.85).aspx}[GetSystemTime]}
75
+
and
76
+
{{:https://msdn.microsoft.com/en-us/library/windows/desktop/ms724421(v=vs.85).aspx}[GetTimeZoneInformation]}
77
+
are used.}
78
+
{- On JavaScript
79
+
{{:http://www.ecma-international.org/ecma-262/6.0/index.html#sec-date.now}[Date.now ()]} and
80
+
{{:http://www.ecma-international.org/ecma-262/6.0/index.html#sec-date.prototype.gettimezoneoffset}[Date.prototype.getTimezoneOffset]} are used.}} *)
+1
vendor/opam/ptime/src/clock/ptime_clock.mllib
+1
vendor/opam/ptime/src/clock/ptime_clock.mllib
···
1
+
Ptime_clock
+265
vendor/opam/ptime/src/clock/ptime_clock_stubs.c
+265
vendor/opam/ptime/src/clock/ptime_clock_stubs.c
···
1
+
/*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
--------------------------------------------------------------------------*/
5
+
6
+
#include <caml/mlvalues.h>
7
+
#include <caml/alloc.h>
8
+
#include <caml/memory.h>
9
+
#include <caml/fail.h>
10
+
11
+
#define Val_none Val_int(0)
12
+
#define OCAML_PTIME_DAY_MAX 2932896 // See Ptime.max
13
+
#define OCAML_PTIME_RAISE_SYS_ERROR(ERR) \
14
+
do { caml_raise_sys_error (caml_copy_string("Ptime_clock: " ERR)); } \
15
+
while (0)
16
+
17
+
/* Detect platforms and call in their includes */
18
+
19
+
#if defined(__APPLE__) && defined(__MACH__)
20
+
#define OCAML_PTIME_DARWIN
21
+
#include <time.h>
22
+
#include <sys/time.h>
23
+
24
+
#elif defined(__unix__) || defined(__unix)
25
+
#include <unistd.h>
26
+
#if defined(_POSIX_VERSION)
27
+
#define OCAML_PTIME_POSIX
28
+
#include <time.h>
29
+
#endif
30
+
31
+
#elif defined(_WIN32)
32
+
#define OCAML_PTIME_WIN
33
+
#include <windows.h>
34
+
35
+
#else
36
+
#warning OCaml Ptime_clock module: unsupported platform
37
+
#define OCAML_PTIME_UNSUPPORTED
38
+
#endif
39
+
40
+
41
+
/* Clock now */
42
+
43
+
#if defined(OCAML_PTIME_POSIX)
44
+
45
+
CAMLprim value ocaml_ptime_clock_now_d_ps (value unit)
46
+
{
47
+
CAMLparam1 (unit);
48
+
CAMLlocal1 (pair);
49
+
struct timespec now;
50
+
51
+
if (clock_gettime (CLOCK_REALTIME, &now))
52
+
OCAML_PTIME_RAISE_SYS_ERROR ("can't determine current time");
53
+
54
+
/* Make sure to return valid Ptime.t values. */
55
+
56
+
/* We only handle valid timespec structs as per POSIX def (§2.8.5 in 2013) */
57
+
if (now.tv_nsec < 0 || now.tv_nsec > 999999999)
58
+
OCAML_PTIME_RAISE_SYS_ERROR ("invalid tv_nsec in timespec");
59
+
60
+
/* To make it easier, we do not lie, this can't possibly be now.
61
+
See e.g. Ptime.Span.of_int_s if this is a problem. */
62
+
if (now.tv_sec < 0)
63
+
OCAML_PTIME_RAISE_SYS_ERROR ("negative tv_sec in timespec");
64
+
65
+
int d = now.tv_sec / 86400;
66
+
if (d > OCAML_PTIME_DAY_MAX)
67
+
OCAML_PTIME_RAISE_SYS_ERROR ("can't represent timespec in Ptime.t");
68
+
69
+
pair = caml_alloc (2, 0);
70
+
Store_field (pair, 0, Val_int (d));
71
+
Store_field (pair, 1,
72
+
/* Given the above checks, in the right range for Ptime */
73
+
caml_copy_int64 ((now.tv_sec % 86400) * 1000000000000L +
74
+
(now.tv_nsec * 1000L)));
75
+
CAMLreturn (pair);
76
+
}
77
+
78
+
#elif defined(OCAML_PTIME_DARWIN)
79
+
80
+
CAMLprim value ocaml_ptime_clock_now_d_ps (value unit)
81
+
{
82
+
CAMLparam1 (unit);
83
+
CAMLlocal1 (pair);
84
+
struct timeval now;
85
+
86
+
gettimeofday(&now, NULL);
87
+
88
+
/* Make sure to return valid Ptime.t values. */
89
+
90
+
/* We only handle reasonable timevals (not specified in POSIX it seems) */
91
+
if (now.tv_usec < 0 || now.tv_usec > 999999)
92
+
OCAML_PTIME_RAISE_SYS_ERROR ("unreasonable tv_usec in timeval");
93
+
94
+
/* To make it easier, we do not lie, this can't possibly be now.
95
+
See e.g. Ptime.Span.of_int_s if this is a problem. */
96
+
if (now.tv_sec < 0)
97
+
OCAML_PTIME_RAISE_SYS_ERROR ("negative tv_sec in timeval");
98
+
99
+
int d = now.tv_sec / 86400;
100
+
if (d > OCAML_PTIME_DAY_MAX)
101
+
OCAML_PTIME_RAISE_SYS_ERROR ("can't represent timeval in Ptime.t");
102
+
103
+
pair = caml_alloc (2, 0);
104
+
Store_field (pair, 0, Val_int (d));
105
+
Store_field (pair, 1,
106
+
/* Given the above checks, in the right range for Ptime */
107
+
caml_copy_int64 ((now.tv_sec % 86400) * 1000000000000L +
108
+
(now.tv_usec * 1000000L)));
109
+
CAMLreturn (pair);
110
+
}
111
+
112
+
#elif defined(OCAML_PTIME_WIN)
113
+
114
+
CAMLprim value ocaml_ptime_clock_now_d_ps (value unit)
115
+
{
116
+
CAMLparam1 (unit);
117
+
CAMLlocal1 (pair);
118
+
long sec, usec;
119
+
SYSTEMTIME stime;
120
+
FILETIME ftime;
121
+
ULARGE_INTEGER time;
122
+
123
+
GetSystemTime (&stime);
124
+
SystemTimeToFileTime (&stime, &ftime);
125
+
time.LowPart = ftime.dwLowDateTime;
126
+
time.HighPart = ftime.dwHighDateTime;
127
+
128
+
#define EPOCH (116444736000000000ULL)
129
+
sec = (long)((time.QuadPart - EPOCH) / 10000000L);
130
+
#undef EPOCH
131
+
usec = (long)(stime.wMilliseconds * 1000);
132
+
133
+
if (usec < 0 || usec > 999999)
134
+
OCAML_PTIME_RAISE_SYS_ERROR ("unreasonable usec in FILETIME");
135
+
136
+
if (sec < 0)
137
+
OCAML_PTIME_RAISE_SYS_ERROR ("negative sec in FILETIME");
138
+
139
+
int d = sec / 86400;
140
+
if (d > OCAML_PTIME_DAY_MAX)
141
+
OCAML_PTIME_RAISE_SYS_ERROR ("can't represent FILETIME in Ptime.t");
142
+
143
+
pair = caml_alloc (2, 0);
144
+
Store_field (pair, 0, Val_int (d));
145
+
Store_field (pair, 1,
146
+
caml_copy_int64 ((sec % 86400) * 1000000000000L +
147
+
(usec * 1000000L)));
148
+
CAMLreturn (pair);
149
+
}
150
+
151
+
#else
152
+
153
+
CAMLprim value ocaml_ptime_clock_now_d_ps (value unit)
154
+
{
155
+
OCAML_PTIME_RAISE_SYS_ERROR ("unsupported platform");
156
+
}
157
+
158
+
#endif
159
+
160
+
161
+
/* Clock period */
162
+
163
+
#if defined(OCAML_PTIME_POSIX)
164
+
165
+
CAMLprim value ocaml_ptime_clock_period_d_ps (value unit)
166
+
{
167
+
CAMLparam1 (unit);
168
+
CAMLlocal2 (some, pair);
169
+
struct timespec res;
170
+
171
+
if (clock_getres (CLOCK_REALTIME, &res)) CAMLreturn (Val_none);
172
+
173
+
/* Make sure to return valid Ptime.Span.t values. */
174
+
175
+
/* We only handle valid timespec structs as per POSIX def (§2.8.5 in 2013) */
176
+
if (res.tv_nsec < 0 || res.tv_nsec > 999999999) CAMLreturn (Val_none);
177
+
178
+
/* Negative periods are dubious */
179
+
if (res.tv_sec < 0) CAMLreturn (Val_none);
180
+
181
+
some = caml_alloc (1, 0);
182
+
pair = caml_alloc (2, 0);
183
+
Store_field (some, 0, pair);
184
+
Store_field (pair, 0, Val_int (res.tv_sec / 86400));
185
+
Store_field (pair, 1,
186
+
/* Given the above checks, in the right range for Ptime */
187
+
caml_copy_int64 ((res.tv_sec % 86400) * 1000000000000L +
188
+
(res.tv_nsec * 1000L)));
189
+
CAMLreturn (some);
190
+
}
191
+
192
+
#else /* OCAML_PTIME_DARWIN || OCAML_PTIME_WIN || OCAML_PTIME_UNSUPPORTED */
193
+
194
+
CAMLprim value ocaml_ptime_clock_period_d_ps (value unit)
195
+
{ return Val_none; }
196
+
197
+
#endif
198
+
199
+
200
+
/* Timezone offset (local time - UTC time) */
201
+
202
+
#if defined(OCAML_PTIME_DARWIN) || defined (OCAML_PTIME_POSIX)
203
+
204
+
CAMLprim value ocaml_ptime_clock_current_tz_offset_s (value unit)
205
+
{
206
+
CAMLparam1(unit);
207
+
CAMLlocal1(some);
208
+
struct tm *tm;
209
+
210
+
time_t now_utc = time (NULL);
211
+
if (now_utc == (time_t)-1) return Val_none;
212
+
213
+
tm = localtime (&now_utc);
214
+
if (tm == NULL) return Val_none;
215
+
struct tm local = *tm;
216
+
217
+
tm = gmtime (&now_utc);
218
+
if (tm == NULL) return Val_none;
219
+
struct tm utc = *tm;
220
+
221
+
int dd = local.tm_yday - utc.tm_yday;
222
+
int dh = local.tm_hour - utc.tm_hour;
223
+
int dm = dh * 60 + (local.tm_min - utc.tm_min);
224
+
dm = (dd == 1 || dd < -1 /* year wrap */) ? dm + (24 * 60) :
225
+
(dd == -1 || dd > 1 /* year wrap */) ? dm - (24 * 60) :
226
+
dm /* same day */;
227
+
228
+
some = caml_alloc (1, 0);
229
+
Store_field (some, 0, Val_int (dm * 60));
230
+
CAMLreturn(some);
231
+
}
232
+
233
+
#elif defined(OCAML_PTIME_WIN)
234
+
235
+
CAMLprim value ocaml_ptime_clock_current_tz_offset_s (value unit)
236
+
{
237
+
CAMLparam1(unit);
238
+
CAMLlocal1(some);
239
+
TIME_ZONE_INFORMATION tz;
240
+
int bias;
241
+
242
+
DWORD ret = GetTimeZoneInformation(&tz);
243
+
if (ret == TIME_ZONE_ID_UNKNOWN)
244
+
bias = tz.Bias;
245
+
else if (ret == TIME_ZONE_ID_STANDARD)
246
+
bias = tz.Bias + tz.StandardBias;
247
+
else if (ret == TIME_ZONE_ID_DAYLIGHT)
248
+
bias = tz.Bias + tz.DaylightBias;
249
+
else {
250
+
OCAML_PTIME_RAISE_SYS_ERROR("GetTimeZoneInformation failed");
251
+
}
252
+
253
+
some = caml_alloc (1, 0);
254
+
/* Note that on Windows 'bias' is defined as (UTC - localtime),
255
+
while ptime uses (localtime - UTC) */
256
+
Store_field (some, 0, Val_int (-bias * 60));
257
+
CAMLreturn(some);
258
+
}
259
+
260
+
#else /* OCAML_PTIME_UNSUPPORTED */
261
+
262
+
CAMLprim value ocaml_ptime_clock_current_tz_offset_s (value unit)
263
+
{ return Val_none; }
264
+
265
+
#endif
+49
vendor/opam/ptime/src/clock/runtime.js
+49
vendor/opam/ptime/src/clock/runtime.js
···
1
+
/*---------------------------------------------------------------------------
2
+
Copyright (c) 2022 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*/
5
+
6
+
//Provides: ocaml_ptime_clock_period_d_ps
7
+
function ocaml_ptime_clock_period_d_ps (_unit) {
8
+
return 0;
9
+
}
10
+
11
+
//Provides: ocaml_ptime_clock_current_tz_offset_s
12
+
function ocaml_ptime_clock_current_tz_offset_s (_unit) {
13
+
return [0, ((new Date ()).getTimezoneOffset () * -60)]
14
+
}
15
+
16
+
//Provides: ocaml_ptime_clock_now_d_ps
17
+
//Requires: caml_int64_of_int32, caml_int64_of_float
18
+
//Requires: caml_int64_add, caml_int64_mul
19
+
//Requires: caml_modf_float
20
+
//Requires: caml_raise_sys_error
21
+
function ocaml_ptime_clock_now_d_ps (_unit) {
22
+
function err (ms) {
23
+
caml_raise_sys_error
24
+
("Ptime_clock: can't represent JavaScript timestamp " + ms);
25
+
}
26
+
var dmin = -719528; /* Day component of Ptime.min */
27
+
var dmax = 2932896; /* Day component of Ptime.max */
28
+
var ms = Date.now ();
29
+
var ps;
30
+
if (ms != ms) err (ms)
31
+
var days = Math.floor (ms / 86400000);
32
+
if (days < dmin || days > dmax) err(ms);
33
+
var rem_ms = ms % 86400000;
34
+
if (rem_ms < 0) rem_ms += 86400000
35
+
if (rem_ms >= 86400000) {
36
+
/* Guard against a potential overflow in the computation of [rem_s] */
37
+
days += 1;
38
+
if (days > dmax) err (ms);
39
+
ps = caml_int64_of_int32 (0);
40
+
}
41
+
else {
42
+
var modf = caml_modf_float (rem_ms);
43
+
var fract_ps = caml_int64_of_float (modf[1] * 1e9);
44
+
var rem_ps = caml_int64_mul (caml_int64_of_float (modf[2]),
45
+
caml_int64_of_int32 (1000000000));
46
+
ps = caml_int64_add (rem_ps, fract_ps);
47
+
}
48
+
return [0, days, ps]
49
+
}
+5
vendor/opam/ptime/src/dune
+5
vendor/opam/ptime/src/dune
+707
vendor/opam/ptime/src/ptime.ml
+707
vendor/opam/ptime/src/ptime.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Julian day and proleptic Gregorian calendar date conversion.
7
+
8
+
Formulae are from the calendar FAQ:
9
+
http://www.tondering.dk/claus/cal/julperiod.php#formula
10
+
11
+
These formulae work for positive Julian days. They represent
12
+
Gegorian calendar BCE year `y` by `-(y-1)`, e.g. 2 BCE is -1, this
13
+
follows the convention of ISO 8601.
14
+
15
+
All timestamps in Ptime's [min;max] range are represented by
16
+
positive Julian days and the formulae do not overflow on 32-bit
17
+
platforms in this restricted range. *)
18
+
19
+
let jd_to_date jd =
20
+
let a = jd + 32044 in
21
+
let b = (4 * a + 3) / 146097 in
22
+
let c = a - ((146097 * b) / 4) in
23
+
let d = (4 * c + 3) / 1461 in
24
+
let e = c - ((1461 * d) / 4) in
25
+
let m = (5 * e + 2) / 153 in
26
+
let day = e - ((153 * m + 2) / 5) + 1 in
27
+
let month = m + 3 - (12 * (m / 10)) in
28
+
let year = 100 * b + d - 4800 + (m / 10) in
29
+
(year, month, day)
30
+
31
+
let jd_to_year jd = (* Same as above but only for the year *)
32
+
let a = jd + 32044 in
33
+
let b = (4 * a + 3) / 146097 in
34
+
let c = a - ((146097 * b) / 4) in
35
+
let d = (4 * c + 3) / 1461 in
36
+
let e = c - ((1461 * d) / 4) in
37
+
let m = (5 * e + 2) / 153 in
38
+
100 * b + d - 4800 + (m / 10)
39
+
40
+
let jd_of_date (year, month, day) =
41
+
let a = (14 - month) / 12 in
42
+
let y = year + 4800 - a in
43
+
let m = month + 12 * a - 3 in
44
+
day + ((153 * m) + 2)/ 5 + 365 * y +
45
+
(y / 4) - (y / 100) + (y / 400) - 32045
46
+
47
+
let jd_posix_epoch = 2_440_588 (* the Julian day of the POSIX epoch *)
48
+
let jd_ptime_min = 1_721_060 (* the Julian day of Ptime.min *)
49
+
let jd_ptime_max = 5_373_484 (* the Julian day of Ptime.max *)
50
+
51
+
(* Picosecond precision POSIX timestamps and time span representation.
52
+
53
+
POSIX timestamps and spans are represented by int * int64 pairs
54
+
with the int64 in the range [0L;86_399_999_999_999_999L]. A pair
55
+
[(d, ps)] denotes the POSIX picosecond duration [d] * 86_400e12 +
56
+
[ps].
57
+
58
+
For a timestamp this can be seen as a POSIX day count from the
59
+
epoch paired with a picosecond precision POSIX time point in that
60
+
day starting from 00:00:00.
61
+
62
+
By definition with a negative [d] the [ps] duration brings us
63
+
towards zero, *not* towards infinity:
64
+
65
+
66
+
(d * 86_400e12) (d * 86_400e12 + ps) 0
67
+
... -----+-----------------+-------------------+--------- ...
68
+
[---------------->|
69
+
ps
70
+
71
+
[d] is largely sufficent to represent all the days in Ptime's
72
+
[min;max] range on both 32-bit and 64-bit platforms. *)
73
+
74
+
type t = int * int64
75
+
76
+
let ps_count_in_ps = 1L
77
+
let ps_count_in_ns = 1_000L
78
+
let ps_count_in_100ns = 100_000L
79
+
let ps_count_in_us = 1_000_000L
80
+
let ps_count_in_100us = 100_000_000L
81
+
let ps_count_in_ms = 1_000_000_000L
82
+
let ps_count_in_100ms = 100_000_000_000L
83
+
let ps_count_in_s = 1_000_000_000_000L
84
+
let ps_count_in_min = 60_000_000_000_000L
85
+
let ps_count_in_hour = 3600_000_000_000_000L
86
+
let ps_count_in_day = 86_400_000_000_000_000L
87
+
let ps_day_max = 86_399_999_999_999_999L
88
+
89
+
let day_min = jd_ptime_min - jd_posix_epoch
90
+
let day_max = jd_ptime_max - jd_posix_epoch
91
+
92
+
let epoch = (0, 0L) (* 1970-01-01 00:00:00 UTC *)
93
+
let min = (day_min, 0L) (* 0000-01-01 00:00:00 UTC *)
94
+
let max = (day_max, ps_day_max) (* 9999-12-31 23:59:59 UTC *)
95
+
96
+
(* POSIX time spans *)
97
+
98
+
type span = t
99
+
100
+
module Span = struct
101
+
102
+
let stdlib_abs = abs
103
+
104
+
(* Arithmetic *)
105
+
106
+
let neg = function
107
+
| (d, 0L) -> (-d, 0L)
108
+
| (d, ps) -> (-(d + 1), Int64.sub ps_count_in_day ps)
109
+
110
+
let add (d0, ps0) (d1, ps1) =
111
+
let d = d0 + d1 in
112
+
let ps = Int64.add ps0 ps1 in
113
+
let ps_clamp = Int64.rem ps ps_count_in_day in
114
+
let d = d + Int64.compare ps ps_clamp in
115
+
d, ps_clamp
116
+
117
+
let sub s0 s1 = add s0 (neg s1)
118
+
let abs (d, _ as s) = if d < 0 then neg s else s
119
+
120
+
(* POSIX time spans *)
121
+
122
+
type t = span
123
+
124
+
let zero = (0, 0L)
125
+
let v (d, ps as s) =
126
+
if ps < 0L || ps > ps_day_max
127
+
then invalid_arg (Format.sprintf "illegal ptime time span: (%d,%Ld)" d ps)
128
+
else s
129
+
130
+
let of_d_ps (d, ps as s) = if ps < 0L || ps > ps_day_max then None else Some s
131
+
let unsafe_of_d_ps s = s
132
+
let unsafe_of_d_ps_option s = s
133
+
let to_d_ps s = s
134
+
135
+
let of_int_s secs =
136
+
let d = stdlib_abs secs in
137
+
let s = (d / 86_400, Int64.(mul (of_int (d mod 86_400)) ps_count_in_s)) in
138
+
if secs < 0 then neg s else s
139
+
140
+
let day_int_min = min_int / 86_400
141
+
let day_int_max = max_int / 86_400
142
+
let to_int_s (d, ps) =
143
+
if d < day_int_min || d > day_int_max then None else
144
+
let days_s = d * 86_400 in
145
+
let day_s = Int64.(to_int (div ps ps_count_in_s)) (* always positive *) in
146
+
let secs = days_s + day_s in
147
+
if secs < days_s (* positive overflow *) then None else Some secs
148
+
149
+
let min_int_float = float min_int
150
+
let max_int_float = float max_int
151
+
let of_float_s secs =
152
+
if secs <> secs (* nan *) then None else
153
+
let days = floor (secs /. 86_400.) in
154
+
if days < min_int_float || days > max_int_float then None else
155
+
let rem_s = mod_float secs 86_400. in
156
+
let rem_s = if rem_s < 0. then 86_400. +. rem_s else rem_s in
157
+
if rem_s >= 86_400. then
158
+
(* Guard against a potential overflow in the computation of [rem_s] *)
159
+
let days = days +. 1. in
160
+
if days > max_int_float then None else
161
+
Some (int_of_float days, 0L)
162
+
else
163
+
let frac_s, rem_s = modf rem_s in
164
+
let rem_ps = Int64.(mul (of_float rem_s) ps_count_in_s) in
165
+
let frac_ps = Int64.(of_float (frac_s *. 1e12)) in
166
+
Some (int_of_float days, (Int64.add rem_ps frac_ps))
167
+
168
+
let to_float_s (d, ps) =
169
+
let days_s = (float d) *. 86_400. in
170
+
let day_s = Int64.(to_float (div ps ps_count_in_s)) in
171
+
let day_rem_ps = Int64.(to_float (rem ps ps_count_in_s)) in
172
+
days_s +. day_s +. (day_rem_ps *. 1e-12)
173
+
174
+
(* Predicates *)
175
+
176
+
let equal (d0, ps0) (d1, ps1) =
177
+
(compare : int -> int -> int) d0 d1 = 0 &&
178
+
Int64.compare ps0 ps1 = 0
179
+
180
+
let compare (d0, ps0) (d1, ps1) =
181
+
let c = (compare : int -> int -> int) d0 d1 in
182
+
if c <> 0 then c else (compare : int64 -> int64 -> int) ps0 ps1
183
+
184
+
(* Rounding *)
185
+
186
+
let round_div a b = (* a >= 0 and b > 0 *)
187
+
if a = 0L then 0L else
188
+
Int64.(div (add a (div b 2L)) b)
189
+
190
+
let frac_div = [| 1_000_000_000_000L;
191
+
100_000_000_000L;
192
+
10_000_000_000L;
193
+
1_000_000_000L;
194
+
100_000_000L;
195
+
10_000_000L;
196
+
1_000_000L;
197
+
100_000L;
198
+
10_000L;
199
+
1_000L;
200
+
100L;
201
+
10L;
202
+
1L; |]
203
+
204
+
let round ~frac_s:frac (sign, _ as t) =
205
+
let frac = if frac < 0 then 0 else (if frac > 12 then 12 else frac) in
206
+
let (d, ps) = if sign < 0 then neg t else t in
207
+
let rps = Int64.mul (round_div ps frac_div.(frac)) frac_div.(frac) in
208
+
let t = if rps > ps_day_max then (d + 1, 0L) else (d, rps) in
209
+
if sign < 0 then neg t else t
210
+
211
+
let truncate ~frac_s:frac (sign, _ as t) =
212
+
let frac = if frac < 0 then 0 else (if frac > 12 then 12 else frac) in
213
+
let (d, ps) = if sign < 0 then neg t else t in
214
+
let tps = Int64.(sub ps (rem ps frac_div.(frac))) in
215
+
if sign < 0 then neg (d, tps) else (d, tps)
216
+
217
+
let truncate_down ~frac_s:frac (d, ps) =
218
+
(d, Int64.(sub ps (rem ps frac_div.(frac ))))
219
+
220
+
(* Pretty printing *)
221
+
222
+
let dump ppf (d, ps) = Format.fprintf ppf "@[<1>(%d,@,%Ld)@]" d ps
223
+
224
+
(* Warning laborious code follows. Is there a better way ? *)
225
+
226
+
let divide_ps ~carry ps hi lo =
227
+
let hi_d = Int64.(to_int (div ps hi)) in
228
+
let rem_ps = Int64.rem ps hi in
229
+
let lo_d = Int64.to_int (round_div rem_ps lo) in
230
+
if lo_d = carry then hi_d + 1, 0 else hi_d, lo_d
231
+
232
+
let pp_y_d ppf ~neg d ps = (* assert d >= 0 *)
233
+
let y, rem_d =
234
+
let max_d = max_int / 4 in
235
+
if d > max_d then (* d * 4 overflows *) d / 365, d mod 365 else
236
+
let y = (d * 4) / 1461 (* / 365.25 *) in
237
+
y, d - (y * 1461) / 4
238
+
in
239
+
let days = rem_d + Int64.to_int (round_div ps ps_count_in_day) in
240
+
let y, days = if days = 366 then y + 1, 1 else y, days in
241
+
let y = if neg then -y else y in
242
+
Format.fprintf ppf "%dy" y;
243
+
if days <> 0 then Format.fprintf ppf "%dd" days;
244
+
()
245
+
246
+
let pp_d_h ppf ~neg d ps =
247
+
let h, _ = divide_ps ~carry:1 ps ps_count_in_hour ps_count_in_hour in
248
+
let d, h = if h = 24 then d + 1, 0 else d, h in
249
+
if d = 366 then Format.fprintf ppf "%dy1d" (if neg then -1 else 1) else
250
+
if d = 365 && h >= 6
251
+
then Format.fprintf ppf "%dy" (if neg then -1 else 1) else
252
+
let d = if neg then -d else d in
253
+
Format.fprintf ppf "%dd" d;
254
+
if h <> 0 then Format.fprintf ppf "%dh" h;
255
+
()
256
+
257
+
let pp_h_m ppf ~neg ps =
258
+
let h, m = divide_ps ~carry:60 ps ps_count_in_hour ps_count_in_min in
259
+
if h = 24 then Format.fprintf ppf "%dd" (if neg then -1 else 1) else
260
+
let h = if neg then -h else h in
261
+
Format.fprintf ppf "%dh" h;
262
+
if m <> 0 then Format.fprintf ppf "%dmin" m;
263
+
()
264
+
265
+
let pp_m_s ppf ~neg ps =
266
+
let m, s = divide_ps ~carry:60 ps ps_count_in_min ps_count_in_s in
267
+
if m = 60 then Format.fprintf ppf "%dh" (if neg then -1 else 1) else
268
+
let m = if neg then -m else m in
269
+
Format.fprintf ppf "%dmin" m;
270
+
if s <> 0 then Format.fprintf ppf "%ds" s;
271
+
()
272
+
273
+
let pp_s ppf ~neg ps =
274
+
let s, ms = divide_ps ~carry:1000 ps ps_count_in_s ps_count_in_ms in
275
+
if s = 60 then Format.fprintf ppf "%dmin" (if neg then -1 else 1) else
276
+
let s = if neg then -s else s in
277
+
if ms <> 0 then Format.fprintf ppf "%d.%03ds" s ms else
278
+
Format.fprintf ppf "%ds" s
279
+
280
+
let pp_unit higher_str hi hi_str frac_limit lo ppf ~neg ps =
281
+
let pp_unit_integral ppf ~neg h =
282
+
if h = 1000
283
+
then Format.fprintf ppf "%d%s" (if neg then -1 else 1) higher_str
284
+
else Format.fprintf ppf "%d%s" (if neg then -h else h) hi_str
285
+
in
286
+
if ps < frac_limit then begin
287
+
let h, l = divide_ps ~carry:1000 ps hi lo in
288
+
if h >= 100 || l = 0 then pp_unit_integral ppf ~neg h else
289
+
let h = if neg then -h else h in
290
+
Format.fprintf ppf "%d.%03d%s" h l hi_str
291
+
end else begin
292
+
let ms, _ = divide_ps ~carry:1 ps hi hi in
293
+
pp_unit_integral ppf ~neg ms
294
+
end
295
+
296
+
let pp_ms =
297
+
pp_unit "s" ps_count_in_ms "ms" ps_count_in_100ms ps_count_in_us
298
+
299
+
let pp_us =
300
+
pp_unit "ms" ps_count_in_us "us" ps_count_in_100us ps_count_in_ns
301
+
302
+
let pp_ns =
303
+
pp_unit "us" ps_count_in_ns "ns" ps_count_in_100ns ps_count_in_ps
304
+
305
+
let pp_ps ppf ~neg ps =
306
+
let ps = Int64.to_int ps in
307
+
Format.fprintf ppf "%dps" (if neg then -ps else ps)
308
+
309
+
let pp ppf (sign, _ as s) =
310
+
let neg = sign < 0 in
311
+
match (abs s) with
312
+
| (0, ps) ->
313
+
if ps >= ps_count_in_hour then pp_h_m ppf ~neg ps else
314
+
if ps >= ps_count_in_min then pp_m_s ppf ~neg ps else
315
+
if ps >= ps_count_in_s then pp_s ppf ~neg ps else
316
+
if ps >= ps_count_in_ms then pp_ms ppf ~neg ps else
317
+
if ps >= ps_count_in_us then pp_us ppf ~neg ps else
318
+
if ps >= ps_count_in_ns then pp_ns ppf ~neg ps else
319
+
pp_ps ppf ~neg ps
320
+
| (d, ps) ->
321
+
if d > 365 then pp_y_d ppf ~neg d ps else
322
+
pp_d_h ppf ~neg d ps
323
+
end
324
+
325
+
(* POSIX timestamps *)
326
+
327
+
let v (d, ps as s) =
328
+
if (ps < 0L || ps > ps_day_max || d < day_min || d > day_max)
329
+
then invalid_arg (Format.sprintf "illegal ptime timestamp: (%d,%Ld)" d ps)
330
+
else s
331
+
332
+
let unsafe_of_d_ps s = s
333
+
334
+
let of_span (d, _ as span) =
335
+
if d < day_min || d > day_max then None else Some span
336
+
337
+
let to_span t = t
338
+
339
+
let of_float_s secs = match Span.of_float_s secs with
340
+
| None -> None
341
+
| Some d -> of_span d
342
+
343
+
let to_float_s = Span.to_float_s
344
+
345
+
let truncate = Span.truncate_down
346
+
347
+
let frac_s (_, ps) = (0, Int64.(rem ps ps_count_in_s))
348
+
349
+
(* Predicates *)
350
+
351
+
let equal = Span.equal
352
+
let compare = Span.compare
353
+
let is_earlier t ~than = compare t than = -1
354
+
let is_later t ~than = compare t than = 1
355
+
356
+
(* POSIX arithmetic *)
357
+
358
+
let add_span t d = of_span (Span.add t d)
359
+
let sub_span t d = of_span (Span.sub t d)
360
+
let diff t1 t0 = Span.sub t1 t0
361
+
362
+
(* Time zone offsets between local and UTC timelines *)
363
+
364
+
type tz_offset_s = int
365
+
366
+
(* Date-time conversion
367
+
368
+
POSIX time counts seconds since 1970-01-01 00:00:00 UTC without
369
+
counting leap seconds -- when a leap second occurs a POSIX second
370
+
can be two SI seconds or zero SI second. Hence 86400 POSIX seconds
371
+
always represent an UTC day and the translations below are accurate
372
+
without having to refer to a leap seconds table. *)
373
+
374
+
type date = (int * int * int)
375
+
type time = (int * int * int) * tz_offset_s
376
+
377
+
let max_month_day = (* max day number in a given year's month. *)
378
+
let is_leap_year y = (y mod 4 = 0) && (y mod 100 <> 0 || y mod 400 = 0) in
379
+
let mlen = [|31; 28 (* or not *); 31; 30; 31; 30; 31; 31; 30; 31; 30; 31|] in
380
+
fun y m -> if (m = 2 && is_leap_year y) then 29 else mlen.(m - 1)
381
+
382
+
let is_date_valid (y, m, d) =
383
+
0 <= y && y <= 9999 &&
384
+
1 <= m && m <= 12 &&
385
+
1 <= d && d <= max_month_day y m
386
+
387
+
let is_time_valid ((hh, mm, ss), _) =
388
+
0 <= hh && hh <= 23 &&
389
+
0 <= mm && mm <= 59 &&
390
+
0 <= ss && ss <= 60
391
+
392
+
let of_date_time (date, ((hh, mm, ss), tz_offset_s as t)) =
393
+
(* We first verify that the given date and time are Ptime-valid.
394
+
Once this has been established we find find the number of Julian
395
+
days since the epoch for the given proleptic Georgian calendar
396
+
date. This gives us the POSIX day component of the timestamp. The
397
+
remaining time fields are used to derive the picosecond precision
398
+
time in that day compensated by the time zone offset. The final
399
+
result is checked to be in Ptime's [min;max] range.
400
+
401
+
By definition POSIX timestamps cannot represent leap seconds.
402
+
With the code below any date-time with a seconds value of 60
403
+
(leap second addition) is mapped to the POSIX timestamp that
404
+
happens 1 second later which is what POSIX mktime would to. Any
405
+
formally non-existing UTC date-time with a seconds value of 59
406
+
(leap second subtraction) is mapped on the POSIX timestamp that
407
+
represents this non existing instant. *)
408
+
if not (is_date_valid date && is_time_valid t) then None else
409
+
let d = jd_of_date date - jd_posix_epoch in
410
+
let hh_ps = Int64.(mul (of_int hh) ps_count_in_hour) in
411
+
let mm_ps = Int64.(mul (of_int mm) ps_count_in_min) in
412
+
let ss_ps = Int64.(mul (of_int ss) ps_count_in_s) in
413
+
let ps = Int64.(add hh_ps (add mm_ps ss_ps)) in
414
+
sub_span (d, ps) (Span.of_int_s tz_offset_s)
415
+
416
+
let to_date_time ?(tz_offset_s = 0) t =
417
+
(* To render the timestamp in the given time zone offset we first
418
+
express the timestamp in local time and then compute the date
419
+
fields on that stamp as if it were UTC. If the local timestamp is
420
+
not in [min;max] then its date fields cannot be valid according
421
+
to the constraints guaranteed by Ptime and we fallback to UTC,
422
+
i.e. a time zone offset of 0.
423
+
424
+
We then apply the following algorithm whose description makes
425
+
sense on a POSIX timestamp (i.e. UTC) but works equally well to
426
+
render the date-time fields of a local timestamp.
427
+
428
+
We first take take the POSIX day count [d] (equivalent by
429
+
definition to an UTC day count) from the epoch, convert it to a
430
+
Julian day and use this to get the proleptic Gregorian calendar
431
+
date. The POSIX picoseconds [ps] in the day are are converted to
432
+
a daytime according to to its various units.
433
+
434
+
By definition no POSIX timestamp can represent a date-time with a
435
+
seconds value of 60 (leap second addition) and thus the function
436
+
will never return a date-time with such a value. On the other
437
+
hand it will return an inexisting UTC date-time with a seconds
438
+
value of 59 whenever a leap second is subtracted since there is a
439
+
POSIX timestamp that represents this instant. *)
440
+
let (d, ps), tz_offset_s = match add_span t (Span.of_int_s tz_offset_s) with
441
+
| None -> t, 0 (* fallback to UTC *)
442
+
| Some local -> local, tz_offset_s
443
+
in
444
+
let jd = d + jd_posix_epoch in
445
+
let date = jd_to_date jd in
446
+
let hh = Int64.(to_int (div ps ps_count_in_hour)) in
447
+
let hh_rem = Int64.rem ps ps_count_in_hour in
448
+
let mm = Int64.(to_int (div hh_rem ps_count_in_min)) in
449
+
let mm_rem = Int64.rem hh_rem ps_count_in_min in
450
+
let ss = Int64.(to_int (div mm_rem ps_count_in_s)) in
451
+
date, ((hh, mm, ss), tz_offset_s)
452
+
453
+
let of_date ?tz_offset_s:(tz = 0) date = of_date_time (date, ((00, 00, 00), tz))
454
+
let to_date ?tz_offset_s t = fst (to_date_time ?tz_offset_s t)
455
+
let of_year ?tz_offset_s y = of_date ?tz_offset_s (y, 01, 01)
456
+
let to_year ?(tz_offset_s = 0) t =
457
+
let d = match add_span t (Span.of_int_s tz_offset_s) with
458
+
| None -> fst t (* fallback to UTC *) | Some (local_d, _) -> local_d
459
+
in
460
+
jd_to_year (d + jd_posix_epoch)
461
+
462
+
463
+
type weekday = [ `Sun | `Mon | `Tue | `Wed | `Thu | `Fri | `Sat ]
464
+
465
+
let weekday_num ?(tz_offset_s = 0) t =
466
+
let (d, _) = Span.add t (Span.of_int_s tz_offset_s) in
467
+
(* N.B. in contrast to [to_date_time] we don't care if we fall outside
468
+
[min;max]. Even if it happens the result of the computation is still
469
+
correct *)
470
+
let i = (d + 4 (* Epoch, d = 0, was a thu, we want 4 for that day *)) mod 7 in
471
+
if i < 0 then 7 + i else i
472
+
473
+
let weekday =
474
+
let wday = [| `Sun; `Mon; `Tue; `Wed; `Thu; `Fri; `Sat; |] in
475
+
fun ?tz_offset_s t -> wday.(weekday_num ?tz_offset_s t)
476
+
477
+
(* RFC 3339 timestamp conversions *)
478
+
479
+
(* RFC 3339 timestamp parser *)
480
+
481
+
type error_range = int * int
482
+
type rfc3339_error =
483
+
[ `Invalid_stamp | `Eoi | `Exp_chars of char list | `Trailing_input ]
484
+
485
+
let pp_rfc3339_error ppf = function
486
+
| `Invalid_stamp -> Format.fprintf ppf "@[invalid@ time@ stamp@]"
487
+
| `Eoi -> Format.fprintf ppf "@[unexpected@ end@ of@ input@]"
488
+
| `Trailing_input -> Format.fprintf ppf "@[trailing@ input@]"
489
+
| `Exp_chars cs ->
490
+
let rec pp_chars ppf = function
491
+
| c :: cs -> Format.fprintf ppf "@ %C" c; pp_chars ppf cs
492
+
| [] -> ()
493
+
in
494
+
Format.fprintf ppf "@[expected@ a@ character@ in:%a@]" pp_chars cs
495
+
496
+
let pp_range ppf (s, e) =
497
+
if s = e then Format.pp_print_int ppf s else Format.fprintf ppf "%d-%d" s e
498
+
499
+
let _rfc3339_error_to_string (r, err) =
500
+
Format.asprintf "@[<h>%a: %a@]" pp_range r pp_rfc3339_error err
501
+
502
+
let rfc3339_string_error = function
503
+
| Ok _ as v -> v | Error (`RFC3339 e) -> Error (_rfc3339_error_to_string e)
504
+
505
+
let rfc3339_error_to_msg = function
506
+
| Ok _ as v -> v | Error (`RFC3339 e) ->
507
+
Error (`Msg (_rfc3339_error_to_string e))
508
+
509
+
exception RFC3339 of (int * int) * rfc3339_error (* Internal *)
510
+
511
+
let error r e = raise (RFC3339 (r, e))
512
+
let error_pos p e = error (p, p) e
513
+
let error_exp_digit p =
514
+
error_pos p (`Exp_chars ['0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'])
515
+
516
+
let is_digit = function '0' .. '9' -> true | _ -> false
517
+
518
+
let parse_digits ~count pos max s =
519
+
let stop = pos + count - 1 in
520
+
if stop > max then error_pos max `Eoi else
521
+
let rec loop k acc =
522
+
if k > stop then acc else
523
+
if is_digit s.[k] then loop (k+1) (acc * 10 + Char.code s.[k] - 0x30) else
524
+
error_exp_digit k
525
+
in
526
+
loop pos 0
527
+
528
+
let parse_char c pos max s =
529
+
if pos > max then error_pos max `Eoi else
530
+
if s.[pos] = c then () else error_pos pos (`Exp_chars [c])
531
+
532
+
let parse_dt_sep ~strict pos max s =
533
+
let is_dt_sep = function
534
+
| 'T' -> true
535
+
| 't' | ' ' when not strict -> true
536
+
| _ -> false
537
+
in
538
+
if pos > max then error_pos max `Eoi else
539
+
if is_dt_sep s.[pos] then () else
540
+
error_pos pos (`Exp_chars (['T'] @ if strict then [] else ['t'; ' ']))
541
+
542
+
let decide_frac_or_tz ~strict pos max s =
543
+
if pos > max then error_pos max `Eoi else
544
+
match s.[pos] with
545
+
| '.' -> `Frac
546
+
| '+' | '-' | 'Z' -> `Tz
547
+
| 'z' when not strict -> `Tz
548
+
| c ->
549
+
let chars = ['.'; '+'; '-'; 'Z'] @ if strict then [] else ['z'] in
550
+
error_pos pos (`Exp_chars chars)
551
+
552
+
let parse_frac_ps pos max s =
553
+
if pos > max then error_pos max `Eoi else
554
+
if not (is_digit s.[pos]) then error_exp_digit pos else
555
+
let rec loop k acc pow =
556
+
if k > max then error_pos max `Eoi else
557
+
if not (is_digit s.[k]) then (Some acc), k else
558
+
let count = k - pos + 1 in
559
+
if count > 12 then (* truncate *) loop (k + 1) acc pow else
560
+
let pow = Int64.div pow 10L in
561
+
let acc = Int64.(add acc (mul (of_int (Char.code s.[k] - 0x30)) pow)) in
562
+
loop (k + 1) acc pow
563
+
in
564
+
loop pos 0L ps_count_in_s
565
+
566
+
let parse_tz_s ~strict pos max s =
567
+
let parse_tz_mag sign pos =
568
+
let hh_pos = pos in
569
+
let hh = parse_digits ~count:2 hh_pos max s in
570
+
let mm, mm_pos = match strict with
571
+
| true ->
572
+
let mm_pos = hh_pos + 3 in
573
+
parse_char ':' (mm_pos - 1) max s;
574
+
parse_digits ~count:2 mm_pos max s, mm_pos
575
+
| false ->
576
+
let next = hh_pos + 2 in
577
+
if next > max || not (s.[next] = ':' || is_digit s.[next])
578
+
then (0, hh_pos (* end pos of parse - 1, one is added at the end *))
579
+
else
580
+
let mm_pos = if s.[next] = ':' then hh_pos + 3 else hh_pos + 2 in
581
+
parse_digits ~count:2 mm_pos max s, mm_pos
582
+
in
583
+
if hh > 23 then error (hh_pos, hh_pos + 1) `Invalid_stamp else
584
+
if mm > 59 then error (mm_pos, mm_pos + 1) `Invalid_stamp else
585
+
let secs = hh * 3600 + mm * 60 in
586
+
let tz_s = match secs = 0 && sign = -1 with
587
+
| true -> None (* -00:00 convention *)
588
+
| false -> Some (sign * secs)
589
+
in
590
+
tz_s, mm_pos + 1
591
+
in
592
+
if pos > max then error_pos max `Eoi else
593
+
match s.[pos] with
594
+
| 'Z' -> Some 0, pos
595
+
| 'z' when not strict -> Some 0, pos
596
+
| '+' -> parse_tz_mag ( 1) (pos + 1)
597
+
| '-' -> parse_tz_mag (-1) (pos + 1)
598
+
| c ->
599
+
let chars = ['+'; '-'; 'Z'] @ if strict then [] else ['z'] in
600
+
error_pos pos (`Exp_chars chars)
601
+
602
+
let of_rfc3339 ?(strict = false) ?(sub = false) ?(start = 0) s =
603
+
try
604
+
let s_len = String.length s in
605
+
let max = s_len - 1 in
606
+
if s_len = 0 || start < 0 || start > max then error_pos start `Eoi else
607
+
let y_pos = start in
608
+
let m_pos = y_pos + 5 in
609
+
let d_pos = m_pos + 3 in
610
+
let hh_pos = d_pos + 3 in
611
+
let mm_pos = hh_pos + 3 in
612
+
let ss_pos = mm_pos + 3 in
613
+
let decide_pos = ss_pos + 2 in
614
+
let y = parse_digits ~count:4 y_pos max s in
615
+
parse_char '-' (m_pos - 1) max s;
616
+
let m = parse_digits ~count:2 m_pos max s in
617
+
parse_char '-' (d_pos - 1) max s;
618
+
let d = parse_digits ~count:2 d_pos max s in
619
+
parse_dt_sep ~strict (hh_pos - 1) max s;
620
+
let hh = parse_digits ~count:2 hh_pos max s in
621
+
parse_char ':' (mm_pos - 1) max s;
622
+
let mm = parse_digits ~count:2 mm_pos max s in
623
+
parse_char ':' (ss_pos - 1) max s;
624
+
let ss = parse_digits ~count:2 ss_pos max s in
625
+
let frac, tz_pos = match decide_frac_or_tz ~strict decide_pos max s with
626
+
| `Frac -> parse_frac_ps (decide_pos + 1) max s
627
+
| `Tz -> None, decide_pos
628
+
in
629
+
let tz_s_opt, last_pos = parse_tz_s ~strict tz_pos max s in
630
+
let tz_s = match tz_s_opt with None -> 0 | Some s -> s in
631
+
match of_date_time ((y, m, d), ((hh, mm, ss), tz_s)) with
632
+
| None -> error (start, last_pos) `Invalid_stamp
633
+
| Some t ->
634
+
let t, tz_s = match frac with
635
+
| None | Some 0L -> t, tz_s
636
+
| Some frac ->
637
+
match add_span t (0, frac) with
638
+
| None -> error (start, last_pos) `Invalid_stamp
639
+
| Some t -> t, tz_s
640
+
in
641
+
if not sub && last_pos <> max
642
+
then error_pos (last_pos + 1) `Trailing_input
643
+
else Ok (t, tz_s_opt, last_pos - start + 1)
644
+
with RFC3339 (r, e) -> Error (`RFC3339 (r, e))
645
+
646
+
(* RFC 3339 timestamp formatter *)
647
+
648
+
let rfc3339_adjust_tz_offset tz_offset_s =
649
+
(* The RFC 3339 time zone offset field is limited in expression to
650
+
the bounds below with minute precision. If the requested time
651
+
zone offset exceeds these bounds or is not an *integral* number
652
+
of minutes we simply use UTC. An alternative would be to
653
+
compensate the offset *and* the timestamp but it's more
654
+
complicated to explain and maybe more surprising to the user. *)
655
+
let min = -86340 (* -23h59 in secs *) in
656
+
let max = +86340 (* +23h59 in secs *) in
657
+
if min <= tz_offset_s && tz_offset_s <= max && tz_offset_s mod 60 = 0
658
+
then tz_offset_s, false
659
+
else 0 (* UTC *), true
660
+
661
+
let s_frac_of_ps frac ps =
662
+
Int64.(div (rem ps ps_count_in_s) Span.frac_div.(frac))
663
+
664
+
let to_rfc3339 ?(space = false) ?frac_s:(frac = 0) ?tz_offset_s (_, ps as t) =
665
+
let buf = Buffer.create 255 in
666
+
let tz_offset_s, tz_unknown = match tz_offset_s with
667
+
| Some tz -> rfc3339_adjust_tz_offset tz
668
+
| None -> 0, true
669
+
in
670
+
let (y, m, d), ((hh, ss, mm), tz_offset_s) = to_date_time ~tz_offset_s t in
671
+
let dt_sep = if space then ' ' else 'T' in
672
+
Printf.bprintf buf "%04d-%02d-%02d%c%02d:%02d:%02d" y m d dt_sep hh ss mm;
673
+
let frac = if frac < 0 then 0 else (if frac > 12 then 12 else frac) in
674
+
if frac <> 0 then Printf.bprintf buf ".%0*Ld" frac (s_frac_of_ps frac ps);
675
+
if tz_offset_s = 0 && not tz_unknown then Printf.bprintf buf "Z" else
676
+
begin
677
+
let tz_sign = if tz_offset_s < 0 || tz_unknown then '-' else '+' in
678
+
let tz_min = abs (tz_offset_s / 60) in
679
+
let tz_hh = tz_min / 60 in
680
+
let tz_mm = tz_min mod 60 in
681
+
Printf.bprintf buf "%c%02d:%02d" tz_sign tz_hh tz_mm;
682
+
end;
683
+
Buffer.contents buf
684
+
685
+
let pp_rfc3339 ?space ?frac_s ?tz_offset_s () ppf t =
686
+
Format.fprintf ppf "%s" (to_rfc3339 ?space ?frac_s ?tz_offset_s t)
687
+
688
+
(* Pretty printing *)
689
+
690
+
let pp_human ?frac_s:(frac = 0) ?tz_offset_s () ppf (_, ps as t) =
691
+
let tz_offset_s, tz_unknown = match tz_offset_s with
692
+
| Some tz -> rfc3339_adjust_tz_offset tz
693
+
| None -> 0, true
694
+
in
695
+
let (y, m, d), ((hh, ss, mm), tz_offset_s) = to_date_time ~tz_offset_s t in
696
+
Format.fprintf ppf "%04d-%02d-%02d %02d:%02d:%02d" y m d hh ss mm;
697
+
let frac = if frac < 0 then 0 else (if frac > 12 then 12 else frac) in
698
+
if frac <> 0 then Format.fprintf ppf ".%0*Ld" frac (s_frac_of_ps frac ps);
699
+
let tz_sign = if tz_offset_s < 0 || tz_unknown then '-' else '+' in
700
+
let tz_min = abs (tz_offset_s / 60) in
701
+
let tz_hh = tz_min / 60 in
702
+
let tz_mm = tz_min mod 60 in
703
+
Format.fprintf ppf " %c%02d:%02d" tz_sign tz_hh tz_mm;
704
+
()
705
+
706
+
let pp = pp_human ~tz_offset_s:0 ()
707
+
let dump = Span.dump
+612
vendor/opam/ptime/src/ptime.mli
+612
vendor/opam/ptime/src/ptime.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** POSIX time values.
7
+
8
+
Consult the {{!basics}basics} and a few {{!notes}notes
9
+
and limitations}.
10
+
11
+
{b References}
12
+
{ul
13
+
{- The Open Group. {{:http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/V1_chap04.html#tag_04_15}The Open Group Base Specifications Issue 7, section 4.15 Seconds Since the Epoch}. 2013}
14
+
{- G. Klyne et al.
15
+
{{:http://tools.ietf.org/html/rfc3339}
16
+
{e Date and Time on the Internet: Timestamps}}. RFC 3339, 2002.}} *)
17
+
18
+
(** {1:timespans POSIX time spans} *)
19
+
20
+
type span
21
+
(** The type for signed picosecond precision POSIX time spans. A value
22
+
of this type represent the POSIX duration between two POSIX
23
+
timestamps. *)
24
+
25
+
(** POSIX time spans.
26
+
27
+
{b WARNING.} A POSIX time span is not equal to an SI second based time
28
+
span see the {{!basics}basics}. *)
29
+
module Span : sig
30
+
31
+
(** {1:spans POSIX time spans} *)
32
+
33
+
type t = span
34
+
(** The type for signed, picosecond precision, POSIX time spans. *)
35
+
36
+
val v : int * int64 -> span
37
+
(** [v s] is like {!of_d_ps}[ s] but raises [Invalid_argument] if
38
+
[s] is not in the right range. Use {!of_d_ps} to deal with
39
+
untrusted input. *)
40
+
41
+
val zero : span
42
+
(** [zero] is the neutral element of {!add}. *)
43
+
44
+
val of_d_ps : int * int64 -> span option
45
+
(** [of_d_ps (d, ps)] is a span for the signed POSIX picosecond
46
+
span [d] * 86_400e12 + [ps]. [d] is a signed number of POSIX
47
+
days and [ps] a number of picoseconds in the range
48
+
\[[0];[86_399_999_999_999_999L]\]. [None] is returned if
49
+
[ps] is not in the right range. *)
50
+
51
+
(**/**)
52
+
val unsafe_of_d_ps : int * int64 -> span
53
+
val unsafe_of_d_ps_option : (int * int64) option -> span option
54
+
(**/**)
55
+
56
+
val to_d_ps : span -> int * int64
57
+
(** [to_d_ps d] is the span [d] as a pair [(d, ps)] expressing the
58
+
POSIX picosecond span [d] * 86_400e12 + [ps] with
59
+
[ps] in the range \[[0];[86_399_999_999_999_999L]\] *)
60
+
61
+
val of_int_s : int -> span
62
+
(** [of_int_s secs] is a span from the signed integer POSIX second
63
+
span [secs]. *)
64
+
65
+
val to_int_s : span -> int option
66
+
(** [to_int_s d] is the span [d] as a signed integer POSIX second
67
+
span, if [int]'s range can represent it (note that this
68
+
depends on {!Sys.word_size}). Subsecond precision numbers are
69
+
truncated. *)
70
+
71
+
val of_float_s : float -> span option
72
+
(** [of_float_s secs] is a span from the signed floating point POSIX
73
+
second span [d]. Subpicosecond precision numbers are truncated.
74
+
75
+
[None] is returned if [secs] cannot be represented as a span.
76
+
This occurs on {!Stdlib.nan} or if the duration in POSIX
77
+
days cannot fit on an [int] (on 32-bit platforms this means the
78
+
absolute magnitude of the duration is greater than ~2'941'758
79
+
years). *)
80
+
81
+
val to_float_s : span -> float
82
+
(** [to_float_s s] is the span [d] as floating point POSIX seconds.
83
+
84
+
{b Warning.} The magnitude of [s] may not be represented exactly
85
+
by the floating point value. *)
86
+
87
+
(** {1:predicates Predicates} *)
88
+
89
+
val equal : span -> span -> bool
90
+
(** [equal d d'] is [true] iff [d] and [d'] are the same time span. *)
91
+
92
+
val compare : span -> span -> int
93
+
(** [compare d d'] is a total order on durations that is compatible
94
+
with signed time span order. *)
95
+
96
+
(** {1:arith Arithmetic}
97
+
98
+
{b Note.} The following functions rollover on overflows. *)
99
+
100
+
val neg : span -> span
101
+
(** [neg d] is the span [d] negated. *)
102
+
103
+
val add : span -> span -> span
104
+
(** [add d d'] is [d] + [d']. *)
105
+
106
+
val sub : span -> span -> span
107
+
(** [sub d d'] is [d] - [d']. *)
108
+
109
+
val abs : span -> span
110
+
(** [abs d] is the absolute value of span [d]. *)
111
+
112
+
(** {1:rounding Rounding} *)
113
+
114
+
val round : frac_s:int -> span -> span
115
+
(** [round ~frac_s t] is [t] rounded to the [frac_s] decimal
116
+
fractional second. Ties are rounded away from zero. [frac_s] is
117
+
clipped to the range \[[0];[12]\]. *)
118
+
119
+
val truncate : frac_s:int -> span -> span
120
+
(** [truncate ~frac_s t] is [t] truncated to the [frac_s] decimal
121
+
fractional second. [frac_s] is clipped to the range
122
+
\[[0];[12]\]. *)
123
+
124
+
(** {1:print Pretty printing} *)
125
+
126
+
val pp : Format.formatter -> span -> unit
127
+
(** [pp ppf d] prints an unspecified, approximative, representation of [d]
128
+
on [ppf].
129
+
130
+
The representation is not fixed-width, depends on the magnitude of [d]
131
+
and uses locale independent
132
+
{{:http://www.bipm.org/en/publications/si-brochure/chapter3.html}SI
133
+
prefixes} on seconds and
134
+
{{:http://www.bipm.org/en/publications/si-brochure/table6.html}accepted
135
+
non-SI units}. Years are counted in Julian years (365.25
136
+
SI-accepted days) as
137
+
{{:http://www.iau.org/publications/proceedings_rules/units/}defined}
138
+
by the International Astronomical Union (IUA).
139
+
140
+
The representation is approximative. In particular beyond 60
141
+
seconds it only keeps the two most significant time units and
142
+
rounds towards the infinity. The latter means that case arising,
143
+
it always {e over} approximates durations.
144
+
145
+
{b Warning} Becomes unprecise (but does not overflow) if the
146
+
absolute number of POSIX days in the time span is greater than [max_int /
147
+
4] (on 32-bit platforms this is ~735'439 years) *)
148
+
149
+
val dump : Format.formatter -> span -> unit
150
+
(** [dump ppf s] prints an unspecified raw representation of [d]
151
+
on [ppf]. *)
152
+
end
153
+
154
+
(** {1:timestamps POSIX timestamps} *)
155
+
156
+
type t
157
+
(** The type for picosecond precision POSIX timestamps in the range
158
+
\[{!min};{!max}\]. Note that POSIX timestamps, and hence values of
159
+
this type, are by definition always on the UTC timeline. *)
160
+
161
+
val v : int * int64 -> t
162
+
(** [v s] is [of_span (Span.v s)] but raise [Invalid_argument] if [s]
163
+
is not in the right range. Use {!Span.of_d_ps} and {!of_span}
164
+
to deal with untrusted input. *)
165
+
166
+
val epoch : t
167
+
(** [epoch] is 1970-01-01 00:00:00 UTC. *)
168
+
169
+
val min : t
170
+
(** [min] is 0000-01-01 00:00:00 UTC, the earliest timestamp
171
+
representable by {!Ptime}. *)
172
+
173
+
val max : t
174
+
(** [max] is 9999-12-31 23:59:59.999999999999 UTC, the latest timestamp
175
+
representable by {!Ptime}. *)
176
+
177
+
val of_span : span -> t option
178
+
(** [of_span d] is the POSIX time stamp that:
179
+
{ul
180
+
{- Happens at the POSIX span [d] {e after} {!epoch}
181
+
if [d] is positive.}
182
+
{- Happens at the POSIX span [d] {e before} {!epoch}
183
+
if [d] is negative.}}
184
+
[None] is returned if the timestamp is not in the range
185
+
\[{!min};{!max}\]. *)
186
+
187
+
val to_span : t -> span
188
+
(** [to_span t] is the signed POSIX span that happen between [t]
189
+
and {!epoch}:
190
+
{ul
191
+
{- If the number is positive [t] happens {e after} {!epoch}.}
192
+
{- If the number is negative [t] happens {e before} {!epoch}.}} *)
193
+
194
+
(**/**)
195
+
val unsafe_of_d_ps : int * int64 -> t
196
+
(**/**)
197
+
198
+
val of_float_s : float -> t option
199
+
(** [of_float_s d] is like {!of_span} but with [d] as a floating point
200
+
second POSIX span [d]. This function is compatible with the result
201
+
of {!Unix.gettimeofday}. Decimal fractional seconds beyond [1e-12]
202
+
are truncated. *)
203
+
204
+
val to_float_s : t -> float
205
+
(** [to_float_s t] is like {!to_span} but returns a floating point second
206
+
POSIX span.
207
+
208
+
{b Warning.} Due to floating point inaccuracies do not expect the
209
+
function to round trip with {!of_float_s}; especially near
210
+
{!Ptime.min} and {!Ptime.max}. *)
211
+
212
+
val truncate : frac_s:int -> t -> t
213
+
(** [truncate ~frac_s t] is [t] truncated to the [frac_s] decimal
214
+
fractional second. Effectively this reduces precision without
215
+
rounding, the timestamp remains in the second it is in. [frac_s]
216
+
is clipped to the range \[[0];[12]\]. *)
217
+
218
+
val frac_s : t -> span
219
+
(** [frac_s t] is the (positive) fractional second duration in [t]. *)
220
+
221
+
(** {1:predicates Predicates} *)
222
+
223
+
val equal : t -> t -> bool
224
+
(** [equal t t'] is [true] iff [t] and [t'] are the same timestamps. *)
225
+
226
+
val compare : t -> t -> int
227
+
(** [compare t t'] is a total order on timestamps that is compatible
228
+
with timeline order. *)
229
+
230
+
val is_earlier : t -> than:t -> bool
231
+
(** [is_earlier t ~than] is [true] iff [compare t than = -1]. *)
232
+
233
+
val is_later : t -> than:t -> bool
234
+
(** [is_later t than] is [true] iff [compare t than = 1]. *)
235
+
236
+
(** {1:posix_arithmetic POSIX arithmetic}
237
+
238
+
{b WARNING.} A POSIX time span is not equal to an SI second based
239
+
time span, see the {{!basics}basics}. Do not use these functions
240
+
to perform calendar arithmetic or measure wall-clock durations,
241
+
you will fail. *)
242
+
243
+
val add_span : t -> span -> t option
244
+
(** [add_span t d] is timestamp [t + d], that is [t] with the signed
245
+
POSIX span [d] added. [None] is returned if the result is not
246
+
in the range \[{!min};{!max}\]. *)
247
+
248
+
val sub_span : t -> span -> t option
249
+
(** [sub_span t d] is the timestamp [t - d], that is [t] with the
250
+
signed POSIX span [d] subtracted. [None] is returned if the result
251
+
is not in the range \[{!min};{!max}\]. *)
252
+
253
+
val diff : t -> t -> span
254
+
(** [diff t t'] is the signed POSIX span [t - t'] that happens between
255
+
the timestamps [t] and [t']. *)
256
+
257
+
(** {1:tz_offset Time zone offsets between local and UTC timelines} *)
258
+
259
+
type tz_offset_s = int
260
+
(** The type for time zone offsets between local and UTC timelines
261
+
in seconds. This is the signed difference in seconds between the local
262
+
timeline and the UTC timeline:
263
+
{[
264
+
tz_offset_s = local - UTC
265
+
]}
266
+
{ul
267
+
{- A value of [-3600] means that the local timeline is sixty minutes
268
+
{e behind} the UTC timeline.}
269
+
{- A value of [3600] means that the local timeline is sixty
270
+
minutes {e ahead} the UTC timeline.}} *)
271
+
272
+
(** {1:date_time Date-time value conversions}
273
+
274
+
A {e date-time} represents a point on the UTC timeline by pairing
275
+
a date in the proleptic Gregorian calendar and a second precision
276
+
daytime in a local timeline with stated relationship to the UTC
277
+
timeline. *)
278
+
279
+
type date = int * int * int
280
+
(** The type for big-endian proleptic Gregorian dates. A triple
281
+
[(y, m, d)] with:
282
+
{ul
283
+
{- [y] the year from [0] to [9999]. [0] denotes -1 BCE
284
+
(this follows the
285
+
{{:http://www.iso.org/iso/home/standards/iso8601.htm}ISO 8601}
286
+
convention).}
287
+
{- [m] is the month from [1] to [12]}
288
+
{- [d] is the day from [1] to [28], [29], [30] or [31]
289
+
depending on [m] and [y]}}
290
+
291
+
A date is said to be {e valid} iff the values [(y, m, d)] are
292
+
in the range mentioned above and represent an existing date in the
293
+
proleptic Gregorian calendar. *)
294
+
295
+
type time = (int * int * int) * tz_offset_s
296
+
(** The type for daytimes on a local timeline. Pairs a triple [(hh,
297
+
mm, ss)] denoting the time on the local timeline and a [tz_offset]
298
+
stating the {{!tz_offset_s}relationship} of the local timeline to
299
+
the UTC timeline.
300
+
301
+
The [(hh, mm, ss)] components are understood and constrainted as
302
+
follows:
303
+
{ul
304
+
{- [hh] is the hour from [0] to [23].}
305
+
{- [mm] is the minute from [0] to [59].}
306
+
{- [ss] is the seconds from [0] to [60]. [60] may happen whenever
307
+
a leap second is added.}}
308
+
A [time] value is said to be {e valid} iff the values [(hh, mm, ss)]
309
+
are in the ranges mentioned above. *)
310
+
311
+
(** {2:datetimes Date and time} *)
312
+
313
+
val of_date_time : date * time -> t option
314
+
(** [of_date_time dt] is the POSIX timestamp corresponding to
315
+
date-time [dt] or [None] if [dt] has an {{!date}invalid date},
316
+
{{!time}invalid time} or the date-time is not in the range
317
+
\[{!min};{!max}\].
318
+
319
+
{b Leap seconds.} Any date-time with a seconds value of [60], hence
320
+
representing a leap second addition, is mapped to the date-time
321
+
that happens 1 second later. Any date-time with a seconds value of
322
+
[59] is mapped to the POSIX timestamp that represents this
323
+
instant, if a leap second was subtracted at that point, this is
324
+
the POSIX timestamp that represents this inexisting instant. See
325
+
the {{!basics}basics}. *)
326
+
327
+
val to_date_time : ?tz_offset_s:tz_offset_s -> t -> date * time
328
+
(** [to_date_time ~tz_offset_s t] is the date-time of the timestamp [t].
329
+
330
+
[tz_offset_s] hints the time zone offset used for the resulting
331
+
daytime component (defaults to [0], i.e. UTC). The offset is not
332
+
honoured and fallbacks to [0] in case the resulting date-time
333
+
rendering of the timestamp would yield an {{!date}invalid
334
+
date}. This means that you should always interpret the resulting
335
+
time component with the time zone offset it is paired with in the
336
+
result and not assume it will be the one you gave to the
337
+
function. Note that for real-world time zone offsets the fallback
338
+
to [0] will only happen around {!Ptime.min} and {!Ptime.max}.
339
+
Formally the fallback occurs whenever [add_span t (Span.of_int_s
340
+
tz_offset_s)] is [None].
341
+
342
+
{b Leap seconds.} No POSIX timestamp can represent a date-time
343
+
with a leap second added, hence this function will never return a
344
+
date-time with a [60] seconds value. This function does return
345
+
inexisting UTC date-times with [59] seconds whenever a leap second is
346
+
subtracted since POSIX timestamps do represent them. See the
347
+
{{!basics}basics}.
348
+
349
+
{b Subsecond precision.} POSIX timestamps with subsecond precision
350
+
are floored, i.e. the date-time always has the second mentioned in
351
+
the timestamp. *)
352
+
353
+
(** {2:dates Date} *)
354
+
355
+
val of_date : ?tz_offset_s:tz_offset_s -> date -> t option
356
+
(** [of_date d] is
357
+
[of_date_time (d, ((00, 00, 00), tz_offset_s))]. [tz_offset_s]
358
+
defaults to 0, i.e. UTC. *)
359
+
360
+
val to_date : ?tz_offset_s:tz_offset_s -> t -> date
361
+
(** [to_date t] is [fst (to_date_time ?tz_offset_s t)]. *)
362
+
363
+
(** {2:years Year} *)
364
+
365
+
val of_year : ?tz_offset_s:tz_offset_s -> int -> t option
366
+
(** [of_year y] is [of_date ?tz_offset_s (y, 01, 01)]. *)
367
+
368
+
val to_year : ?tz_offset_s:tz_offset_s -> t -> int
369
+
(** [to_year t] is the first component of [(to_date ?tz_offset_s t))] but
370
+
more efficient. *)
371
+
372
+
(** {2:weekdays Week days} *)
373
+
374
+
type weekday = [ `Sun | `Mon | `Tue | `Wed | `Thu | `Fri | `Sat ]
375
+
(** The type for the days of the 7-day week. *)
376
+
377
+
val weekday : ?tz_offset_s:tz_offset_s -> t -> weekday
378
+
(** [weekday ~tz_offset_s t] is the day in the 7-day week of timestamp [t]
379
+
expressed in the time zone offset [ts_offset_s] (defaults to [0]). *)
380
+
381
+
val weekday_num : ?tz_offset_s:tz_offset_s -> t -> int
382
+
(** [weekday_num] is like {!weekday} but returns a weekday number, 0
383
+
is sunday, 1 is monday, …, 6 is saturday etc. *)
384
+
385
+
(** {1:rfc3339 RFC 3339 timestamp conversions} *)
386
+
387
+
type error_range = int * int
388
+
(** The type for error ranges, starting and ending position. *)
389
+
390
+
type rfc3339_error =
391
+
[ `Invalid_stamp
392
+
| `Eoi
393
+
| `Exp_chars of char list
394
+
| `Trailing_input ]
395
+
(** The type for RFC 3339 timestamp parsing errors. [`Invalid_stamp]
396
+
means that either the time stamp is not in the range
397
+
\[{!min};{!max}\], or the date is invalid, or one of the fields is
398
+
not in the right range. *)
399
+
400
+
val pp_rfc3339_error : Format.formatter -> rfc3339_error -> unit
401
+
(** [pp_rfc3339_error ppf e] prints an unspecified representation of
402
+
[e] on [ppf]. *)
403
+
404
+
val rfc3339_error_to_msg : ('a, [`RFC3339 of error_range * rfc3339_error])
405
+
result -> ('a, [> `Msg of string]) result
406
+
(** [rfc3339_error_to_msg r] converts RFC 3339 parse errors to error
407
+
messages. *)
408
+
409
+
val rfc3339_string_error :
410
+
('a, [`RFC3339 of error_range * rfc3339_error]) result -> ('a, string) result
411
+
(** [rfc3339_string_error r] converts RFC 3339 parse errors errors to
412
+
string errors. *)
413
+
414
+
val of_rfc3339 : ?strict:bool -> ?sub:bool -> ?start:int -> string ->
415
+
((t * tz_offset_s option * int),
416
+
[> `RFC3339 of error_range * rfc3339_error]) result
417
+
(** [of_rfc3339 ~strict ~sub ~start s] parses an RFC 3339
418
+
{{:https://tools.ietf.org/html/rfc3339#section-5.6}[date-time]}
419
+
starting at [start] (defaults to [0]) in [s] to a triple [(t, tz, count)]
420
+
with:
421
+
{ul
422
+
{- [t] the POSIX timestamp (hence on the UTC timeline).}
423
+
{- [tz], the optional {{!tz_offset_s}time zone offset} found in the
424
+
timestamp. [None] is returned iff the date-time satisfies the
425
+
{{:https://tools.ietf.org/html/rfc3339#section-4.3}unknown local
426
+
offset convention}.}
427
+
{- [count] the number of bytes read starting at [start] to parse the
428
+
timestamp. If [sub] is [false] (default) this is always
429
+
[String.length s - start] and [Error `Trailing_input] is returned
430
+
if there are still bytes in [s] after the date-time was parsed. Use
431
+
[~sub:true] for allowing trailing input to exist.}
432
+
{- [strict] if [false] (default) the pasring function does
433
+
not error on timestamp with lowercase ['T'] or ['Z'] characters, or
434
+
space separated date and times, and `hhmm` and `hh` timezone
435
+
offsets (strict mandates [hh:mm]). This allows to parse a slightly
436
+
larger subset of ISO 8601 than what RFC 3339 allows}}
437
+
438
+
{b Notes and limitations.}
439
+
{ul
440
+
{- If [start] is not an index of [s], [Error ((start, start), `Eoi)] is
441
+
returned.}
442
+
{- RFC 3339 allows a few degenerate (I say) timestamps with
443
+
non-zero time zone offsets to be parsed at the boundaries that
444
+
correspond to timestamps that cannot be expressed in UTC in RFC
445
+
3339 itself (e.g. [0000-01-01T00:00:00+00:01]). The function
446
+
errors on these timestamps with [`Invalid_stamp] as they cannot
447
+
be represented in the range \[{!min};{!max}\].}
448
+
{- Leap seconds are allowed on any date-time and handled as in
449
+
{!of_date_time}}
450
+
{- Fractional parts beyond the picosecond ([1e-12]) are truncated.}} *)
451
+
452
+
val to_rfc3339 : ?space:bool -> ?frac_s:int -> ?tz_offset_s:tz_offset_s ->
453
+
t -> string
454
+
(** [to_rfc3339_tz ~space ~frac_s ~tz_offset_s t] formats the timestamp
455
+
[t] according to a RFC 3339
456
+
{{:https://tools.ietf.org/html/rfc3339#section-5.6}[date-time]}
457
+
production with:
458
+
{ul
459
+
{- [tz_offset_s] hints the time zone offset to use, use [0] for UTC.
460
+
The hint is ignored in the following cases: if [tz_offset_s] is not an
461
+
integral number of minutes and its magnitude not in the range permitted
462
+
by the standard, if [add_span t (Span.of_int_s tz_offset_s)] is [None]
463
+
(the resulting timestamp rendering would not be RFC 3339 compliant).
464
+
If either the hint is ignored or [tz_offset_s] is unspecified then
465
+
the
466
+
{{:https://tools.ietf.org/html/rfc3339#section-4.3}unknown local offset
467
+
convention} is used to render the time zone component.}
468
+
{- [frac_s], clipped to the range \[[0];[12]\] specifies that exactly
469
+
[frac_s] decimal digits of the fractional second of [t] are
470
+
rendered (defaults to [0]).}
471
+
{- [space] if [true] the date and time separator is a space
472
+
rather than a ['T'] (not recommended but may be allowed by the
473
+
protocol you are dealing with, defaults to [false]).}} *)
474
+
475
+
val pp_rfc3339 : ?space:bool -> ?frac_s:int -> ?tz_offset_s:tz_offset_s ->
476
+
unit -> Format.formatter -> t -> unit
477
+
(** [pp_rfc3339 ?space ?frac_s ?tz_offset_s () ppf t] is
478
+
[Format.fprintf ppf "%s" (to_rfc3339 ?space ?frac_s ?tz_offset_s t)]. *)
479
+
480
+
(** {1:print Pretty printing} *)
481
+
482
+
val pp_human : ?frac_s:int -> ?tz_offset_s:tz_offset_s -> unit ->
483
+
Format.formatter -> t -> unit
484
+
(** [pp_human ~frac_s ~tz_offset_s () ppf t] prints an unspecified, human
485
+
readable, locale-independent, representation of [t] with:
486
+
{ul
487
+
{- [tz_offset_s] hints the time zone offset to use. The hint is ignored
488
+
in the following cases: if [tz_offset_s] is not an integral number of
489
+
minutes and its magnitude not in the range permitted by the standard,
490
+
if [add_span t (Span.of_int_s tz_offset_s)] is [None].
491
+
If either the hint is ignored or [tz_offset_s] is unspecified then
492
+
RFC 3339's
493
+
{{:https://tools.ietf.org/html/rfc3339#section-4.3}unknown local offset
494
+
convention} is used to render the time zone component.}
495
+
{- [frac_s] clipped to the range \[[0];[12]\] specifies that exactly
496
+
[frac_s] decimal digits of the fractional second of [t] are
497
+
rendered (defaults to [0]).}}
498
+
499
+
{b Note.} The output of this function is similar to but {b not}
500
+
compliant with RFC 3339, it should only be used for presentation,
501
+
not as a serialization format. *)
502
+
503
+
val pp : Format.formatter -> t -> unit
504
+
(** [pp] is [pp_human ~tz_offset_s:0]. *)
505
+
506
+
val dump : Format.formatter -> t -> unit
507
+
(** [dump ppf t] prints an unspecified raw representation of [t]
508
+
on [ppf]. *)
509
+
510
+
(** {1:basics Basics}
511
+
512
+
POSIX time counts POSIX seconds since the epoch 1970-01-01
513
+
00:00:00 UTC. As such a POSIX timestamp is {b always} on the UTC
514
+
timeline.
515
+
516
+
POSIX time doesn't count leap seconds, so by definition it cannot
517
+
represent them. One way of viewing this is that whenever a leap
518
+
second is added a POSIX second lasts two SI seconds and whenever a
519
+
leap second is subtracted a POSIX second lasts zero SI second.
520
+
521
+
{!Ptime} does not provide any mean to convert the duration between
522
+
two POSIX timestamps to SI seconds. The reason is that in order to
523
+
accurately find this number, a
524
+
{{:http://www.ietf.org/timezones/data/leap-seconds.list}leap
525
+
second table} is needed. However since this table may change every
526
+
six months, {!Ptime} decides not to include it so as not to
527
+
potentially become incorrect every six months.
528
+
529
+
This decision has the following implications. First it should be
530
+
realised that the durations mentioned by the {!add_span},
531
+
{!sub_span} and {!diff} functions are expressed in {e
532
+
POSIX seconds} which may represent zero, one, or two SI
533
+
seconds. For example if we add 1 second with
534
+
{!add_span} to the POSIX timestamp for 1998-12-31 23:59:59 UTC,
535
+
what we get is the timestamp for 1999-01-01 00:00:00 UTC:
536
+
{[
537
+
let get = function None -> assert false | Some v -> v
538
+
let utc d t = get @@ Ptime.of_date_time (d, (t, 0))
539
+
let t0 = utc (1998, 12, 31) (23, 59, 59)
540
+
let t1 = utc (1999, 01, 01) (00, 00, 00)
541
+
let one_s = Ptime.Span.of_int_s 1
542
+
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t1)
543
+
]}
544
+
However since the leap second 1998-12-31 23:59:60 UTC exists,
545
+
{e two} actual SI seconds elapsed between [t0] and [t1]. Now if we use
546
+
{!diff} to find the POSIX duration that elapsed between
547
+
[t0] and [t1] we get one POSIX second:
548
+
{[
549
+
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) one_s)
550
+
]}
551
+
But still, two SI seconds elapsed between these two points in
552
+
time. Note also that no value of type {!t} can represent the UTC
553
+
timetamp 1998-12-31 23:59:60 and hence {!Ptime.to_date_time}
554
+
will never return a date-time with a seconds value of [60]. In
555
+
fact both 1998-12-31 23:59:60 UTC and 1999-01-01 00:00:00 UTC are
556
+
represented by the same timestamp:
557
+
{[
558
+
let t2 = utc (1998, 12, 31) (23, 59, 60)
559
+
let () = assert (Ptime.equal t1 t2)
560
+
]}
561
+
This is true of any added leap second, we map it on the first second
562
+
of the next minute, thus matching the behaviour
563
+
of POSIX's
564
+
{{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/mktime.html}
565
+
mktime} function.
566
+
567
+
If a leap second is subtracted on a day the following occurs –
568
+
2015, as of writing this never happened. Let YYYY-06-30 23:59:58
569
+
be the instant a leap second is subtracted, this means that the
570
+
next UTC date-time, one SI second later, is YYYY-07-01
571
+
00:00:00. However if we diff the two instants:
572
+
{[
573
+
let y = 9999 (* hypothetical year were this happens *)
574
+
let t0 = utc (y, 06, 30) (23, 59, 58)
575
+
let t1 = utc (y, 07, 01) (00, 00, 00)
576
+
let two_s = Ptime.Span.of_int_s 2
577
+
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) two_s)
578
+
]}
579
+
We get two POSIX seconds, but only one SI second
580
+
elapsed between these two points in time. It should also
581
+
be noted that POSIX time will represent a point that never
582
+
existed in time namely YYYY-06-30 23:59:59, the POSIX second
583
+
with 0 SI second duration and that {!Ptime.to_date_time}
584
+
will return a date-time value for this timestamp even though
585
+
it never existed:
586
+
{[
587
+
let t2 = utc (y, 06, 30) (23, 59, 59)
588
+
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t2)
589
+
]}
590
+
591
+
{1:notes Notes and limitations}
592
+
593
+
The following points should be taken into account
594
+
{ul
595
+
{- {!Ptime} is not a calendar library and will never be.}
596
+
{- {!Ptime} can only represent picosecond precision timestamps in
597
+
the range \[{!Ptime.min};{!Ptime.max}\]. It is however able to
598
+
convert {e any} of these timestamps to a valid date-time or RFC
599
+
3339 timestamp.}
600
+
{- POSIX time in general is ill-suited to measure wall-clock
601
+
time spans for the following reasons.
602
+
{ul
603
+
{- POSIX time counts time in POSIX seconds. POSIX
604
+
seconds can represent 2, 1 or 0 SI seconds. [Ptime]
605
+
offers no mechanism to determine the SI duration between
606
+
two timestamps, see the {{!basics}basics}.}
607
+
{- The POSIX timestamps returned by your platform are not
608
+
monotonic: they are subject to operating system time
609
+
adjustements and can even go back in time. If you need to
610
+
measure time spans in a single program run use a monotonic
611
+
time source (e.g. {!Mtime}).}}}}
612
+
*)
+1
vendor/opam/ptime/src/ptime.mllib
+1
vendor/opam/ptime/src/ptime.mllib
···
1
+
Ptime
+7
vendor/opam/ptime/src/ptime_top_init.ml
+7
vendor/opam/ptime/src/ptime_top_init.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
#install_printer Ptime.pp;;
7
+
#install_printer Ptime.Span.pp;;
+5
vendor/opam/ptime/src/top/dune
+5
vendor/opam/ptime/src/top/dune
+6
vendor/opam/ptime/src/top/ptime_top.ml
+6
vendor/opam/ptime/src/top/ptime_top.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let () = ignore (Toploop.use_file Format.err_formatter "ptime_top_init.ml")
+1
vendor/opam/ptime/src/top/ptime_top.mllib
+1
vendor/opam/ptime/src/top/ptime_top.mllib
···
1
+
Ptime_top
+25
vendor/opam/ptime/test/examples.ml
+25
vendor/opam/ptime/test/examples.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2024 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: CC0-1.0
4
+
---------------------------------------------------------------------------*)
5
+
6
+
let get = function None -> assert false | Some v -> v
7
+
let utc d t = get @@ Ptime.of_date_time (d, (t, 0))
8
+
let t0 = utc (1998, 12, 31) (23, 59, 59)
9
+
let t1 = utc (1999, 01, 01) (00, 00, 00)
10
+
let one_s = Ptime.Span.of_int_s 1
11
+
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t1)
12
+
13
+
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) one_s)
14
+
15
+
let t2 = utc (1998, 12, 31) (23, 59, 60)
16
+
let () = assert (Ptime.equal t1 t2)
17
+
18
+
let y = 9999 (* hypothetical year were this happens *)
19
+
let t0 = utc (y, 06, 30) (23, 59, 58)
20
+
let t1 = utc (y, 07, 01) (00, 00, 00)
21
+
let two_s = Ptime.Span.of_int_s 2
22
+
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) two_s)
23
+
24
+
let t2 = utc (y, 06, 30) (23, 59, 59)
25
+
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t2)
+33
vendor/opam/ptime/test/min_clock.ml
+33
vendor/opam/ptime/test/min_clock.ml
···
1
+
(*
2
+
Compile with:
3
+
4
+
ocamlfind ocamlopt \
5
+
-package ptime.clock -linkpkg -o min_clock.native min_clock.ml
6
+
7
+
ocamlfind ocamlc \
8
+
-package ptime.clock -linkpkg -o min_clock.byte min_clock.ml
9
+
10
+
js_of_ocaml \
11
+
$(ocamlfind query -format "%+(jsoo_runtime)" -r ptime.clock) \
12
+
min_clock.byte
13
+
*)
14
+
15
+
let pp_period ppf = function
16
+
| None -> Format.fprintf ppf "unknown"
17
+
| Some p -> Ptime.Span.pp ppf p
18
+
19
+
let pp_tz ppf = function
20
+
| None -> Format.fprintf ppf "unknown"
21
+
| Some tz -> Format.fprintf ppf "%ds" tz
22
+
23
+
let main () =
24
+
let now = Ptime_clock.now () in
25
+
let tz_offset_s = Ptime_clock.current_tz_offset_s () in
26
+
let period = Ptime_clock.period () in
27
+
Format.printf "Clock period: %a@." pp_period period;
28
+
Format.printf " TZ offset: %a@." pp_tz tz_offset_s;
29
+
Format.printf " Now UTC : %a@." Ptime.pp now;
30
+
Format.printf " Now local: %a@." Ptime.(pp_human ?tz_offset_s ()) now;
31
+
()
32
+
33
+
let () = if !Sys.interactive then () else main ()
+147
vendor/opam/ptime/test/test_base.ml
+147
vendor/opam/ptime/test/test_base.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_testing
7
+
open Testing_ptime
8
+
9
+
let span_of_d_ps ?__POS__ s =
10
+
Test.noraise ?__POS__ @@ fun () -> Option.get (Ptime.Span.of_d_ps s)
11
+
12
+
let test_base =
13
+
Test.test "stamp constants and base constructors" @@ fun () ->
14
+
let of_span s = Ptime.(of_span (span_of_d_ps s)) in
15
+
let get_of_span s = match of_span s with None -> assert false | Some s -> s in
16
+
let to_raw_span t = Ptime.(Span.to_d_ps (to_span t)) in
17
+
T.raw_span ~__POS__
18
+
(to_raw_span Ptime.epoch) (0, 0L);
19
+
T.stamp_option ~__POS__
20
+
(of_span (0, 0L)) (Some Ptime.epoch);
21
+
T.raw_span ~__POS__
22
+
(to_raw_span Ptime.min) (-719528, 0L);
23
+
T.stamp_option ~__POS__
24
+
(of_span (-719528, 0L)) (Some Ptime.min);
25
+
T.stamp_option ~__POS__
26
+
(of_span (-719529, 86_399_999_999_999_999L)) None;
27
+
T.raw_span ~__POS__
28
+
(to_raw_span Ptime.max) (2932896, 86_399_999_999_999_999L);
29
+
T.stamp_option ~__POS__
30
+
(of_span (2932896, 86_399_999_999_999_999L)) (Some Ptime.max);
31
+
T.stamp_option ~__POS__
32
+
(of_span (2932897, 0L)) None;
33
+
Test.float ~__POS__
34
+
(Ptime.to_float_s Ptime.epoch) 0.;
35
+
T.stamp_option ~__POS__
36
+
(Ptime.of_float_s 0.) (Some Ptime.epoch);
37
+
Test.float ~__POS__
38
+
(Ptime.to_float_s Ptime.min) ~-.62167219200.;
39
+
T.stamp_option ~__POS__
40
+
(Ptime.of_float_s ~-.62167219200.) (Some Ptime.min);
41
+
T.stamp_option ~__POS__
42
+
(Ptime.of_float_s ~-.62167219201.) None;
43
+
Test.float ~__POS__
44
+
(Ptime.to_float_s (Ptime.truncate ~frac_s:0 Ptime.max)) 253402300799.;
45
+
T.stamp_option ~__POS__
46
+
(Ptime.of_float_s 253402300799.)
47
+
(Some (Ptime.truncate ~frac_s:0 Ptime.max));
48
+
T.stamp_option ~__POS__
49
+
(Ptime.of_float_s 253402300800.) None;
50
+
T.stamp_option ~__POS__
51
+
(Ptime.of_float_s nan) None;
52
+
T.stamp_option ~__POS__
53
+
(Ptime.of_float_s infinity) None;
54
+
T.stamp_option ~__POS__
55
+
(Ptime.of_float_s ~-.infinity) None;
56
+
T.raw_span ~__POS__
57
+
Ptime.(Span.to_d_ps (frac_s Ptime.max)) (0, 999_999_999_999L);
58
+
T.span ~__POS__
59
+
(Ptime.frac_s @@ get_of_span (0, 100_000_000_000L))
60
+
(span_of_d_ps (0, 100_000_000_000L));
61
+
T.span ~__POS__
62
+
(Ptime.frac_s @@ get_of_span (-1, 100_000_000_000L))
63
+
(span_of_d_ps (0, 100_000_000_000L));
64
+
()
65
+
66
+
let test_predicates =
67
+
Test.test "stamp predicates" @@ fun () ->
68
+
Test.bool ~__POS__ Ptime.(is_earlier min ~than:min) false;
69
+
Test.bool ~__POS__ Ptime.(is_earlier min ~than:epoch) true;
70
+
Test.bool ~__POS__ Ptime.(is_earlier min ~than:max) true;
71
+
Test.bool ~__POS__ Ptime.(is_earlier epoch ~than:min) false;
72
+
Test.bool ~__POS__ Ptime.(is_earlier epoch ~than:epoch) false;
73
+
Test.bool ~__POS__ Ptime.(is_earlier epoch ~than:max) true;
74
+
Test.bool ~__POS__ Ptime.(is_earlier max ~than:min) false;
75
+
Test.bool ~__POS__ Ptime.(is_earlier max ~than:epoch) false;
76
+
Test.bool ~__POS__ Ptime.(is_earlier max ~than:max) false;
77
+
Test.bool ~__POS__ Ptime.(is_later min ~than:min) false;
78
+
Test.bool ~__POS__ Ptime.(is_later min ~than:epoch) false;
79
+
Test.bool ~__POS__ Ptime.(is_later min ~than:max) false;
80
+
Test.bool ~__POS__ Ptime.(is_later epoch ~than:min) true;
81
+
Test.bool ~__POS__ Ptime.(is_later epoch ~than:epoch) false;
82
+
Test.bool ~__POS__ Ptime.(is_later epoch ~than:max) false;
83
+
Test.bool ~__POS__ Ptime.(is_later max ~than:min) true;
84
+
Test.bool ~__POS__ Ptime.(is_later max ~than:epoch) true;
85
+
Test.bool ~__POS__ Ptime.(is_later max ~than:max) false;
86
+
()
87
+
88
+
let test_posix_arithmetic =
89
+
Test.test "stamp POSIX arithmetic" @@ fun () ->
90
+
let span ps = span_of_d_ps (0, ps) in
91
+
let nspan ps = Ptime.Span.(neg (span_of_d_ps (0, ps))) in
92
+
(* Test limits *)
93
+
T.stamp_option ~__POS__ Ptime.(add_span max (span 1L)) None;
94
+
T.stamp_option ~__POS__ Ptime.(add_span min (nspan (1L))) None;
95
+
T.stamp_option ~__POS__ Ptime.(sub_span min (span 1L)) None;
96
+
T.stamp_option ~__POS__ Ptime.(sub_span max (nspan (1L))) None;
97
+
(* Test arithmetic *)
98
+
T.stamp_option ~__POS__
99
+
(Ptime.of_span (span 10L)) Ptime.(add_span epoch (span 10L));
100
+
T.stamp_option ~__POS__
101
+
(Ptime.of_span (nspan 10L)) Ptime.(sub_span epoch (span 10L));
102
+
T.stamp_option ~__POS__
103
+
(Ptime.of_span (nspan (10L))) Ptime.(sub_span epoch (span 10L));
104
+
Test.block @@ fun () ->
105
+
let of_span ps =
106
+
let s = span_of_d_ps (0, Int64.abs ps) in
107
+
Ptime.of_span (if ps < 0L then Ptime.Span.neg s else s)
108
+
in
109
+
let get ?__POS__ s =
110
+
Test.noraise ?__POS__ @@ fun () -> Option.get (of_span s)
111
+
in
112
+
let t0 = get ~__POS__ 20L in
113
+
let t1 = get ~__POS__ 10L in
114
+
let t2 = get ~__POS__ (-10L) in
115
+
T.span ~__POS__ (Ptime.diff t0 t1) (span 10L);
116
+
T.span ~__POS__ (Ptime.diff t1 t0) (nspan 10L);
117
+
T.span ~__POS__ (Ptime.diff t2 t0) (nspan 30L);
118
+
T.span ~__POS__ (Ptime.diff t0 t2) (span 30L);
119
+
()
120
+
121
+
let test_truncation =
122
+
Test.test "stamp truncation" @@ fun () ->
123
+
let p ~frac_s t =
124
+
let d1 = Ptime.(diff t min) |> Ptime.Span.truncate ~frac_s
125
+
and d2 = Ptime.diff (Ptime.truncate ~frac_s t) Ptime.min in
126
+
T.span ~__POS__ d1 d2
127
+
in
128
+
let t ~frac_s ps =
129
+
p ~frac_s (Ptime.v (0, ps));
130
+
p ~frac_s (Ptime.v (1, ps));
131
+
p ~frac_s (Ptime.v (-1, ps));
132
+
p ~frac_s (Ptime.v (2932896, ps));
133
+
p ~frac_s (Ptime.v (-719528, ps));
134
+
in
135
+
for i = 0 to 12 do
136
+
t ~frac_s:i 0L;
137
+
t ~frac_s:i 86_399_999_999_999_999L;
138
+
t ~frac_s:i 86_399_000_000_000_000L;
139
+
done;
140
+
()
141
+
142
+
let tests () =
143
+
test_base ();
144
+
test_predicates ();
145
+
test_posix_arithmetic ();
146
+
test_truncation ();
147
+
()
+134
vendor/opam/ptime/test/test_date.ml
+134
vendor/opam/ptime/test/test_date.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_testing
7
+
open Testing_ptime
8
+
9
+
let test_bounds =
10
+
Test.test "calendar date field bounds" @@ fun () ->
11
+
let valid_date ?__POS__ d =
12
+
Test.holds ?__POS__ (Option.is_some (Ptime.of_date ?tz_offset_s:None d))
13
+
in
14
+
let wrong_date ?__POS__ d =
15
+
Test.holds ?__POS__ (Option.is_none (Ptime.of_date ?tz_offset_s:None d))
16
+
in
17
+
(* Check year bounds *)
18
+
wrong_date ~__POS__ (-1, 01, 01);
19
+
valid_date ~__POS__ (0, 01, 01);
20
+
valid_date ~__POS__ (1, 01, 01);
21
+
valid_date ~__POS__ (9999, 01, 01);
22
+
wrong_date ~__POS__ (10000, 01, 01);
23
+
wrong_date ~__POS__ (10001, 01, 01);
24
+
(* Check month bounds *)
25
+
wrong_date ~__POS__ (0, 00, 01);
26
+
valid_date ~__POS__ (0, 01, 01);
27
+
valid_date ~__POS__ (0, 12, 01);
28
+
wrong_date ~__POS__ (0, 13, 01);
29
+
(* Check day bounds in 2015 (month lengths) *)
30
+
(* Jan 2015 *)
31
+
wrong_date ~__POS__ (2015, 01, -1);
32
+
valid_date ~__POS__ (2015, 01, 01);
33
+
valid_date ~__POS__ (2015, 01, 31);
34
+
wrong_date ~__POS__ (2015, 01, 32);
35
+
(* Feb 2015, is not leap *)
36
+
wrong_date ~__POS__ (2015, 02, -1);
37
+
valid_date ~__POS__ (2015, 02, 01);
38
+
valid_date ~__POS__ (2015, 02, 28);
39
+
wrong_date ~__POS__ (2015, 02, 29);
40
+
(* Mar 2015 *)
41
+
wrong_date ~__POS__ (2015, 03, -1);
42
+
valid_date ~__POS__ (2015, 03, 01);
43
+
valid_date ~__POS__ (2015, 03, 31);
44
+
wrong_date ~__POS__ (2015, 03, 32);
45
+
(* Apr 2015 *)
46
+
wrong_date ~__POS__ (2015, 04, -1);
47
+
valid_date ~__POS__ (2015, 04, 01);
48
+
valid_date ~__POS__ (2015, 04, 30);
49
+
wrong_date ~__POS__ (2015, 04, 31);
50
+
(* May 2015 *)
51
+
wrong_date ~__POS__ (2015, 05, -1);
52
+
valid_date ~__POS__ (2015, 05, 01);
53
+
valid_date ~__POS__ (2015, 05, 31);
54
+
wrong_date ~__POS__ (2015, 05, 32);
55
+
(* June 2015 *)
56
+
wrong_date ~__POS__ (2015, 06, -1);
57
+
valid_date ~__POS__ (2015, 06, 01);
58
+
valid_date ~__POS__ (2015, 06, 30);
59
+
wrong_date ~__POS__ (2015, 06, 31);
60
+
(* July 2015 *)
61
+
wrong_date ~__POS__ (2015, 07, -1);
62
+
valid_date ~__POS__ (2015, 07, 01);
63
+
valid_date ~__POS__ (2015, 07, 31);
64
+
wrong_date ~__POS__ (2015, 07, 32);
65
+
(* Aug 2015 *)
66
+
wrong_date ~__POS__ (2015, 08, -1);
67
+
valid_date ~__POS__ (2015, 08, 01);
68
+
valid_date ~__POS__ (2015, 08, 31);
69
+
wrong_date ~__POS__ (2015, 08, 32);
70
+
(* Sept 2015 *)
71
+
wrong_date ~__POS__ (2015, 09, -1);
72
+
valid_date ~__POS__ (2015, 09, 01);
73
+
valid_date ~__POS__ (2015, 09, 30);
74
+
wrong_date ~__POS__ (2015, 09, 31);
75
+
(* Oct 2015 *)
76
+
wrong_date ~__POS__ (2015, 10, -1);
77
+
valid_date ~__POS__ (2015, 10, 01);
78
+
valid_date ~__POS__ (2015, 10, 31);
79
+
wrong_date ~__POS__ (2015, 10, 32);
80
+
(* Nov 2015 *)
81
+
wrong_date ~__POS__ (2015, 11, -1);
82
+
valid_date ~__POS__ (2015, 11, 01);
83
+
valid_date ~__POS__ (2015, 11, 30);
84
+
wrong_date ~__POS__ (2015, 11, 31);
85
+
(* Dec 2015 *)
86
+
wrong_date ~__POS__ (2015, 12, -1);
87
+
valid_date ~__POS__ (2015, 12, 01);
88
+
valid_date ~__POS__ (2015, 12, 31);
89
+
wrong_date ~__POS__ (2015, 12, 32);
90
+
(* 1500 is not leap *)
91
+
valid_date ~__POS__ (1500, 02, 28);
92
+
wrong_date ~__POS__ (1500, 02, 29);
93
+
(* 1700 is not leap *)
94
+
valid_date ~__POS__ (1700, 02, 28);
95
+
wrong_date ~__POS__ (1700, 02, 29);
96
+
(* 1800 is not leap *)
97
+
valid_date ~__POS__ (1800, 02, 28);
98
+
wrong_date ~__POS__ (1800, 02, 29);
99
+
(* 1900 is not leap, Lotus 1-2-3 & Excel bug *)
100
+
valid_date ~__POS__ (1900, 02, 28);
101
+
wrong_date ~__POS__ (1900, 02, 29);
102
+
(* 2000 is leap *)
103
+
valid_date ~__POS__ (2000, 02, 28);
104
+
valid_date ~__POS__ (2000, 02, 29);
105
+
wrong_date ~__POS__ (2000, 02, 30);
106
+
(* 2010 is not leap *)
107
+
valid_date ~__POS__ (2010, 02, 28);
108
+
wrong_date ~__POS__ (2010, 02, 29);
109
+
(* 2012 is leap *)
110
+
valid_date ~__POS__ (2012, 02, 29);
111
+
valid_date ~__POS__ (2012, 02, 29);
112
+
wrong_date ~__POS__ (2012, 02, 30);
113
+
(* 2100 is not leap *)
114
+
valid_date ~__POS__ (2100, 02, 28);
115
+
wrong_date ~__POS__ (2100, 02, 29);
116
+
()
117
+
118
+
let test_stamp_trips =
119
+
Test.test "random valid dates to stamps round trips" @@ fun () ->
120
+
let of_date ?__POS__ d =
121
+
Test.noraise ?__POS__ @@ fun () ->
122
+
Option.get (Ptime.of_date ?tz_offset_s:None d)
123
+
in
124
+
for i = 1 to Rand.loop_len () do
125
+
let date = Rand.date () in
126
+
let trip = Ptime.to_date (of_date date) in
127
+
T.date ~__POS__ date trip
128
+
done;
129
+
()
130
+
131
+
let tests () =
132
+
test_bounds ();
133
+
test_stamp_trips ();
134
+
()
+211
vendor/opam/ptime/test/test_date_time.ml
+211
vendor/opam/ptime/test/test_date_time.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_testing
7
+
open Testing_ptime
8
+
9
+
let stamp_of_date_time ?__POS__ d =
10
+
Test.noraise ?__POS__ @@ fun () -> Option.get (Ptime.of_date_time d)
11
+
12
+
let valid_date_time ?__POS__ d =
13
+
Test.holds ?__POS__ (Option.is_some (Ptime.of_date_time d))
14
+
15
+
let wrong_date_time ?__POS__ d =
16
+
Test.holds ?__POS__ (Option.is_none (Ptime.of_date_time d))
17
+
18
+
let test_time_bounds =
19
+
Test.test "date-time time field bounds" @@ fun () ->
20
+
let min_date = Ptime.to_date Ptime.min in
21
+
let min_utc t = min_date, (t, 0) in
22
+
(* Check hour bounds *)
23
+
wrong_date_time ~__POS__ (min_utc (-2, 00, 00));
24
+
wrong_date_time ~__POS__ (min_utc (-1, 00, 00));
25
+
valid_date_time ~__POS__ (min_utc (00, 00, 00));
26
+
valid_date_time ~__POS__ (min_utc (01, 00, 00));
27
+
valid_date_time ~__POS__ (min_utc (23, 00, 00));
28
+
wrong_date_time ~__POS__ (min_utc (24, 00, 00));
29
+
(* Check minute bounds *)
30
+
wrong_date_time ~__POS__ (min_utc (00, -2, 00));
31
+
wrong_date_time ~__POS__ (min_utc (00, -1, 00));
32
+
valid_date_time ~__POS__ (min_utc (00, 00, 00));
33
+
valid_date_time ~__POS__ (min_utc (00, 01, 00));
34
+
valid_date_time ~__POS__ (min_utc (00, 59, 00));
35
+
wrong_date_time ~__POS__ (min_utc (00, 60, 00));
36
+
(* Check second bounds *)
37
+
wrong_date_time ~__POS__ (min_utc (00, 00, -2));
38
+
wrong_date_time ~__POS__ (min_utc (00, 00, -1));
39
+
valid_date_time ~__POS__ (min_utc (00, 00, 00));
40
+
valid_date_time ~__POS__ (min_utc (00, 00, 01));
41
+
valid_date_time ~__POS__ (min_utc (00, 00, 59));
42
+
valid_date_time ~__POS__ (min_utc (00, 00, 60));
43
+
wrong_date_time ~__POS__ (min_utc (00, 00, 61));
44
+
()
45
+
46
+
let test_tz =
47
+
Test.test "testing date-time time zone calculations" @@ fun () ->
48
+
(* Timestamps with tz offsets around Ptime.{max,min} *)
49
+
wrong_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), +1));
50
+
valid_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), +0));
51
+
valid_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), -1));
52
+
wrong_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 59), -1));
53
+
wrong_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 60), +0));
54
+
valid_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 60), +1));
55
+
(* Convert time zones *)
56
+
let nyc_tz = -4 * 3600 in
57
+
let cam_tz = +1 * 3600 in
58
+
let lau_tz = +2 * 3600 in
59
+
let new_york = ((2015, 06, 27), ((18, 30, 01), nyc_tz)) in
60
+
let cambridge = ((2015, 06, 27), ((23, 30, 01), cam_tz)) in
61
+
let lausanne = ((2015, 06, 28), ((00, 30, 01), lau_tz)) in
62
+
let nyc_stamp = stamp_of_date_time new_york in
63
+
let cam_stamp = stamp_of_date_time cambridge in
64
+
let lau_stamp = stamp_of_date_time lausanne in
65
+
T.stamp ~__POS__ nyc_stamp cam_stamp;
66
+
T.stamp ~__POS__ cam_stamp lau_stamp;
67
+
T.date_time ~__POS__
68
+
(Ptime.to_date_time ~tz_offset_s:nyc_tz nyc_stamp) new_york;
69
+
T.date_time ~__POS__
70
+
(Ptime.to_date_time ~tz_offset_s:cam_tz nyc_stamp) cambridge;
71
+
T.date_time ~__POS__
72
+
(Ptime.to_date_time ~tz_offset_s:lau_tz nyc_stamp) lausanne;
73
+
()
74
+
75
+
let test_subsecond =
76
+
Test.test "subsecond stamp to date-time" @@ fun () ->
77
+
let span_of_d_ps ?__POS__ s =
78
+
Test.noraise ?__POS__ @@ fun () -> Option.get (Ptime.Span.of_d_ps s)
79
+
in
80
+
let add, sub =
81
+
let add t ps = Ptime.(add_span t (span_of_d_ps (0, ps))) |> Option.get in
82
+
let sub t ps = Ptime.(sub_span t (span_of_d_ps (0, ps))) |> Option.get in
83
+
add, sub
84
+
in
85
+
let b0 = sub Ptime.epoch 750_000_000_000L in
86
+
let b1 = sub Ptime.epoch 500_000_000_000L in
87
+
let b2 = sub Ptime.epoch 250_000_000_000L in
88
+
let b = (1969, 12, 31), ((23, 59, 59), +0) in
89
+
T.date_time ~__POS__ b (Ptime.to_date_time b0);
90
+
T.date_time ~__POS__ b (Ptime.to_date_time b1);
91
+
T.date_time ~__POS__ b (Ptime.to_date_time b2);
92
+
let a0 = add Ptime.epoch 750_000_000_000L in
93
+
let a1 = add Ptime.epoch 500_000_000_000L in
94
+
let a2 = add Ptime.epoch 250_000_000_000L in
95
+
let a = (1970, 01, 01), ((00, 00, 00), +0) in
96
+
T.date_time ~__POS__ a (Ptime.to_date_time a0);
97
+
T.date_time ~__POS__ a (Ptime.to_date_time a1);
98
+
T.date_time ~__POS__ a (Ptime.to_date_time a2);
99
+
()
100
+
101
+
let test_leap_sec =
102
+
Test.test "testing leap second date-times" @@ fun () ->
103
+
let after_leap_sec = (1999, 01, 01), ((00, 00, 00), 0) in
104
+
let t0 = stamp_of_date_time ((1998, 12, 31), ((23, 59, 59), 0)) in
105
+
let t1 = stamp_of_date_time ((1998, 12, 31), ((23, 59, 60), 0)) in
106
+
let t2 = stamp_of_date_time after_leap_sec in
107
+
T.stamp ~__POS__ t1 t2
108
+
(* leap sec is represented by second that comes after *);
109
+
T.stamp_option ~__POS__ (Some t1) Ptime.(add_span t0 (Span.of_int_s 1));
110
+
T.date_time ~__POS__ after_leap_sec (Ptime.to_date_time t1);
111
+
T.date_time ~__POS__ after_leap_sec (Ptime.to_date_time t2);
112
+
T.span ~__POS__ (Ptime.diff t2 t0) (Ptime.Span.of_int_s 1);
113
+
T.span ~__POS__ (Ptime.diff t1 t0) (Ptime.Span.of_int_s 1);
114
+
T.span ~__POS__ (Ptime.diff t2 t1) (Ptime.Span.of_int_s 0);
115
+
()
116
+
117
+
let test_stamp_trips =
118
+
Test.test "random stamps to date-time round trips" @@ fun () ->
119
+
let stamp_of_posix_s s = Option.get (Ptime.of_float_s s) in
120
+
let trip ?tz_offset_s t =
121
+
let back = stamp_of_posix_s (floor (Ptime.to_float_s t)) in
122
+
let trip = stamp_of_date_time (Ptime.to_date_time ?tz_offset_s t) in
123
+
T.stamp ~__POS__ back trip
124
+
in
125
+
for i = 1 to Rand.loop_len () do
126
+
trip ~tz_offset_s:0 (* UTC *) (Rand.float_stamp ());
127
+
trip ~tz_offset_s:(Rand.tz_offset_s ()) (Rand.float_stamp ())
128
+
done
129
+
130
+
let test_round_trips =
131
+
Test.test "random valid date-times to stamp round trips" @@ fun () ->
132
+
let is_leap_sec = function
133
+
| (_, _, _), ((_, _, 60), _) -> true
134
+
| _ -> false
135
+
in
136
+
let rec rand_date_time_stamp () = (* biased *)
137
+
let date = Rand.date () in
138
+
let time = Rand.time () in
139
+
let tz = Rand.tz_offset_s () in
140
+
let dt = (date, (time, tz)) in
141
+
match Ptime.of_date_time dt with
142
+
| Some _ -> dt
143
+
| None ->
144
+
let dt = date, (time, 0) (* try in UTC *) in
145
+
begin match Ptime.of_date_time dt with
146
+
| None -> rand_date_time_stamp () (* start again *)
147
+
| Some _ -> dt
148
+
end
149
+
in
150
+
let add_posix_s =
151
+
let span s = Option.get (Ptime.Span.of_float_s s)in
152
+
let add_posix_s t s = Option.get (Ptime.(add_span t (span s))) in
153
+
add_posix_s
154
+
in
155
+
for i = 1 to Rand.loop_len () do
156
+
let (_, (_, tz_offset_s) as dt) = rand_date_time_stamp () in
157
+
let stamp = stamp_of_date_time dt in
158
+
if not (is_leap_sec dt)
159
+
then begin
160
+
let ((y, _, _), _ as dt') = Ptime.to_date_time ~tz_offset_s stamp in
161
+
assert (Ptime.to_year ~tz_offset_s stamp = y);
162
+
T.date_time ~__POS__ dt dt'
163
+
end
164
+
else begin
165
+
(* Verify we map the leap sec on the the second after. *)
166
+
let before_leap_dt = match dt with
167
+
| date, ((hh, ss, 60), tz) -> date, ((hh, ss, 59), tz)
168
+
| _ -> assert false
169
+
in
170
+
let stamp' = add_posix_s (stamp_of_date_time before_leap_dt) 1. in
171
+
T.stamp ~__POS__ stamp stamp'
172
+
end
173
+
done;
174
+
()
175
+
176
+
let test_weekday =
177
+
Test.test "Ptime.{weekday_num,weekday}" @@ fun () ->
178
+
let module Weekday = struct
179
+
type t = Ptime.weekday
180
+
let equal = ( = )
181
+
let pp ppf v = Format.pp_print_string ppf @@ match v with
182
+
| `Mon -> "`Mon" | `Tue -> "`Tue" | `Wed -> "`Wed" | `Thu -> "`Thu"
183
+
| `Fri -> "`Fri" | `Sat -> "`Sat" | `Sun -> "`Sun"
184
+
end
185
+
in
186
+
let weekday ?__POS__ = Test.eq ?__POS__ (module Weekday) in
187
+
let eq ?__POS__ ?tz_offset_s c wday =
188
+
let s = stamp_of_date_time (c, ((0, 0, 0), 0)) in
189
+
weekday ?__POS__ (Ptime.weekday ?tz_offset_s s) wday
190
+
in
191
+
eq ~__POS__ (1970, 01, 01) `Thu;
192
+
eq ~__POS__ ~tz_offset_s:(-1) (1970, 01, 01) `Wed;
193
+
eq ~__POS__ ~tz_offset_s:86400 (1970, 01, 01) `Fri;
194
+
eq ~__POS__ (1871, 03, 18) `Sat;
195
+
eq ~__POS__ ~tz_offset_s:(-1) (1871, 03, 18) `Fri;
196
+
eq ~__POS__ ~tz_offset_s:86400 (1871, 03, 18) `Sun;
197
+
eq ~__POS__ (1995, 09, 12) `Tue;
198
+
eq ~__POS__ ~tz_offset_s:(-1) (1995, 09, 12) `Mon;
199
+
eq ~__POS__ ~tz_offset_s:86400 (1995, 09, 12) `Wed;
200
+
eq ~__POS__ ~tz_offset_s:172800 (1995, 09, 12) `Thu;
201
+
()
202
+
203
+
let tests () =
204
+
test_time_bounds ();
205
+
test_tz ();
206
+
test_subsecond ();
207
+
test_leap_sec ();
208
+
test_stamp_trips ();
209
+
test_round_trips ();
210
+
test_weekday ();
211
+
()
+38
vendor/opam/ptime/test/test_gmtime.ml
+38
vendor/opam/ptime/test/test_gmtime.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_testing
7
+
open Testing_ptime
8
+
9
+
let test_stamp_to_date_time =
10
+
Test.test "random Ptime-valid stamps to date-time" @@ fun () ->
11
+
if Sys.word_size > 32 then begin
12
+
T.date_time_gmtime_witness ~__POS__ Ptime.min;
13
+
T.date_time_gmtime_witness ~__POS__ Ptime.(truncate ~frac_s:0 max);
14
+
end;
15
+
for i = 1 to Rand.loop_len () do
16
+
T.date_time_gmtime_witness ~__POS__ (Rand.stamp ())
17
+
done;
18
+
()
19
+
20
+
let exhaustive_min_max =
21
+
if Sys.word_size > 32
22
+
then Ptime.(to_float_s min), Ptime.(to_float_s (truncate ~frac_s:0 max))
23
+
else Int32.(to_float min_int), Int32.(to_float max_int)
24
+
25
+
let test_exhaustive =
26
+
Test.test ~long:true "each Ptime-valid second stamp to date-time" @@
27
+
fun () ->
28
+
let min, max = exhaustive_min_max in
29
+
let rec loop t =
30
+
if t > max then () else
31
+
let stamp = Ptime.of_float_s t |> Option.get in
32
+
T.date_time_gmtime_witness ~__POS__ stamp;
33
+
loop (t +. 1.0)
34
+
in
35
+
loop min
36
+
37
+
let main () = Test.main @@ fun () -> Test.autorun ()
38
+
let () = if !Sys.interactive then () else exit (main ())
+17
vendor/opam/ptime/test/test_ptime.ml
+17
vendor/opam/ptime/test/test_ptime.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_testing
7
+
8
+
let main () =
9
+
Test.main @@ fun () ->
10
+
Test_span.tests ();
11
+
Test_base.tests ();
12
+
Test_date.tests ();
13
+
Test_date_time.tests ();
14
+
Test_rfc3339.tests ();
15
+
()
16
+
17
+
let () = if !Sys.interactive then () else exit (main ())
+278
vendor/opam/ptime/test/test_rfc3339.ml
+278
vendor/opam/ptime/test/test_rfc3339.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_std
7
+
open B0_testing
8
+
open Testing_ptime
9
+
10
+
let stamp_of_s ?__POS__ v =
11
+
Test.noraise ?__POS__ @@ fun () -> Option.get (Ptime.of_float_s v)
12
+
13
+
let test_stamp_conversions =
14
+
Test.test "stamp to RFC 3339 conversions" @@ fun () ->
15
+
let stamp_of_date_time ?__POS__ v =
16
+
Test.noraise ?__POS__ @@ fun () -> Option.get (Ptime.of_date_time v)
17
+
in
18
+
let dt ?space ?frac_s ?tz_offset_s dt =
19
+
Ptime.to_rfc3339 ?space ?frac_s ?tz_offset_s (stamp_of_date_time dt)
20
+
in
21
+
let stamp ?space ?frac_s ?tz_offset_s s =
22
+
Ptime.to_rfc3339 ?space ?frac_s ?tz_offset_s s
23
+
in
24
+
let dt0 = (1999, 01, 02), ((01, 02, 03), 0) in
25
+
Test.string ~__POS__ "1999-01-02T01:02:03Z"
26
+
(dt ~tz_offset_s:0 dt0);
27
+
Test.string ~__POS__ "1999-01-02 01:02:03Z"
28
+
(dt ~tz_offset_s:0 ~space:true dt0);
29
+
Test.string ~__POS__ "1999-01-02T01:02:03-00:00"
30
+
(dt dt0);
31
+
Test.string ~__POS__ "1999-01-02 01:02:03-00:00"
32
+
(dt ~space:true dt0);
33
+
Test.string ~__POS__ "1999-01-02T02:03:03+01:01"
34
+
(dt ~tz_offset_s:3660 dt0);
35
+
Test.string ~__POS__ "1999-01-02T00:01:03-01:01"
36
+
(dt ~tz_offset_s:(-3660) dt0);
37
+
Test.string ~__POS__ "1999-01-02T01:02:03-00:00"
38
+
(dt ~tz_offset_s:1 dt0);
39
+
Test.string ~__POS__ "1999-01-02T01:02:03-00:00"
40
+
(dt ~tz_offset_s:12960000 dt0);
41
+
Test.string ~__POS__ "1969-12-31T23:59:59.75Z"
42
+
(stamp ~frac_s:2 ~tz_offset_s:0 (stamp_of_s (-.(1. /. 4.))));
43
+
Test.string ~__POS__ "1969-12-31T23:59:59.25Z"
44
+
(stamp ~frac_s:2 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. 4.))));
45
+
Test.string ~__POS__ "1970-01-01T00:00:01.001953125Z"
46
+
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s ( 1. +. (1. /. (2. ** 9.)))));
47
+
Test.string ~__POS__ "1969-12-31T23:59:59.001953125Z"
48
+
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. (2. ** 9.)))));
49
+
Test.string ~__POS__ "1970-01-01T00:00:01.125Z"
50
+
(stamp ~frac_s:3 ~tz_offset_s:0 (stamp_of_s ( 1. +. (1. /. (2. ** 3.)))));
51
+
Test.string ~__POS__ "1969-12-31T23:59:59.125Z"
52
+
(stamp ~frac_s:3 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. (2. ** 3.)))));
53
+
Test.string ~__POS__ "1970-01-01T00:00:01.5Z"
54
+
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s ( 1. +. (1. /. (2. ** 1.)))));
55
+
Test.string ~__POS__ "1969-12-31T23:59:59.5Z"
56
+
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. (2. ** 1.)))));
57
+
Test.string ~__POS__ "1970-01-01T00:00:02.001953125Z"
58
+
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s ( 2. +. (1. /. (2. ** 9.)))));
59
+
Test.string ~__POS__ "1969-12-31T23:59:58.001953125Z"
60
+
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s (-2. +. (1. /. (2. ** 9.)))));
61
+
Test.string ~__POS__ "1970-01-01T00:00:02.000000000Z"
62
+
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s ( 2.)));
63
+
Test.string ~__POS__ "1969-12-31T23:59:58.000000000Z"
64
+
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s (-2.)));
65
+
Test.string ~__POS__ "1970-01-01T00:00:02.0Z"
66
+
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s ( 2.)));
67
+
Test.string ~__POS__ "1969-12-31T23:59:58.0Z"
68
+
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s (-2.)));
69
+
Test.string ~__POS__ "1970-01-01T00:00:02Z"
70
+
(stamp ~frac_s:0 ~tz_offset_s:0 (stamp_of_s ( 2.)));
71
+
Test.string ~__POS__ "1969-12-31T23:59:58Z"
72
+
(stamp ~frac_s:0 ~tz_offset_s:0 (stamp_of_s (-2.)));
73
+
Test.string ~__POS__ "1969-12-31T23:59:58Z"
74
+
(stamp ~frac_s:(-1) ~tz_offset_s:0 (stamp_of_s (-2.)));
75
+
Test.string ~__POS__ "9999-12-31T23:59:59.999999999999Z"
76
+
(stamp ~frac_s:12 ~tz_offset_s:0 Ptime.max);
77
+
Test.string ~__POS__ "0000-01-01T00:00:00.000000000000Z"
78
+
(stamp ~frac_s:12 ~tz_offset_s:0 Ptime.min);
79
+
Test.string ~__POS__ "0000-01-01T00:00:00.000000000000Z"
80
+
(stamp ~frac_s:13 ~tz_offset_s:0 Ptime.min);
81
+
()
82
+
83
+
let test_parse =
84
+
Test.test "RFC 3339 to stamp conversions" @@ fun () ->
85
+
let test_result =
86
+
let ok =
87
+
let equal (t, tz, c) (t', tz',c') =
88
+
Ptime.equal t t' && tz = tz' && c = c'
89
+
in
90
+
let pp ppf (t, tz, count) =
91
+
Fmt.pf ppf "(%a, %a, %d)"
92
+
Ptime.dump t (Fmt.OCaml.option Fmt.int) tz count
93
+
in
94
+
Test.T.make ~equal ~pp ()
95
+
in
96
+
let error =
97
+
let pp ppf = function `RFC3339 ((s, e), err) ->
98
+
Fmt.pf ppf "@[<1>%d-%d:@ @[%a@]@]" s e Ptime.pp_rfc3339_error err
99
+
in
100
+
Test.T.make ~pp ()
101
+
in
102
+
fun ?__POS__ -> Test.result' ?__POS__ ~ok ~error
103
+
in
104
+
let edigit = `Exp_chars ['0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'] in
105
+
let etz = `Exp_chars ['+'; '-'; 'Z'; 'z'] in
106
+
let etz_strict = `Exp_chars ['+'; '-'; 'Z'] in
107
+
let edtsep = `Exp_chars ['T';'t';' '] in
108
+
let edtsep_strict = `Exp_chars ['T'] in
109
+
let p ?strict ?sub ?start ?len s = Ptime.of_rfc3339 ?strict ?sub ?start s in
110
+
let err (s,e) err = Error (`RFC3339 ((s, e), err)) in
111
+
let err_pos pos e = err (pos, pos) e in
112
+
let ok s ~tz ~count = Ok (stamp_of_s s, tz, count) in
113
+
test_result ~__POS__
114
+
(p "1970-01-01T00:00:02.001953125Z")
115
+
(ok ( 2. +. (1. /. (2. ** 9.))) ~tz:(Some 0) ~count:30);
116
+
test_result ~__POS__
117
+
(p "1970-01-01T00:00:02.001953125-00:00")
118
+
(ok ( 2. +. (1. /. (2. ** 9.))) ~tz:None ~count:35);
119
+
test_result ~__POS__
120
+
(p "1969-12-31T23:59:58.001953125Z")
121
+
(ok (-2. +. (1. /. (2. ** 9.))) ~tz:(Some 0) ~count:30);
122
+
test_result ~__POS__
123
+
(p "1969-12-31T23:59:58.001953125-00:00")
124
+
(ok (-2. +. (1. /. (2. ** 9.))) ~tz:None ~count:35);
125
+
test_result ~__POS__
126
+
(p "1969-13-31T23:59:58.5Z")
127
+
(err (0, 21) `Invalid_stamp);
128
+
test_result ~__POS__
129
+
(p "1969-12-31T23:59:58.Z")
130
+
(err_pos 20 edigit);
131
+
test_result ~__POS__
132
+
(p "1969-12-31T23:59:58.5")
133
+
(err_pos 20 `Eoi);
134
+
test_result ~__POS__
135
+
(p "1969-12-31T23:59:58.5a")
136
+
(err_pos 21 etz);
137
+
test_result ~__POS__
138
+
(p "1969-12-31T23:59:58.5Za")
139
+
(err_pos 22 `Trailing_input);
140
+
test_result ~__POS__
141
+
(p "1969-12-31t23:59:58.5Z")
142
+
(ok (-1.5) ~tz:(Some 0) ~count:22);
143
+
test_result ~__POS__
144
+
(p "1969-12-31 23:59:58.5z")
145
+
(ok (-1.5) ~tz:(Some 0) ~count:22);
146
+
test_result ~__POS__
147
+
(p "1969-12-31T23:59:58.5Z")
148
+
(ok (-1.5) ~tz:(Some 0) ~count:22);
149
+
test_result ~__POS__
150
+
(p "1969-12-31a23:59:58.5Z")
151
+
(err_pos 10 edtsep);
152
+
test_result ~__POS__
153
+
(p ~strict:true "1969-12-31 23:59:58.5Z")
154
+
(err_pos 10 edtsep_strict);
155
+
test_result ~__POS__
156
+
(p ~strict:true "1969-12-31t23:59:58.5Z")
157
+
(err_pos 10 edtsep_strict);
158
+
test_result ~__POS__
159
+
(p ~strict:true "1969-12-31T23:59:58.5z")
160
+
(err_pos 21 etz_strict);
161
+
test_result ~__POS__
162
+
(p "1970-01-01T00:00:00.5+00:01")
163
+
(ok (-59.5) ~tz:(Some 60) ~count:27);
164
+
test_result ~__POS__
165
+
(p "1970-01-01T00:00:00.5+01:01")
166
+
(ok (-3659.5) ~tz:(Some 3660) ~count:27);
167
+
test_result ~__POS__
168
+
(p "1970-01-01T00:00:00.5-00:01")
169
+
(ok (60.5) ~tz:(Some ~-60) ~count:27);
170
+
test_result ~__POS__
171
+
(p "1970-01-01T00:00:00.00+01:01")
172
+
(ok (-3660.00) ~tz:(Some 3660) ~count:28);
173
+
test_result ~__POS__
174
+
(p "1970-01-01T00:00:00.25+01:01")
175
+
(ok (-3659.75) ~tz:(Some 3660) ~count:28);
176
+
test_result ~__POS__
177
+
(p "1970-01-01T00:00:00.25-00:01")
178
+
(ok (60.25) ~tz:(Some ~-60) ~count:28);
179
+
test_result ~__POS__
180
+
(p "1970-01-01T00:00:00-23:59")
181
+
(ok (86340.) ~tz:(Some ~-86340) ~count:25);
182
+
test_result ~__POS__
183
+
(p "1970-01-01T00:00:00-23:59")
184
+
(ok (86340.) ~tz:(Some ~-86340) ~count:25);
185
+
test_result ~__POS__
186
+
(p "1970-01-01T00:00:00+23:59")
187
+
(ok (-86340.) ~tz:(Some 86340) ~count:25);
188
+
test_result ~__POS__
189
+
(p "1970-01-01T00:00:00+23:59")
190
+
(ok (-86340.) ~tz:(Some 86340) ~count:25);
191
+
test_result ~__POS__
192
+
(p "1970-01-01T00:00:00.5-01:01")
193
+
(ok (3660.5) ~tz:(Some ~-3660) ~count:27);
194
+
test_result ~__POS__
195
+
(p "1970-01-01T00:00:00.5-24:01")
196
+
(err (22, 23) `Invalid_stamp);
197
+
test_result ~__POS__
198
+
(p "1970-01-01T00:00:00.5-01:60")
199
+
(err (25, 26) `Invalid_stamp);
200
+
test_result ~__POS__
201
+
(p ~sub:true ~start:1 "X1969-12-31T23:59:58.5ZX")
202
+
(ok (-1.5) ~tz:(Some 0) ~count:22);
203
+
test_result ~__POS__
204
+
(p ~start:1 "X1969-12-31T23:59:58.5ZX")
205
+
(err_pos 23 `Trailing_input);
206
+
test_result ~__POS__
207
+
(p "1969X12-31T23:59:58Z")
208
+
(err_pos 4 (`Exp_chars ['-']));
209
+
test_result ~__POS__
210
+
(p "1969-12X31T23:59:58Z")
211
+
(err_pos 7 (`Exp_chars ['-']));
212
+
test_result ~__POS__
213
+
(p "1969-12-31T23X59:58Z")
214
+
(err_pos 13 (`Exp_chars [':']));
215
+
test_result ~__POS__
216
+
(p "1969-12-31T23:59X58Z")
217
+
(err_pos 16 (`Exp_chars [':']));
218
+
test_result ~__POS__
219
+
(p ~strict:true "1969-12-31T23:59:58+00X00")
220
+
(err_pos 22 (`Exp_chars [':']));
221
+
test_result ~__POS__
222
+
(p "1969-12-31T23:59:58+00X00")
223
+
(err_pos 22 `Trailing_input);
224
+
test_result ~__POS__
225
+
(p ~start:(-1) "1970-01-01")
226
+
(err_pos (-1) `Eoi);
227
+
test_result ~__POS__
228
+
(p ~start:11 "1970-01-01")
229
+
(err_pos 11 `Eoi);
230
+
test_result ~__POS__
231
+
(p "")
232
+
(err_pos 0 `Eoi);
233
+
test_result ~__POS__
234
+
(p "0000-01-01T00:00:00+00:01")
235
+
(err (0, 24) `Invalid_stamp);
236
+
test_result ~__POS__
237
+
(p "9999-12-31T23:59:59-00:01")
238
+
(err (0, 24) `Invalid_stamp);
239
+
test_result ~__POS__
240
+
(p "1900-02-29T01:02:03Z")
241
+
(err (0, 19) `Invalid_stamp);
242
+
test_result ~__POS__
243
+
(p "01-02-29T01:02:03Z")
244
+
(err_pos 2 edigit);
245
+
test_result ~__POS__
246
+
(p "1970-01-01T00:00:00.00+0101")
247
+
(ok (-3660.00) ~tz:(Some 3660) ~count:27);
248
+
test_result ~__POS__
249
+
(p "1970-01-01T00:00:00.00+01")
250
+
(ok (-3600.00) ~tz:(Some 3600) ~count:25);
251
+
()
252
+
253
+
let test_stamp_trips =
254
+
Test.test "random stamps to RFC 3339 round trips" @@ fun () ->
255
+
let stamp_of_rfc3339 ?__POS__ s =
256
+
Test.noraise ?__POS__ @@ fun () ->
257
+
Result.get_ok' (Ptime.of_rfc3339 s |> Ptime.rfc3339_string_error)
258
+
in
259
+
let trip ?__POS__:pos ?tz_offset_s t =
260
+
let back = stamp_of_s ?__POS__:pos (floor (Ptime.to_float_s t)) in
261
+
let trip, tz, _ =
262
+
stamp_of_rfc3339 ?__POS__:pos (Ptime.to_rfc3339 ?tz_offset_s t)
263
+
in
264
+
T.stamp ~__POS__ back trip;
265
+
in
266
+
for i = 1 to Rand.loop_len () do
267
+
trip ~__POS__ ?tz_offset_s:(Some 0)(* UTC *) (Rand.float_stamp ());
268
+
trip ~__POS__ ?tz_offset_s:None (* Unknown *) (Rand.float_stamp ());
269
+
trip ~__POS__ ?tz_offset_s:(Some (Rand.tz_offset_s ()))
270
+
(Rand.float_stamp ())
271
+
done;
272
+
()
273
+
274
+
let tests () =
275
+
test_stamp_conversions ();
276
+
test_parse ();
277
+
test_stamp_trips ();
278
+
()
+339
vendor/opam/ptime/test/test_span.ml
+339
vendor/opam/ptime/test/test_span.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
open B0_testing
7
+
open Testing_ptime
8
+
9
+
let p s = Option.get (Ptime.Span.of_d_ps s)
10
+
let n s = Ptime.Span.(neg (p s))
11
+
let pps ps = p (0, ps)
12
+
let nps ps = n (0, ps)
13
+
14
+
let test_conversions =
15
+
Test.test "span constants and conversions" @@ fun () ->
16
+
(* Ints *)
17
+
let trip_int ?__POS__ secs =
18
+
Test.option ?__POS__ Test.T.int
19
+
Ptime.Span.(to_int_s (of_int_s secs)) (Some secs)
20
+
in
21
+
T.span ~__POS__ (Ptime.Span.of_int_s 0) Ptime.Span.zero;
22
+
T.span ~__POS__ (Ptime.Span.of_int_s 1) (pps 1_000_000_000_000L);
23
+
T.span ~__POS__ (Ptime.Span.of_int_s (-1)) (nps 1_000_000_000_000L);
24
+
T.span ~__POS__ (Ptime.Span.of_int_s 86_400) (p (1, 0L));
25
+
T.span ~__POS__ (Ptime.Span.of_int_s (-86_400)) (n (1, 0L));
26
+
trip_int ~__POS__ (86_400);
27
+
trip_int ~__POS__ (-86_400);
28
+
trip_int ~__POS__ (234_322_342);
29
+
trip_int ~__POS__ (-234_322_352);
30
+
trip_int ~__POS__ (1);
31
+
trip_int ~__POS__ (-1);
32
+
trip_int ~__POS__ (0);
33
+
(* Floats *)
34
+
let trip_float ?__POS__ secs =
35
+
let of_float secs =
36
+
Test.noraise ?__POS__ @@ fun () -> Option.get (Ptime.Span.of_float_s secs)
37
+
in
38
+
Test.float ?__POS__ (Ptime.Span.to_float_s (of_float secs)) secs
39
+
in
40
+
T.span_option ~__POS__
41
+
(Ptime.Span.of_float_s 1.0000000000005) (Some (pps 1_000_000_000_000L));
42
+
T.span_option ~__POS__
43
+
(Ptime.Span.of_float_s (-1.0000000000005)) (Some (nps 1_000_000_000_000L));
44
+
T.span_option ~__POS__
45
+
(Ptime.Span.of_float_s 0.) (Some Ptime.Span.zero);
46
+
T.span_option ~__POS__
47
+
(Ptime.Span.of_float_s (min_float)) (Some Ptime.Span.zero);
48
+
T.span_option ~__POS__
49
+
(Ptime.Span.of_float_s (-.min_float))(Some Ptime.Span.zero);
50
+
T.span_option ~__POS__
51
+
(Ptime.Span.of_float_s max_float) None;
52
+
T.span_option ~__POS__
53
+
(Ptime.Span.of_float_s (-.max_float)) None;
54
+
T.span_option ~__POS__
55
+
(Ptime.Span.of_float_s nan) None;
56
+
T.span_option ~__POS__
57
+
(Ptime.Span.of_float_s infinity) None;
58
+
T.span_option ~__POS__
59
+
(Ptime.Span.of_float_s (-.infinity)) None;
60
+
trip_float ~__POS__ 0.;
61
+
trip_float ~__POS__ (-0.);
62
+
trip_float ~__POS__ 1.;
63
+
trip_float ~__POS__ (-1.);
64
+
trip_float ~__POS__ (float (1 lsl 30 - 1));
65
+
trip_float ~__POS__ (float (- (1 lsl 30)));
66
+
T.span_option ~__POS__
67
+
(Ptime.Span.of_d_ps (23, -1L)) None;
68
+
T.span_option ~__POS__
69
+
(Ptime.Span.of_d_ps (23, 86_400_000_000_000_000L)) None;
70
+
()
71
+
72
+
let test_predicates =
73
+
Test.test "span predicates" @@ fun () ->
74
+
Test.bool ~__POS__ (Ptime.Span.equal Ptime.Span.zero Ptime.Span.zero) true;
75
+
Test.bool ~__POS__ (Ptime.Span.equal Ptime.Span.zero (pps 1L)) false;
76
+
Test.bool ~__POS__ (Ptime.Span.equal Ptime.Span.zero (nps 1L)) false;
77
+
Test.bool ~__POS__ (Ptime.Span.equal (p (30, 3434L)) (p (30, 3434L))) true;
78
+
Test.bool ~__POS__ (Ptime.Span.equal (p (30, 3434L)) (p (30, 3435L))) false;
79
+
Test.bool ~__POS__ (Ptime.Span.equal (n (30, 3434L)) (n (30, 3434L))) true;
80
+
Test.bool ~__POS__ (Ptime.Span.equal (n (30, 3434L)) (n (30, 3435L))) false;
81
+
Test.bool ~__POS__ (Ptime.Span.equal (n (30, 3434L)) (p (30, 3434L))) false;
82
+
Test.int ~__POS__ (Ptime.Span.compare Ptime.Span.zero Ptime.Span.zero) 0;
83
+
Test.int ~__POS__ (Ptime.Span.compare Ptime.Span.zero (pps 1L)) (-1);
84
+
Test.int ~__POS__ (Ptime.Span.compare Ptime.Span.zero (nps 1L)) 1;
85
+
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (n (30, 3434L))) 0;
86
+
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (n (30, 3435L))) 1;
87
+
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (p (30, 3435L))) (-1);
88
+
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (n (30, 3433L))) (-1);
89
+
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (p (30, 3433L))) (-1);
90
+
()
91
+
92
+
let test_arithmetic =
93
+
Test.test "span arithmetic" @@ fun () ->
94
+
T.span ~__POS__
95
+
(Ptime.Span.add (pps 86_399_999_999_999_999L) (pps 1L)) (p (1, 0L));
96
+
T.span ~__POS__
97
+
(Ptime.Span.add (nps 86_399_999_999_999_999L) (nps 1L)) (n (1, 0L));
98
+
T.span ~__POS__
99
+
(Ptime.Span.sub Ptime.Span.zero (pps 1L)) (nps 1L);
100
+
T.span ~__POS__
101
+
(Ptime.Span.sub Ptime.Span.zero (nps 1L)) (pps 1L);
102
+
T.span ~__POS__
103
+
(Ptime.Span.add (nps 1L) (pps 1L)) Ptime.Span.zero;
104
+
T.span ~__POS__
105
+
(Ptime.Span.abs (n (3, 342L))) (p (3, 342L));
106
+
T.span ~__POS__
107
+
(Ptime.Span.abs (p (3, 342L))) (p (3, 342L));
108
+
()
109
+
110
+
let test_rounding =
111
+
Test.test "span rounding" @@ fun () ->
112
+
let r ~frac a b =
113
+
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (3, b));
114
+
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (3, b))
115
+
in
116
+
let r_carry ~frac a =
117
+
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (4, 0L));
118
+
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (4, 0L))
119
+
in
120
+
let t ~frac a b =
121
+
T.span ~__POS__ (Ptime.Span.truncate ~frac_s:frac (p (3, a))) (p (3, b));
122
+
T.span ~__POS__ (Ptime.Span.truncate ~frac_s:frac (n (3, a))) (n (3, b))
123
+
in
124
+
for i = 0 to 12 do r ~frac:i 0L 0L done;
125
+
r_carry ~frac:(-1) 86_399_500_000_000_000L;
126
+
r_carry ~frac:0 86_399_500_000_000_000L;
127
+
r ~frac:0 86_399_499_999_999_999L 86_399_000_000_000_000L;
128
+
r ~frac:0 10_001_500_000_000_000L 10_002_000_000_000_000L;
129
+
r ~frac:0 10_001_499_999_999_999L 10_001_000_000_000_000L;
130
+
r_carry ~frac:1 86_399_950_000_000_000L;
131
+
r ~frac:1 86_399_949_999_999_999L 86_399_900_000_000_000L;
132
+
r ~frac:1 10_001_150_000_000_000L 10_001_200_000_000_000L;
133
+
r ~frac:1 10_001_149_999_999_999L 10_001_100_000_000_000L;
134
+
r_carry ~frac:2 86_399_995_000_000_000L;
135
+
r ~frac:2 86_399_994_999_999_999L 86_399_990_000_000_000L;
136
+
r ~frac:2 10_001_115_000_000_000L 10_001_120_000_000_000L;
137
+
r ~frac:2 10_001_114_999_999_999L 10_001_110_000_000_000L;
138
+
r_carry ~frac:3 86_399_999_500_000_000L;
139
+
r ~frac:3 86_399_999_499_999_999L 86_399_999_000_000_000L;
140
+
r ~frac:3 10_001_111_500_000_000L 10_001_112_000_000_000L;
141
+
r ~frac:3 10_001_111_499_999_999L 10_001_111_000_000_000L;
142
+
r_carry ~frac:4 86_399_999_950_000_000L;
143
+
r ~frac:4 86_399_999_949_999_999L 86_399_999_900_000_000L;
144
+
r ~frac:4 10_001_111_150_000_000L 10_001_111_200_000_000L;
145
+
r ~frac:4 10_001_111_149_999_999L 10_001_111_100_000_000L;
146
+
r_carry ~frac:5 86_399_999_995_000_000L;
147
+
r ~frac:5 86_399_999_994_999_999L 86_399_999_990_000_000L;
148
+
r ~frac:5 10_001_111_115_000_000L 10_001_111_120_000_000L;
149
+
r ~frac:5 10_001_111_114_999_999L 10_001_111_110_000_000L;
150
+
r_carry ~frac:6 86_399_999_999_500_000L;
151
+
r ~frac:6 86_399_999_999_499_999L 86_399_999_999_000_000L;
152
+
r ~frac:6 10_001_111_111_500_000L 10_001_111_112_000_000L;
153
+
r ~frac:6 10_001_111_111_499_999L 10_001_111_111_000_000L;
154
+
r_carry ~frac:7 86_399_999_999_950_000L;
155
+
r ~frac:7 86_399_999_999_949_999L 86_399_999_999_900_000L;
156
+
r ~frac:7 10_001_111_111_150_000L 10_001_111_111_200_000L;
157
+
r ~frac:7 10_001_111_111_149_999L 10_001_111_111_100_000L;
158
+
r_carry ~frac:8 86_399_999_999_995_000L;
159
+
r ~frac:8 86_399_999_999_994_999L 86_399_999_999_990_000L;
160
+
r ~frac:8 10_001_111_111_115_000L 10_001_111_111_120_000L;
161
+
r ~frac:8 10_001_111_111_114_999L 10_001_111_111_110_000L;
162
+
r_carry ~frac:9 86_399_999_999_999_500L;
163
+
r ~frac:9 86_399_999_999_999_499L 86_399_999_999_999_000L;
164
+
r ~frac:9 10_001_111_111_111_500L 10_001_111_111_112_000L;
165
+
r ~frac:9 10_001_111_111_111_499L 10_001_111_111_111_000L;
166
+
r_carry ~frac:10 86_399_999_999_999_950L;
167
+
r ~frac:10 86_399_999_999_999_949L 86_399_999_999_999_900L;
168
+
r ~frac:10 10_001_111_111_111_150L 10_001_111_111_111_200L;
169
+
r ~frac:10 10_001_111_111_111_149L 10_001_111_111_111_100L;
170
+
r_carry ~frac:11 86_399_999_999_999_995L;
171
+
r ~frac:11 86_399_999_999_999_994L 86_399_999_999_999_990L;
172
+
r ~frac:11 10_001_111_111_111_115L 10_001_111_111_111_120L;
173
+
r ~frac:11 10_001_111_111_111_114L 10_001_111_111_111_110L;
174
+
r ~frac:12 86_399_999_999_999_999L 86_399_999_999_999_999L;
175
+
r ~frac:12 10_001_111_111_111_115L 10_001_111_111_111_115L;
176
+
r ~frac:12 10_001_111_111_111_114L 10_001_111_111_111_114L;
177
+
r ~frac:13 10_001_111_111_111_114L 10_001_111_111_111_114L;
178
+
for i = 0 to 12 do t ~frac:i 0L 0L done;
179
+
t ~frac:(-1) 86_399_999_999_999_999L 86_399_000_000_000_000L;
180
+
t ~frac:0 86_399_999_999_999_999L 86_399_000_000_000_000L;
181
+
t ~frac:1 86_399_999_999_999_999L 86_399_900_000_000_000L;
182
+
t ~frac:2 86_399_999_999_999_999L 86_399_990_000_000_000L;
183
+
t ~frac:3 86_399_999_999_999_999L 86_399_999_000_000_000L;
184
+
t ~frac:4 86_399_999_999_999_999L 86_399_999_900_000_000L;
185
+
t ~frac:5 86_399_999_999_999_999L 86_399_999_990_000_000L;
186
+
t ~frac:6 86_399_999_999_999_999L 86_399_999_999_000_000L;
187
+
t ~frac:7 86_399_999_999_999_999L 86_399_999_999_900_000L;
188
+
t ~frac:8 86_399_999_999_999_999L 86_399_999_999_990_000L;
189
+
t ~frac:9 86_399_999_999_999_999L 86_399_999_999_999_000L;
190
+
t ~frac:10 86_399_999_999_999_999L 86_399_999_999_999_900L;
191
+
t ~frac:11 86_399_999_999_999_999L 86_399_999_999_999_990L;
192
+
t ~frac:12 86_399_999_999_999_999L 86_399_999_999_999_999L;
193
+
t ~frac:13 86_399_999_999_999_999L 86_399_999_999_999_999L;
194
+
()
195
+
196
+
let test_pretty_printing =
197
+
Test.test "span retty printing" @@ fun () ->
198
+
let fmt s = Format.asprintf "%a" Ptime.Span.pp s in
199
+
let n s = fmt @@ Ptime.Span.(neg (p s)) in
200
+
let p s = fmt @@ p s in
201
+
let pps ps = p (0, ps) in
202
+
let nps ps = n (0, ps) in
203
+
(* y d *)
204
+
Test.string ~__POS__ (p (366, 0L)) "1y1d";
205
+
Test.string ~__POS__ (n (366, 0L)) "-1y1d";
206
+
Test.string ~__POS__ (p (1461, 0L)) "4y";
207
+
Test.string ~__POS__ (n (1461, 0L)) "-4y";
208
+
Test.string ~__POS__ (p (1461, 43_200_000_000_000_000L)) "4y1d";
209
+
Test.string ~__POS__ (n (1461, 43_200_000_000_000_000L)) "-4y1d";
210
+
Test.string ~__POS__ (p (1461, 43_199_199_199_199_199L)) "4y";
211
+
Test.string ~__POS__ (n (1461, 43_199_199_199_199_199L)) "-4y";
212
+
Test.string ~__POS__ (p (1462, 43_200_000_000_000_000L)) "4y2d";
213
+
Test.string ~__POS__ (n (1462, 43_200_000_000_000_000L)) "-4y2d";
214
+
Test.string ~__POS__ (p (1462, 43_199_199_199_199_199L)) "4y1d";
215
+
Test.string ~__POS__ (n (1462, 43_199_199_199_199_199L)) "-4y1d";
216
+
(* d h *)
217
+
Test.string ~__POS__ (p (365, 84_600_000_000_000_000L)) "1y1d";
218
+
Test.string ~__POS__ (n (365, 84_600_000_000_000_000L)) "-1y1d";
219
+
Test.string ~__POS__ (p (365, 84_599_999_999_999_999L)) "1y";
220
+
Test.string ~__POS__ (n (365, 84_599_999_999_999_999L)) "-1y";
221
+
Test.string ~__POS__ (p (365, 19_800_000_000_000_000L)) "1y";
222
+
Test.string ~__POS__ (n (365, 19_800_000_000_000_000L)) "-1y";
223
+
Test.string ~__POS__ (p (365, 19_799_999_999_999_999L)) "365d5h";
224
+
Test.string ~__POS__ (n (365, 19_799_999_999_999_999L)) "-365d5h";
225
+
Test.string ~__POS__ (p (1, 84_600_000_000_000_000L)) "2d";
226
+
Test.string ~__POS__ (n (1, 84_600_000_000_000_000L)) "-2d";
227
+
Test.string ~__POS__ (p (1, 84_599_999_999_999_999L)) "1d23h";
228
+
Test.string ~__POS__ (n (1, 84_599_999_999_999_999L)) "-1d23h";
229
+
Test.string ~__POS__ (p (2, 0L)) "2d";
230
+
Test.string ~__POS__ (n (2, 0L)) "-2d";
231
+
(* h m *)
232
+
Test.string ~__POS__ (pps 86_370_000_000_000_000L) "1d";
233
+
Test.string ~__POS__ (nps 86_370_000_000_000_000L) "-1d";
234
+
Test.string ~__POS__ (pps 86_369_999_999_999_999L) "23h59min";
235
+
Test.string ~__POS__ (nps 86_369_999_999_999_999L) "-23h59min";
236
+
Test.string ~__POS__ (pps 3660_000_000_000_000L) "1h1min";
237
+
Test.string ~__POS__ (nps 3660_000_000_000_000L) "-1h1min";
238
+
Test.string ~__POS__ (pps 3630_000_000_000_000L) "1h1min";
239
+
Test.string ~__POS__ (pps 3629_999_999_999_999L) "1h";
240
+
Test.string ~__POS__ (nps 3629_999_999_999_999L) "-1h";
241
+
Test.string ~__POS__ (pps 3600_000_000_000_000L) "1h";
242
+
Test.string ~__POS__ (nps 3600_000_000_000_000L) "-1h";
243
+
(* m s *)
244
+
Test.string ~__POS__ (pps 3599_500_000_000_000L) "1h";
245
+
Test.string ~__POS__ (nps 3599_500_000_000_000L) "-1h";
246
+
Test.string ~__POS__ (pps 3599_499_999_999_999L) "59min59s";
247
+
Test.string ~__POS__ (nps 3599_499_999_999_999L) "-59min59s";
248
+
Test.string ~__POS__ (pps 60_500_000_000_000L) "1min1s";
249
+
Test.string ~__POS__ (nps 60_500_000_000_000L) "-1min1s";
250
+
Test.string ~__POS__ (pps 60_499_000_000_000L) "1min";
251
+
Test.string ~__POS__ (nps 60_499_000_000_000L) "-1min";
252
+
Test.string ~__POS__ (pps 60_000_000_000_000L) "1min";
253
+
Test.string ~__POS__ (nps 60_000_000_000_000L) "-1min";
254
+
(* s *)
255
+
Test.string ~__POS__ (pps 59_999_500_000_000L) "1min";
256
+
Test.string ~__POS__ (nps 59_999_500_000_000L) "-1min";
257
+
Test.string ~__POS__ (pps 59_999_499_999_999L) "59.999s";
258
+
Test.string ~__POS__ (nps 59_999_499_999_999L) "-59.999s";
259
+
Test.string ~__POS__ (pps 1_999_500_000_000L) "2s";
260
+
Test.string ~__POS__ (nps 1_999_500_000_000L) "-2s";
261
+
Test.string ~__POS__ (pps 1_999_499_999_999L) "1.999s";
262
+
Test.string ~__POS__ (nps 1_999_499_999_999L) "-1.999s";
263
+
Test.string ~__POS__ (pps 1_534_500_000_000L) "1.535s";
264
+
Test.string ~__POS__ (nps 1_534_500_000_000L) "-1.535s";
265
+
Test.string ~__POS__ (pps 1_534_499_999_999L) "1.534s";
266
+
Test.string ~__POS__ (nps 1_534_499_999_999L) "-1.534s";
267
+
Test.string ~__POS__ (pps 1_000_000_000_000L) "1s";
268
+
Test.string ~__POS__ (nps 1_000_000_000_000L) "-1s";
269
+
Test.string ~__POS__ (pps 1_136_000_000_000L) "1.136s";
270
+
Test.string ~__POS__ (nps 1_136_000_000_000L) "-1.136s";
271
+
Test.string ~__POS__ (pps 1_036_000_000_000L) "1.036s";
272
+
Test.string ~__POS__ (nps 1_036_000_000_000L) "-1.036s";
273
+
(* ms *)
274
+
Test.string ~__POS__ (pps 999_500_000_000L) "1s";
275
+
Test.string ~__POS__ (nps 999_500_000_000L) "-1s";
276
+
Test.string ~__POS__ (pps 999_499_999_999L) "999ms";
277
+
Test.string ~__POS__ (nps 999_499_999_999L) "-999ms";
278
+
Test.string ~__POS__ (pps 1_999_500_000L) "2ms";
279
+
Test.string ~__POS__ (nps 1_999_500_000L) "-2ms";
280
+
Test.string ~__POS__ (pps 1_999_499_999L) "1.999ms";
281
+
Test.string ~__POS__ (nps 1_999_499_999L) "-1.999ms";
282
+
Test.string ~__POS__ (pps 1_332_500_000L) "1.333ms";
283
+
Test.string ~__POS__ (nps 1_332_500_000L) "-1.333ms";
284
+
Test.string ~__POS__ (pps 1_332_499_999L) "1.332ms";
285
+
Test.string ~__POS__ (nps 1_332_499_999L) "-1.332ms";
286
+
Test.string ~__POS__ (pps 1_036_000_000L) "1.036ms";
287
+
Test.string ~__POS__ (nps 1_036_000_000L) "-1.036ms";
288
+
Test.string ~__POS__ (pps 1_000_000_000L) "1ms";
289
+
Test.string ~__POS__ (nps 1_000_000_000L) "-1ms";
290
+
(* us *)
291
+
Test.string ~__POS__ (pps 999_500_000L) "1ms";
292
+
Test.string ~__POS__ (nps 999_500_000L) "-1ms";
293
+
Test.string ~__POS__ (pps 999_499_999L) "999us";
294
+
Test.string ~__POS__ (nps 999_499_999L) "-999us";
295
+
Test.string ~__POS__ (pps 1_999_500L) "2us";
296
+
Test.string ~__POS__ (nps 1_999_500L) "-2us";
297
+
Test.string ~__POS__ (pps 1_999_499L) "1.999us";
298
+
Test.string ~__POS__ (nps 1_999_499L) "-1.999us";
299
+
Test.string ~__POS__ (pps 1_332_500L) "1.333us";
300
+
Test.string ~__POS__ (nps 1_332_500L) "-1.333us";
301
+
Test.string ~__POS__ (pps 1_332_499L) "1.332us";
302
+
Test.string ~__POS__ (nps 1_332_499L) "-1.332us";
303
+
Test.string ~__POS__ (pps 1_036_000L) "1.036us";
304
+
Test.string ~__POS__ (nps 1_036_000L) "-1.036us";
305
+
Test.string ~__POS__ (pps 1_000_000L) "1us";
306
+
Test.string ~__POS__ (nps 1_000_000L) "-1us";
307
+
(* ns *)
308
+
Test.string ~__POS__ (pps 999_500L) "1us";
309
+
Test.string ~__POS__ (nps 999_500L) "-1us";
310
+
Test.string ~__POS__ (pps 999_499L) "999ns";
311
+
Test.string ~__POS__ (nps 999_499L) "-999ns";
312
+
Test.string ~__POS__ (pps 1_995L) "1.995ns";
313
+
Test.string ~__POS__ (nps 1_995L) "-1.995ns";
314
+
Test.string ~__POS__ (pps 1_994L) "1.994ns";
315
+
Test.string ~__POS__ (nps 1_994L) "-1.994ns";
316
+
Test.string ~__POS__ (pps 1_332L) "1.332ns";
317
+
Test.string ~__POS__ (nps 1_332L) "-1.332ns";
318
+
Test.string ~__POS__ (pps 1_036L) "1.036ns";
319
+
Test.string ~__POS__ (nps 1_036L) "-1.036ns";
320
+
Test.string ~__POS__ (pps 1_000L) "1ns";
321
+
Test.string ~__POS__ (nps 1_000L) "-1ns";
322
+
(* ps *)
323
+
Test.string ~__POS__ (pps 999L) "999ps";
324
+
Test.string ~__POS__ (nps 999L) "-999ps";
325
+
Test.string ~__POS__ (pps 50L) "50ps";
326
+
Test.string ~__POS__ (nps 50L) "-50ps";
327
+
Test.string ~__POS__ (pps 1L) "1ps";
328
+
Test.string ~__POS__ (nps 1L) "-1ps";
329
+
Test.string ~__POS__ (pps 0L) "0ps";
330
+
Test.string ~__POS__ (nps 0L) "0ps";
331
+
()
332
+
333
+
let tests () =
334
+
test_conversions ();
335
+
test_predicates ();
336
+
test_arithmetic ();
337
+
test_rounding ();
338
+
test_pretty_printing ();
339
+
()
+139
vendor/opam/ptime/test/testing_ptime.ml
+139
vendor/opam/ptime/test/testing_ptime.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2015 The ptime programmers. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Ptime test unit comonalities *)
7
+
8
+
open B0_std
9
+
open B0_testing
10
+
11
+
module T = struct
12
+
13
+
(* Time spans *)
14
+
15
+
let eq_raw_span =
16
+
let raw_span ppf (d, ps) = Fmt.pf ppf "@[<1>(%d,@ %Ld)@]" d ps in
17
+
Test.T.make ~pp:raw_span ()
18
+
19
+
let raw_span ?__POS__ = Test.eq ?__POS__ eq_raw_span
20
+
21
+
let eq_span = Test.T.make ~equal:Ptime.Span.equal ~pp:Ptime.Span.dump ()
22
+
let span ?__POS__ = Test.eq ?__POS__ eq_span
23
+
let span_option ?__POS__ = Test.option ?__POS__ eq_span
24
+
25
+
(* Timestamps *)
26
+
27
+
let eq_stamp = Test.T.make ~equal:Ptime.equal ~pp:Ptime.dump ()
28
+
let stamp ?__POS__ = Test.eq ?__POS__ eq_stamp
29
+
let stamp_option ?__POS__ = Test.option ?__POS__ eq_stamp
30
+
31
+
(* Dates *)
32
+
33
+
module Date = struct
34
+
type t = Ptime.date
35
+
let equal = ( = )
36
+
let pp ppf (y,m,d) = Fmt.pf ppf "(%d, %d, %d)" y m d
37
+
end
38
+
39
+
let date ?__POS__ = Test.eq ?__POS__ (module Date)
40
+
41
+
(* Date time *)
42
+
43
+
module Date_time = struct
44
+
type t = Ptime.date * Ptime.time
45
+
let equal = ( = )
46
+
let pp ppf ((y, m, d), ((hh, mm, ss), tz)) =
47
+
Fmt.pf ppf "(%d, %d, %d), ((%d, %d, %d), %d)" y m d hh mm ss tz
48
+
end
49
+
50
+
let date_time ?__POS__ = Test.eq ?__POS__ (module Date_time)
51
+
52
+
let gmtime_to_date_time t =
53
+
let t = Ptime.to_float_s t in
54
+
let t = floor t (* see https://github.com/ocaml/ocaml/issues/6921 *) in
55
+
let tm = Unix.gmtime t in
56
+
let d = (tm.Unix.tm_year + 1900), (tm.Unix.tm_mon + 1), (tm.Unix.tm_mday) in
57
+
let t = tm.Unix.tm_hour, tm.Unix.tm_min, tm.Unix.tm_sec in
58
+
(d, (t, 0)), tm.Unix.tm_wday
59
+
60
+
let date_time_gmtime_witness ?__POS__:pos t =
61
+
let fail ?__POS__ n ~assertions:_ =
62
+
Test.log_fail ?__POS__ "On stamp %g" (Ptime.to_float_s t)
63
+
in
64
+
Test.block ?__POS__:pos ~fail @@ fun () ->
65
+
let dt, wday = gmtime_to_date_time t in
66
+
let ut = Ptime.to_date_time t in
67
+
Test.eq ~__POS__ (module Date_time) dt ut;
68
+
Test.int ~__POS__ (Ptime.weekday_num t) wday
69
+
end
70
+
71
+
module Rand = struct
72
+
73
+
(* Random loop length *)
74
+
75
+
let loop_len = ref 100_000
76
+
let loop_len () = !loop_len
77
+
78
+
(* Random Ptime-valid stamps from floats *)
79
+
80
+
let float_stamp_range min max =
81
+
let bound = max -. min in
82
+
fun () ->
83
+
let r = Random.State.float (Test.Rand.state ()) bound (* inclusive *) in
84
+
let stamp = min +. r in
85
+
match Ptime.(of_float_s stamp) with
86
+
| None -> Fmt.failwith "cannot convert valid random stamp %f" stamp
87
+
| Some t -> t
88
+
89
+
let float_stamp_32bits =
90
+
let min_stamp = Int32.(to_float min_int) in
91
+
let max_stamp = Int32.(to_float max_int) in
92
+
float_stamp_range min_stamp max_stamp
93
+
94
+
let float_stamp : unit -> Ptime.t =
95
+
let min_stamp = Ptime.(to_float_s min) in
96
+
let max_stamp = Ptime.(to_float_s max) in
97
+
float_stamp_range min_stamp max_stamp
98
+
99
+
let stamp =
100
+
if Sys.word_size = 32 then float_stamp_32bits else float_stamp
101
+
102
+
(* Random Ptime-valid dates *)
103
+
104
+
let date : unit -> (int * int * int) =
105
+
let month_len = [|31; 28; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31 |] in
106
+
let is_leap y = (y mod 4 = 0) && (y mod 100 <> 0 || y mod 400 = 0) in
107
+
fun () ->
108
+
let rstate = Test.Rand.state () in
109
+
let rint bound = Random.State.int rstate bound in
110
+
let y = rint 10_000 in
111
+
let m = 1 + rint 11 in
112
+
let m_len = if (m = 2 && is_leap y) then 29 else month_len.(m - 1) in
113
+
let d = 1 + rint m_len in
114
+
(y, m, d)
115
+
116
+
(* Random times *)
117
+
118
+
let tz_interval_s = (1 lsl 30 - 1) (* max of Random.int *)
119
+
let tz_offset_s : unit -> int =
120
+
fun () ->
121
+
let rstate = Test.Rand.state () in
122
+
(* N.B. We don't cover the whole spectrum *)
123
+
(Random.State.int rstate tz_interval_s) - (tz_interval_s / 2)
124
+
125
+
let min_tz_interval_s = 2000
126
+
let min_tz_offset_s : unit -> int =
127
+
fun () ->
128
+
let rstate = Test.Rand.state () in
129
+
((Random.State.int rstate min_tz_interval_s) - (min_tz_interval_s / 2)) * 60
130
+
131
+
let time : unit -> (int * int * int) =
132
+
fun () ->
133
+
let rstate = Test.Rand.state () in
134
+
let rint bound = Random.State.int rstate bound in
135
+
let hh = rint 24 in
136
+
let mm = rint 60 in
137
+
let ss = rint 61 in
138
+
(hh, mm, ss)
139
+
end