This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
4
unikernel/duniverse/ptime/.gitignore
vendored
Normal file
4
unikernel/duniverse/ptime/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
_b0
|
||||
_build
|
||||
tmp
|
||||
*.install
|
||||
5
unikernel/duniverse/ptime/.merlin
Normal file
5
unikernel/duniverse/ptime/.merlin
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
PKG b0.kit
|
||||
S src
|
||||
S src-clock
|
||||
S test
|
||||
B _b0/**
|
||||
1
unikernel/duniverse/ptime/.ocp-indent
Normal file
1
unikernel/duniverse/ptime/.ocp-indent
Normal file
|
|
@ -0,0 +1 @@
|
|||
strict_with=always,match_clause=4,strict_else=never
|
||||
98
unikernel/duniverse/ptime/B0.ml
Normal file
98
unikernel/duniverse/ptime/B0.ml
Normal file
|
|
@ -0,0 +1,98 @@
|
|||
open B0_kit.V000
|
||||
open Result.Syntax
|
||||
|
||||
(* OCaml library names *)
|
||||
|
||||
let b0_std = B0_ocaml.libname "b0.std"
|
||||
let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel"
|
||||
let unix = B0_ocaml.libname "unix"
|
||||
|
||||
let ptime = B0_ocaml.libname "ptime"
|
||||
let ptime_clock = B0_ocaml.libname "ptime.clock"
|
||||
let ptime_clock_os = B0_ocaml.libname "ptime.clock.os"
|
||||
let ptime_top = B0_ocaml.libname "ptime.top"
|
||||
|
||||
(* Libraries *)
|
||||
|
||||
let ptime_lib =
|
||||
let srcs = [`Dir ~/"src"; `X ~/"src/ptime_top_init.ml" ] in
|
||||
B0_ocaml.lib ptime ~srcs
|
||||
|
||||
let ptime_clock_lib =
|
||||
let srcs = [`Dir ~/"src/clock"] in
|
||||
B0_ocaml.lib ptime_clock ~srcs ~requires:[ptime] ~exports:[ptime]
|
||||
|
||||
let ptime_clock_os_lib =
|
||||
B0_ocaml.deprecated_lib ~exports:[ptime_clock] ptime_clock_os
|
||||
|
||||
let ptime_top_lib =
|
||||
let srcs = [`Dir ~/"src/top"] in
|
||||
B0_ocaml.lib ptime_top ~srcs ~requires:[ptime; compiler_libs_toplevel]
|
||||
|
||||
(* Tests *)
|
||||
|
||||
let test ?(requires = []) =
|
||||
B0_ocaml.test ~requires:(ptime :: b0_std :: requires)
|
||||
|
||||
let testing_ptime = `File ~/"test/testing_ptime.ml"
|
||||
|
||||
let test_ptime =
|
||||
let srcs =
|
||||
[ testing_ptime;
|
||||
`File ~/"test/test_span.ml"; `File ~/"test/test_base.ml";
|
||||
`File ~/"test/test_date.ml"; `File ~/"test/test_date_time.ml";
|
||||
`File ~/"test/test_rfc3339.ml"; `File ~/"test/test_ptime.ml" ]
|
||||
in
|
||||
test ~/"test/test_ptime.ml" ~srcs ~requires:[unix]
|
||||
|
||||
let test_gmtime =
|
||||
let doc = "Test random stamps against Unix.gmtime" in
|
||||
let srcs = [testing_ptime] in
|
||||
test ~/"test/test_gmtime.ml" ~srcs ~requires:[unix] ~doc
|
||||
|
||||
let test_gmtime_all =
|
||||
let doc = "Test all second stamps against Unix.gmtime (very long)" in
|
||||
let srcs = [testing_ptime;] in
|
||||
test ~/"test/test_gmtime_all.ml" ~run:false ~srcs ~requires:[unix] ~doc
|
||||
|
||||
let min_clock =
|
||||
let doc = "Minimal clock example" in
|
||||
test ~/"test/min_clock.ml" ~run:false ~doc ~requires:[ptime_clock]
|
||||
|
||||
(* FIXME b0 this makes the whole build bytecode. *)
|
||||
(* let min_clock_jsoo =
|
||||
let doc = "Minimal clock example in JavaScript" in
|
||||
let srcs = [`File ~/"test/min_clock.ml"] in
|
||||
let meta = B0_meta.(empty |> tag test) in
|
||||
let requires = [ptime; ptime_clock] in
|
||||
B0_jsoo.html_page "min-clock-jsoo" ~doc ~srcs ~meta ~requires *)
|
||||
|
||||
let examples =
|
||||
test ~/"test/examples.ml" ~run:false ~doc:"Examples from the API docs"
|
||||
|
||||
(* Packs *)
|
||||
|
||||
let default =
|
||||
let meta =
|
||||
B0_meta.empty
|
||||
|> ~~ B0_meta.authors ["The ptime programmers"]
|
||||
|> ~~ B0_meta.maintainers ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
|
||||
|> ~~ B0_meta.homepage "https://erratique.ch/software/ptime"
|
||||
|> ~~ B0_meta.online_doc "https://erratique.ch/software/ptime/doc/"
|
||||
|> ~~ B0_meta.licenses ["ISC"]
|
||||
|> ~~ B0_meta.repo "git+https://erratique.ch/repos/ptime.git"
|
||||
|> ~~ B0_meta.issues "https://github.com/dbuenzli/ptime/issues"
|
||||
|> ~~ B0_meta.description_tags ["time"; "posix"; "system"; "org:erratique"]
|
||||
|> ~~ B0_opam.depends
|
||||
[ "ocaml", {|>= "4.08.0"|};
|
||||
"ocamlfind", {|build|};
|
||||
"ocamlbuild", {|build & != "0.9.0"|};
|
||||
"topkg", {|build & >= "1.0.3"|};
|
||||
]
|
||||
|> ~~ B0_opam.build
|
||||
{|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|}
|
||||
|> B0_meta.tag B0_opam.tag
|
||||
|> B0_meta.tag B0_release.tag
|
||||
in
|
||||
B0_pack.make "default" ~doc:"ptime package" ~meta ~locked:true @@
|
||||
B0_unit.list ()
|
||||
1
unikernel/duniverse/ptime/BRZO
Normal file
1
unikernel/duniverse/ptime/BRZO
Normal file
|
|
@ -0,0 +1 @@
|
|||
(srcs-x myocamlbuild.ml pkg test src/ptime_top_init.ml)
|
||||
102
unikernel/duniverse/ptime/CHANGES.md
Normal file
102
unikernel/duniverse/ptime/CHANGES.md
Normal file
|
|
@ -0,0 +1,102 @@
|
|||
v1.2.0 2024-09-10 Zagreb
|
||||
------------------------
|
||||
|
||||
- Fix fractional renderings of `Ptime.Span.pp` with leading zeros. For
|
||||
example 1.036s would render as 1.36s. This is a *rendering* bug in a
|
||||
function for human display, not a bug in the computations or
|
||||
conversion functions of `Ptime`.
|
||||
- Add `Ptime.weekday` type for naming the result of the `Ptime.weekday`
|
||||
function.
|
||||
- Regularize naming structure. The `ptime.clock.os` library is deprecated.
|
||||
Use `ptime.clock` instead.
|
||||
- Make the library `ptime.clock` export `ptime`.
|
||||
|
||||
v1.1.0 2022-12-02 Zagreb
|
||||
------------------------
|
||||
|
||||
- `Ptime.of_rfc3339` timezone offset parsing. Be even more lenient
|
||||
in non-strict parsing mode: allow `hhmm` and `hh` timezone offsets.
|
||||
(strict is `hh:mm`). Allows to parse an even larger subset of
|
||||
ISO 8601 than RFC 3339 (#31).
|
||||
- Add `Ptime.{to,of}_year`. Less costly than extracting the first
|
||||
component of `Ptime.to_date_time`. Useful for example to find
|
||||
out which DST rules a timestamp is subjected to for rendering.
|
||||
- Add `?tz_offset_s` optional argument to `Ptime.{of,to}_date` (#32).
|
||||
- Add `Ptime.weekday_num`. An integer is often more convenient
|
||||
than the enum value of `Ptime.weekday` (#30).
|
||||
- Add `Ptime.rfc3339_string_error` convenience function.
|
||||
- Use the new `js_of_ocaml` META `ocamlfind` standard to link
|
||||
JavaScript stubs (#28).
|
||||
- No longer install interfaces in the `ptime.clock` package,
|
||||
this package is now empty.
|
||||
|
||||
v1.0.0 2022-02-16 La Forclaz
|
||||
----------------------------
|
||||
|
||||
* Change the `js_of_ocaml` strategy for `Ptime_clock`'s JavaScript
|
||||
implementation. Primitives of `ptime.clock.os` are now implemented
|
||||
in pure JavaScript and linked by `js_of_ocaml`. This means that the
|
||||
`ptime.clock.jsoo` library no longer exists, simply link against
|
||||
`ptime.clock.os` instead. Thanks to Hugo Heuzard for suggesting and
|
||||
implementing this.
|
||||
|
||||
* Require OCaml >= 4.08
|
||||
* Correct a potential overflow in Ptime.Span.of_float_s (#26).
|
||||
|
||||
v0.8.6 2021-11-28 Zagreb
|
||||
------------------------
|
||||
|
||||
* Require OCaml >= 4.03
|
||||
* Drop dependency on `result` compatibility package.
|
||||
* Alter install structure. `ptime/{os,jsoo}` are now installed in
|
||||
`ptime/clock/{os,jsoo}`. Also a `ptime_clock.cm[t]i` is now
|
||||
installed in `ptime/clock/`. The `ocamlfind` packages are unchanged
|
||||
except for `ptime.clock.os.top` which no longer exists.
|
||||
* Handle `Pervasives` deprecation.
|
||||
* Fix `Ptime.truncate` to always truncate down. Thanks to David
|
||||
Kaloper Meršinjak for the report & fix.
|
||||
* Allow compiling with MSVC compiler. Thanks to Jonah Beckford for the
|
||||
patch.
|
||||
|
||||
v0.8.5 2019-05-02 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Make the package compatible with `js_of_ocaml` 3.3.0's
|
||||
namespacing
|
||||
|
||||
v0.8.4 2018-07-26 Zagreb
|
||||
------------------------
|
||||
|
||||
* `Ptime_clock`: Windows support. Thanks to IndiscriminateCoding
|
||||
and David Allsopp for the contribution.
|
||||
* Fix `Ptime.frac_s` on pre-epoch time stamps. The function computed a
|
||||
span of `1s - f` instead of `f` on these. This function is not used
|
||||
internally so this only affects users of this function that apply it
|
||||
on pre-epoch time stamps (#12). Thanks to David Kaloper Meršinjak
|
||||
for the report.
|
||||
|
||||
v0.8.3 2017-02-05 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Fix package for -custom linking.
|
||||
|
||||
v0.8.2 2016-07-22 Zagreb
|
||||
------------------------
|
||||
|
||||
* Add `?tz_offset_s` optional argument to `Ptime.weekday`. Thanks
|
||||
to Maxence Guesdon for suggesting.
|
||||
|
||||
v0.8.1 2015-07-14 Cambridge (UK)
|
||||
--------------------------------
|
||||
|
||||
* Add `Ptime.v` and `Ptime.Span.v` to safely deal with trusted
|
||||
inputs. Thanks to Matt Gray for suggesting.
|
||||
* Add `Ptime.weekday`, to help conversions to denormalized
|
||||
timestamp formats. Thanks to Romain Calascibetta for suggesting.
|
||||
* Build depend on topkg.
|
||||
* Relicense from BSD3 to ISC.
|
||||
|
||||
v0.8.0 2015-12-24 Cambridge (UK)
|
||||
--------------------------------
|
||||
|
||||
First release. Thanks to Raphaël Proust for lodging support.
|
||||
13
unikernel/duniverse/ptime/LICENSE.md
Normal file
13
unikernel/duniverse/ptime/LICENSE.md
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
Copyright (c) 2014 The ptime programmers
|
||||
|
||||
Permission to use, copy, modify, and/or distribute this software for any
|
||||
purpose with or without fee is hereby granted, provided that the above
|
||||
copyright notice and this permission notice appear in all copies.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
47
unikernel/duniverse/ptime/README.md
Normal file
47
unikernel/duniverse/ptime/README.md
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
Ptime — POSIX time for OCaml
|
||||
============================
|
||||
|
||||
Ptime has platform independent POSIX time support in pure OCaml. It
|
||||
provides a type to represent a well-defined range of POSIX timestamps
|
||||
with picosecond precision, conversion with date-time values,
|
||||
conversion with [RFC 3339 timestamps][rfc3339] and pretty printing to
|
||||
a human-readable, locale-independent representation.
|
||||
|
||||
The additional Ptime_clock library provides access to a system POSIX
|
||||
clock and to the system's current time zone offset.
|
||||
|
||||
Ptime is not a calendar library.
|
||||
|
||||
Ptime has no dependency. Ptime_clock depends on your system library or
|
||||
JavaScript runtime system. Ptime and its libraries are distributed
|
||||
under the ISC license.
|
||||
|
||||
[rfc3339]: http://tools.ietf.org/html/rfc3339
|
||||
|
||||
Home page: <http://erratique.ch/software/ptime>
|
||||
|
||||
# Installation
|
||||
|
||||
Ptime can be installed with `opam`:
|
||||
|
||||
opam install ptime
|
||||
|
||||
If you don't use `opam` consult the [`opam`](opam) file for build
|
||||
instructions.
|
||||
|
||||
# Documentation
|
||||
|
||||
The documentation can be consulted [online] or via `odig doc mtime`.
|
||||
|
||||
Questions are welcome but better asked on the [OCaml forum] than on
|
||||
the issue tracker.
|
||||
|
||||
[online]: http://erratique.ch/software/ptime/doc/
|
||||
[OCaml forum]: https://discuss.ocaml.org/
|
||||
|
||||
# Sample programs
|
||||
|
||||
See [test/min_clock.ml](test/min_clock.ml).
|
||||
|
||||
If you installed ptime with `opam` sample programs are located in
|
||||
the directory `opam var ptime:doc`.
|
||||
8
unikernel/duniverse/ptime/_tags
Normal file
8
unikernel/duniverse/ptime/_tags
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
true : bin_annot, safe_string
|
||||
<_b0> : -traverse
|
||||
<src> : include
|
||||
<src/top> : include
|
||||
<src/top/ptime_top*> : package(compiler-libs.toplevel)
|
||||
<src/clock> : include
|
||||
<src/clock/ptime_clock.{cma,cmxa}> : record_ptime_clock_stubs
|
||||
<src/clock/ptime_clock.cmxs> : link_ptime_clock_stubs
|
||||
26
unikernel/duniverse/ptime/doc/index.mld
Normal file
26
unikernel/duniverse/ptime/doc/index.mld
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
{0 Ptime {%html: <span class="version">v1.2.0</span>%}}
|
||||
|
||||
{!Ptime} has platform independent support for POSIX time.
|
||||
|
||||
It provides a {{!Ptime.t}type} to represent a well-defined range of
|
||||
POSIX timestamps with picosecond precision, conversion with
|
||||
{{!Ptime.date_time}date-time values}, conversion with
|
||||
{{!Ptime.rfc3339}RFC 3339 timestamps} and {{!Ptime.print}pretty
|
||||
printing} to a human-readable, locale-independent representation.
|
||||
|
||||
{!Ptime_clock} provides access to a
|
||||
{{!Ptime_clock.platform_support}system POSIX clock} and the system's
|
||||
current time zone offset.
|
||||
|
||||
Ptime is not a calendar library.
|
||||
|
||||
{1:ptime Library [ptime]}
|
||||
|
||||
{!modules: Ptime}
|
||||
|
||||
{1:ptime_clock Library [ptime.clock]}
|
||||
|
||||
{!modules: Ptime_clock}
|
||||
|
||||
This library also works with JavaScript,
|
||||
see the {{!Ptime_clock.platform_support}platform support}.
|
||||
3
unikernel/duniverse/ptime/dune-project
Normal file
3
unikernel/duniverse/ptime/dune-project
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(lang dune 2.0)
|
||||
(name ptime)
|
||||
(version v1.2.0+dune)
|
||||
43
unikernel/duniverse/ptime/myocamlbuild.ml
Normal file
43
unikernel/duniverse/ptime/myocamlbuild.ml
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
open Ocamlbuild_plugin
|
||||
open Command
|
||||
|
||||
let os = try Sys.getenv "PTIME_OS" with
|
||||
| Not_found -> Ocamlbuild_pack.My_unix.run_and_read "uname -s"
|
||||
|
||||
let system_support_lib = match os with
|
||||
| "Linux\n" -> [A "-cclib"; A "-lrt"]
|
||||
| _ -> []
|
||||
|
||||
let lib s =
|
||||
match !Ocamlbuild_plugin.Options.ext_lib with
|
||||
| "" -> s ^ ".a"
|
||||
| x -> s ^ "." ^ x
|
||||
|
||||
let () =
|
||||
dispatch begin function
|
||||
| After_rules ->
|
||||
|
||||
(* ptime *)
|
||||
|
||||
ocaml_lib ~tag_name:"use_ptime" ~dir:"src" "src/ptime";
|
||||
|
||||
(* ptime_clock *)
|
||||
|
||||
flag_and_dep ["link"; "ocaml"; "link_ptime_clock_stubs"]
|
||||
(A (lib "src/clock/libptime_clock_stubs"));
|
||||
|
||||
dep ["record_ptime_clock_stubs"]
|
||||
[lib "src/clock/libptime_clock_stubs"];
|
||||
|
||||
flag ["library"; "ocaml"; "byte"; "record_ptime_clock_stubs"]
|
||||
(S ([A "-dllib"; A "-lptime_clock_stubs"] @ system_support_lib));
|
||||
flag ["library"; "ocaml"; "record_ptime_clock_stubs"] (* byt + nat *)
|
||||
(S ([A "-cclib"; A "-lptime_clock_stubs"] @ system_support_lib));
|
||||
|
||||
ocaml_lib ~tag_name:"use_ptime_clock" ~dir:"src-clock"
|
||||
"src/clock/ptime_clock";
|
||||
|
||||
flag ["link"; "ocaml"; "use_ptime_clock"]
|
||||
(S [A "-ccopt"; A "-Lsrc-clock"]);
|
||||
| _ -> ()
|
||||
end
|
||||
42
unikernel/duniverse/ptime/pkg/META
Normal file
42
unikernel/duniverse/ptime/pkg/META
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
description = "POSIX time for OCaml"
|
||||
version = "1.2.0"
|
||||
requires = ""
|
||||
archive(byte) = "ptime.cma"
|
||||
archive(native) = "ptime.cmxa"
|
||||
plugin(byte) = "ptime.cma"
|
||||
plugin(native) = "ptime.cmxs"
|
||||
exists_if = "ptime.cma ptime.cmxa"
|
||||
|
||||
package "clock" (
|
||||
directory = "clock"
|
||||
description = "The ptime.clock library"
|
||||
version = "1.2.0"
|
||||
requires = "ptime"
|
||||
exports = "ptime"
|
||||
archive(byte) = "ptime_clock.cma"
|
||||
archive(native) = "ptime_clock.cmxa"
|
||||
plugin(byte) = "ptime_clock.cma"
|
||||
plugin(native) = "ptime_clock.cmxs"
|
||||
jsoo_runtime = "runtime.js"
|
||||
exists_if = "ptime_clock.cma ptime_clock.cmxa"
|
||||
|
||||
package "os" (
|
||||
description = "The ptime.clock.os library (deprecated)"
|
||||
version = "1.2.0"
|
||||
requires = "ptime.clock"
|
||||
exports = "ptime.clock"
|
||||
warning = "Deprecated, use the ptime.clock library."
|
||||
)
|
||||
)
|
||||
|
||||
package "top" (
|
||||
directory = "top"
|
||||
description = "The ptime.top library"
|
||||
version = "1.2.0"
|
||||
requires = "ptime"
|
||||
archive(byte) = "ptime_top.cma"
|
||||
archive(native) = "ptime_top.cmxa"
|
||||
plugin(byte) = "ptime_top.cma"
|
||||
plugin(native) = "ptime_top.cmxs"
|
||||
exists_if = "ptime_top.cma ptime_top.cmxa"
|
||||
)
|
||||
15
unikernel/duniverse/ptime/pkg/pkg.ml
Executable file
15
unikernel/duniverse/ptime/pkg/pkg.ml
Executable file
|
|
@ -0,0 +1,15 @@
|
|||
#!/usr/bin/env ocaml
|
||||
#use "topfind"
|
||||
#require "topkg"
|
||||
open Topkg
|
||||
|
||||
let () =
|
||||
Pkg.describe "ptime" @@ fun c ->
|
||||
Ok [ Pkg.mllib "src/ptime.mllib";
|
||||
Pkg.mllib "src/clock/ptime_clock.mllib" ~dst_dir:"clock/";
|
||||
Pkg.clib "src/clock/libptime_clock_stubs.clib" ~lib_dst_dir:"clock/";
|
||||
Pkg.lib "src/clock/runtime.js" ~dst:"clock/";
|
||||
Pkg.mllib ~api:[] "src/top/ptime_top.mllib" ~dst_dir:"top/";
|
||||
Pkg.lib "src/ptime_top_init.ml" ~dst:"ptime_top_init.ml";
|
||||
Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld";
|
||||
Pkg.doc "test/min_clock.ml"; ]
|
||||
35
unikernel/duniverse/ptime/ptime.opam
Normal file
35
unikernel/duniverse/ptime/ptime.opam
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
version: "1.2.0+dune"
|
||||
opam-version: "2.0"
|
||||
name: "ptime"
|
||||
synopsis: "POSIX time for OCaml"
|
||||
description: """\
|
||||
Ptime has platform independent POSIX time support in pure OCaml. It
|
||||
provides a type to represent a well-defined range of POSIX timestamps
|
||||
with picosecond precision, conversion with date-time values,
|
||||
conversion with [RFC 3339 timestamps][rfc3339] and pretty printing to
|
||||
a human-readable, locale-independent representation.
|
||||
|
||||
The additional Ptime_clock library provides access to a system POSIX
|
||||
clock and to the system's current time zone offset.
|
||||
|
||||
Ptime is not a calendar library.
|
||||
|
||||
Ptime has no dependency. Ptime_clock depends on your system library or
|
||||
JavaScript runtime system. Ptime and its libraries are distributed
|
||||
under the ISC license.
|
||||
|
||||
[rfc3339]: http://tools.ietf.org/html/rfc3339
|
||||
|
||||
Home page: <http://erratique.ch/software/ptime>"""
|
||||
maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
|
||||
authors: ["The ptime programmers"]
|
||||
license: "ISC"
|
||||
tags: ["time" "posix" "system" "org:erratique"]
|
||||
homepage: "https://github.com/dune-universe/ptime"
|
||||
bug-reports: "https://github.com/dbuenzli/ptime/issues"
|
||||
depends: [
|
||||
"dune" {>= "2.0"}
|
||||
"ocaml" {>= "4.08.0"}
|
||||
]
|
||||
build: [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} ]
|
||||
dev-repo: "git+https://github.com/dune-universe/ptime.git"
|
||||
12
unikernel/duniverse/ptime/src/clock/dune
Normal file
12
unikernel/duniverse/ptime/src/clock/dune
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
(library
|
||||
(name ptime_clock)
|
||||
(synopsis "Ptime_clock for native OS")
|
||||
(public_name ptime.clock)
|
||||
(libraries ptime)
|
||||
(foreign_stubs (language c) (names ptime_clock_stubs))
|
||||
(flags (:standard -w -6-27))
|
||||
(wrapped false))
|
||||
|
||||
(deprecated_library_name
|
||||
(old_public_name ptime.clock.os)
|
||||
(new_public_name ptime.clock))
|
||||
|
|
@ -0,0 +1 @@
|
|||
ptime_clock_stubs.o
|
||||
29
unikernel/duniverse/ptime/src/clock/ptime_clock.ml
Normal file
29
unikernel/duniverse/ptime/src/clock/ptime_clock.ml
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Stubs *)
|
||||
|
||||
external ptime_clock_now_d_ps : unit -> int * int64 =
|
||||
"ocaml_ptime_clock_now_d_ps"
|
||||
|
||||
external ptime_clock_period_d_ps : unit -> (int * int64) option =
|
||||
"ocaml_ptime_clock_period_d_ps"
|
||||
|
||||
external ptime_clock_current_tz_offset_s : unit -> int option =
|
||||
"ocaml_ptime_clock_current_tz_offset_s"
|
||||
|
||||
(* POSIX clock *)
|
||||
|
||||
let now () = Ptime.unsafe_of_d_ps (ptime_clock_now_d_ps ())
|
||||
let period () = Ptime.Span.unsafe_of_d_ps_option (ptime_clock_period_d_ps ())
|
||||
|
||||
(* System time zone offset *)
|
||||
|
||||
let current_tz_offset_s = ptime_clock_current_tz_offset_s
|
||||
|
||||
(* Raw interface *)
|
||||
|
||||
let now_d_ps = ptime_clock_now_d_ps
|
||||
let period_d_ps = ptime_clock_period_d_ps
|
||||
80
unikernel/duniverse/ptime/src/clock/ptime_clock.mli
Normal file
80
unikernel/duniverse/ptime/src/clock/ptime_clock.mli
Normal file
|
|
@ -0,0 +1,80 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(** POSIX time clock.
|
||||
|
||||
[Ptime_clock] provides access to a system POSIX time clock and to
|
||||
the system's current time zone offset.
|
||||
|
||||
This time does not increase monotically and is subject to system
|
||||
calendar time adjustments. Use {!Mtime} if you need monotonic
|
||||
wall-clock time to measure time spans.
|
||||
|
||||
Consult important information about {{!err}error handling}
|
||||
and {{!platform_support}platform support}. *)
|
||||
|
||||
(** {1:clock POSIX clock} *)
|
||||
|
||||
val now : unit -> Ptime.t
|
||||
(** [now ()] is the current POSIX time, by definition always on the
|
||||
UTC timeline.
|
||||
|
||||
Raises {!Sys_error}, see {{!err}error handling}. *)
|
||||
|
||||
val period : unit -> Ptime.span option
|
||||
(** [period ()] is a positive POSIX time span representing
|
||||
the clock's period (if available). *)
|
||||
|
||||
(** {1:tz System time zone offset} *)
|
||||
|
||||
val current_tz_offset_s : unit -> Ptime.tz_offset_s option
|
||||
(** [current_tz_offset_s ()] is the system's current local time zone
|
||||
offset to UTC in seconds, if known. This is the duration local
|
||||
time - UTC time in seconds. *)
|
||||
|
||||
(** {1:raw POSIX clock raw interface} *)
|
||||
|
||||
val now_d_ps : unit -> int * int64
|
||||
(** [now_d_ps ()] is [(d, ps)] representing POSIX time occuring at
|
||||
[d] * 86'400e12 + [ps] POSIX picoseconds from the epoch
|
||||
1970-01-01 00:00:00 UTC. [ps] is in the range
|
||||
\[[0];[86_399_999_999_999_999L]\].
|
||||
|
||||
Raises {!Sys_error}, see {{!err}error handling} *)
|
||||
|
||||
val period_d_ps : unit -> (int * int64) option
|
||||
(** [period_d_ps ()] is if available [Some (d, ps)] representing the
|
||||
clock's picosecond period [d] * 86'400e12 + [ps]. [ps] is in the
|
||||
range \[[0];[86_399_999_999_999_999L]\]. *)
|
||||
|
||||
(** {1:err Error handling}
|
||||
|
||||
The functions {!now} and {!now_d_ps} raise [Sys_error] whenever
|
||||
they can't determine the current time or that it doesn't fit in
|
||||
[Ptime]'s well-defined {{!Ptime.t}range}. This exception should
|
||||
only be catched at the toplevel of your program to log it and
|
||||
abort the program. It indicates a serious error condition in the
|
||||
system.
|
||||
|
||||
All the other functions, whose functionality is less essential,
|
||||
simply silently return [None] if they can't determine the
|
||||
information either because it is unavailable or because an error
|
||||
occured.
|
||||
|
||||
{1:platform_support Platform support}
|
||||
|
||||
{ul
|
||||
{- Platforms with a POSIX clock (includes Linux) use
|
||||
{{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]} with [CLOCK_REALTIME].}
|
||||
{- On Darwin {{:http://pubs.opengroup.org/onlinepubs/9699919799/}
|
||||
[gettimeofday]} is used.}
|
||||
{- On Windows
|
||||
{{:https://msdn.microsoft.com/en-us/library/windows/desktop/ms724390(v=vs.85).aspx}[GetSystemTime]}
|
||||
and
|
||||
{{:https://msdn.microsoft.com/en-us/library/windows/desktop/ms724421(v=vs.85).aspx}[GetTimeZoneInformation]}
|
||||
are used.}
|
||||
{- On JavaScript
|
||||
{{:http://www.ecma-international.org/ecma-262/6.0/index.html#sec-date.now}[Date.now ()]} and
|
||||
{{:http://www.ecma-international.org/ecma-262/6.0/index.html#sec-date.prototype.gettimezoneoffset}[Date.prototype.getTimezoneOffset]} are used.}} *)
|
||||
1
unikernel/duniverse/ptime/src/clock/ptime_clock.mllib
Normal file
1
unikernel/duniverse/ptime/src/clock/ptime_clock.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Ptime_clock
|
||||
265
unikernel/duniverse/ptime/src/clock/ptime_clock_stubs.c
Normal file
265
unikernel/duniverse/ptime/src/clock/ptime_clock_stubs.c
Normal file
|
|
@ -0,0 +1,265 @@
|
|||
/*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
--------------------------------------------------------------------------*/
|
||||
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/alloc.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/fail.h>
|
||||
|
||||
#define Val_none Val_int(0)
|
||||
#define OCAML_PTIME_DAY_MAX 2932896 // See Ptime.max
|
||||
#define OCAML_PTIME_RAISE_SYS_ERROR(ERR) \
|
||||
do { caml_raise_sys_error (caml_copy_string("Ptime_clock: " ERR)); } \
|
||||
while (0)
|
||||
|
||||
/* Detect platforms and call in their includes */
|
||||
|
||||
#if defined(__APPLE__) && defined(__MACH__)
|
||||
#define OCAML_PTIME_DARWIN
|
||||
#include <time.h>
|
||||
#include <sys/time.h>
|
||||
|
||||
#elif defined(__unix__) || defined(__unix)
|
||||
#include <unistd.h>
|
||||
#if defined(_POSIX_VERSION)
|
||||
#define OCAML_PTIME_POSIX
|
||||
#include <time.h>
|
||||
#endif
|
||||
|
||||
#elif defined(_WIN32)
|
||||
#define OCAML_PTIME_WIN
|
||||
#include <windows.h>
|
||||
|
||||
#else
|
||||
#warning OCaml Ptime_clock module: unsupported platform
|
||||
#define OCAML_PTIME_UNSUPPORTED
|
||||
#endif
|
||||
|
||||
|
||||
/* Clock now */
|
||||
|
||||
#if defined(OCAML_PTIME_POSIX)
|
||||
|
||||
CAMLprim value ocaml_ptime_clock_now_d_ps (value unit)
|
||||
{
|
||||
CAMLparam1 (unit);
|
||||
CAMLlocal1 (pair);
|
||||
struct timespec now;
|
||||
|
||||
if (clock_gettime (CLOCK_REALTIME, &now))
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("can't determine current time");
|
||||
|
||||
/* Make sure to return valid Ptime.t values. */
|
||||
|
||||
/* We only handle valid timespec structs as per POSIX def (§2.8.5 in 2013) */
|
||||
if (now.tv_nsec < 0 || now.tv_nsec > 999999999)
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("invalid tv_nsec in timespec");
|
||||
|
||||
/* To make it easier, we do not lie, this can't possibly be now.
|
||||
See e.g. Ptime.Span.of_int_s if this is a problem. */
|
||||
if (now.tv_sec < 0)
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("negative tv_sec in timespec");
|
||||
|
||||
int d = now.tv_sec / 86400;
|
||||
if (d > OCAML_PTIME_DAY_MAX)
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("can't represent timespec in Ptime.t");
|
||||
|
||||
pair = caml_alloc (2, 0);
|
||||
Store_field (pair, 0, Val_int (d));
|
||||
Store_field (pair, 1,
|
||||
/* Given the above checks, in the right range for Ptime */
|
||||
caml_copy_int64 ((now.tv_sec % 86400) * 1000000000000L +
|
||||
(now.tv_nsec * 1000L)));
|
||||
CAMLreturn (pair);
|
||||
}
|
||||
|
||||
#elif defined(OCAML_PTIME_DARWIN)
|
||||
|
||||
CAMLprim value ocaml_ptime_clock_now_d_ps (value unit)
|
||||
{
|
||||
CAMLparam1 (unit);
|
||||
CAMLlocal1 (pair);
|
||||
struct timeval now;
|
||||
|
||||
gettimeofday(&now, NULL);
|
||||
|
||||
/* Make sure to return valid Ptime.t values. */
|
||||
|
||||
/* We only handle reasonable timevals (not specified in POSIX it seems) */
|
||||
if (now.tv_usec < 0 || now.tv_usec > 999999)
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("unreasonable tv_usec in timeval");
|
||||
|
||||
/* To make it easier, we do not lie, this can't possibly be now.
|
||||
See e.g. Ptime.Span.of_int_s if this is a problem. */
|
||||
if (now.tv_sec < 0)
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("negative tv_sec in timeval");
|
||||
|
||||
int d = now.tv_sec / 86400;
|
||||
if (d > OCAML_PTIME_DAY_MAX)
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("can't represent timeval in Ptime.t");
|
||||
|
||||
pair = caml_alloc (2, 0);
|
||||
Store_field (pair, 0, Val_int (d));
|
||||
Store_field (pair, 1,
|
||||
/* Given the above checks, in the right range for Ptime */
|
||||
caml_copy_int64 ((now.tv_sec % 86400) * 1000000000000L +
|
||||
(now.tv_usec * 1000000L)));
|
||||
CAMLreturn (pair);
|
||||
}
|
||||
|
||||
#elif defined(OCAML_PTIME_WIN)
|
||||
|
||||
CAMLprim value ocaml_ptime_clock_now_d_ps (value unit)
|
||||
{
|
||||
CAMLparam1 (unit);
|
||||
CAMLlocal1 (pair);
|
||||
long sec, usec;
|
||||
SYSTEMTIME stime;
|
||||
FILETIME ftime;
|
||||
ULARGE_INTEGER time;
|
||||
|
||||
GetSystemTime (&stime);
|
||||
SystemTimeToFileTime (&stime, &ftime);
|
||||
time.LowPart = ftime.dwLowDateTime;
|
||||
time.HighPart = ftime.dwHighDateTime;
|
||||
|
||||
#define EPOCH (116444736000000000ULL)
|
||||
sec = (long)((time.QuadPart - EPOCH) / 10000000L);
|
||||
#undef EPOCH
|
||||
usec = (long)(stime.wMilliseconds * 1000);
|
||||
|
||||
if (usec < 0 || usec > 999999)
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("unreasonable usec in FILETIME");
|
||||
|
||||
if (sec < 0)
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("negative sec in FILETIME");
|
||||
|
||||
int d = sec / 86400;
|
||||
if (d > OCAML_PTIME_DAY_MAX)
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("can't represent FILETIME in Ptime.t");
|
||||
|
||||
pair = caml_alloc (2, 0);
|
||||
Store_field (pair, 0, Val_int (d));
|
||||
Store_field (pair, 1,
|
||||
caml_copy_int64 ((sec % 86400) * 1000000000000L +
|
||||
(usec * 1000000L)));
|
||||
CAMLreturn (pair);
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
CAMLprim value ocaml_ptime_clock_now_d_ps (value unit)
|
||||
{
|
||||
OCAML_PTIME_RAISE_SYS_ERROR ("unsupported platform");
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
/* Clock period */
|
||||
|
||||
#if defined(OCAML_PTIME_POSIX)
|
||||
|
||||
CAMLprim value ocaml_ptime_clock_period_d_ps (value unit)
|
||||
{
|
||||
CAMLparam1 (unit);
|
||||
CAMLlocal2 (some, pair);
|
||||
struct timespec res;
|
||||
|
||||
if (clock_getres (CLOCK_REALTIME, &res)) CAMLreturn (Val_none);
|
||||
|
||||
/* Make sure to return valid Ptime.Span.t values. */
|
||||
|
||||
/* We only handle valid timespec structs as per POSIX def (§2.8.5 in 2013) */
|
||||
if (res.tv_nsec < 0 || res.tv_nsec > 999999999) CAMLreturn (Val_none);
|
||||
|
||||
/* Negative periods are dubious */
|
||||
if (res.tv_sec < 0) CAMLreturn (Val_none);
|
||||
|
||||
some = caml_alloc (1, 0);
|
||||
pair = caml_alloc (2, 0);
|
||||
Store_field (some, 0, pair);
|
||||
Store_field (pair, 0, Val_int (res.tv_sec / 86400));
|
||||
Store_field (pair, 1,
|
||||
/* Given the above checks, in the right range for Ptime */
|
||||
caml_copy_int64 ((res.tv_sec % 86400) * 1000000000000L +
|
||||
(res.tv_nsec * 1000L)));
|
||||
CAMLreturn (some);
|
||||
}
|
||||
|
||||
#else /* OCAML_PTIME_DARWIN || OCAML_PTIME_WIN || OCAML_PTIME_UNSUPPORTED */
|
||||
|
||||
CAMLprim value ocaml_ptime_clock_period_d_ps (value unit)
|
||||
{ return Val_none; }
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
/* Timezone offset (local time - UTC time) */
|
||||
|
||||
#if defined(OCAML_PTIME_DARWIN) || defined (OCAML_PTIME_POSIX)
|
||||
|
||||
CAMLprim value ocaml_ptime_clock_current_tz_offset_s (value unit)
|
||||
{
|
||||
CAMLparam1(unit);
|
||||
CAMLlocal1(some);
|
||||
struct tm *tm;
|
||||
|
||||
time_t now_utc = time (NULL);
|
||||
if (now_utc == (time_t)-1) return Val_none;
|
||||
|
||||
tm = localtime (&now_utc);
|
||||
if (tm == NULL) return Val_none;
|
||||
struct tm local = *tm;
|
||||
|
||||
tm = gmtime (&now_utc);
|
||||
if (tm == NULL) return Val_none;
|
||||
struct tm utc = *tm;
|
||||
|
||||
int dd = local.tm_yday - utc.tm_yday;
|
||||
int dh = local.tm_hour - utc.tm_hour;
|
||||
int dm = dh * 60 + (local.tm_min - utc.tm_min);
|
||||
dm = (dd == 1 || dd < -1 /* year wrap */) ? dm + (24 * 60) :
|
||||
(dd == -1 || dd > 1 /* year wrap */) ? dm - (24 * 60) :
|
||||
dm /* same day */;
|
||||
|
||||
some = caml_alloc (1, 0);
|
||||
Store_field (some, 0, Val_int (dm * 60));
|
||||
CAMLreturn(some);
|
||||
}
|
||||
|
||||
#elif defined(OCAML_PTIME_WIN)
|
||||
|
||||
CAMLprim value ocaml_ptime_clock_current_tz_offset_s (value unit)
|
||||
{
|
||||
CAMLparam1(unit);
|
||||
CAMLlocal1(some);
|
||||
TIME_ZONE_INFORMATION tz;
|
||||
int bias;
|
||||
|
||||
DWORD ret = GetTimeZoneInformation(&tz);
|
||||
if (ret == TIME_ZONE_ID_UNKNOWN)
|
||||
bias = tz.Bias;
|
||||
else if (ret == TIME_ZONE_ID_STANDARD)
|
||||
bias = tz.Bias + tz.StandardBias;
|
||||
else if (ret == TIME_ZONE_ID_DAYLIGHT)
|
||||
bias = tz.Bias + tz.DaylightBias;
|
||||
else {
|
||||
OCAML_PTIME_RAISE_SYS_ERROR("GetTimeZoneInformation failed");
|
||||
}
|
||||
|
||||
some = caml_alloc (1, 0);
|
||||
/* Note that on Windows 'bias' is defined as (UTC - localtime),
|
||||
while ptime uses (localtime - UTC) */
|
||||
Store_field (some, 0, Val_int (-bias * 60));
|
||||
CAMLreturn(some);
|
||||
}
|
||||
|
||||
#else /* OCAML_PTIME_UNSUPPORTED */
|
||||
|
||||
CAMLprim value ocaml_ptime_clock_current_tz_offset_s (value unit)
|
||||
{ return Val_none; }
|
||||
|
||||
#endif
|
||||
49
unikernel/duniverse/ptime/src/clock/runtime.js
Normal file
49
unikernel/duniverse/ptime/src/clock/runtime.js
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
/*---------------------------------------------------------------------------
|
||||
Copyright (c) 2022 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*/
|
||||
|
||||
//Provides: ocaml_ptime_clock_period_d_ps
|
||||
function ocaml_ptime_clock_period_d_ps (_unit) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
//Provides: ocaml_ptime_clock_current_tz_offset_s
|
||||
function ocaml_ptime_clock_current_tz_offset_s (_unit) {
|
||||
return [0, ((new Date ()).getTimezoneOffset () * -60)]
|
||||
}
|
||||
|
||||
//Provides: ocaml_ptime_clock_now_d_ps
|
||||
//Requires: caml_int64_of_int32, caml_int64_of_float
|
||||
//Requires: caml_int64_add, caml_int64_mul
|
||||
//Requires: caml_modf_float
|
||||
//Requires: caml_raise_sys_error
|
||||
function ocaml_ptime_clock_now_d_ps (_unit) {
|
||||
function err (ms) {
|
||||
caml_raise_sys_error
|
||||
("Ptime_clock: can't represent JavaScript timestamp " + ms);
|
||||
}
|
||||
var dmin = -719528; /* Day component of Ptime.min */
|
||||
var dmax = 2932896; /* Day component of Ptime.max */
|
||||
var ms = Date.now ();
|
||||
var ps;
|
||||
if (ms != ms) err (ms)
|
||||
var days = Math.floor (ms / 86400000);
|
||||
if (days < dmin || days > dmax) err(ms);
|
||||
var rem_ms = ms % 86400000;
|
||||
if (rem_ms < 0) rem_ms += 86400000
|
||||
if (rem_ms >= 86400000) {
|
||||
/* Guard against a potential overflow in the computation of [rem_s] */
|
||||
days += 1;
|
||||
if (days > dmax) err (ms);
|
||||
ps = caml_int64_of_int32 (0);
|
||||
}
|
||||
else {
|
||||
var modf = caml_modf_float (rem_ms);
|
||||
var fract_ps = caml_int64_of_float (modf[1] * 1e9);
|
||||
var rem_ps = caml_int64_mul (caml_int64_of_float (modf[2]),
|
||||
caml_int64_of_int32 (1000000000));
|
||||
ps = caml_int64_add (rem_ps, fract_ps);
|
||||
}
|
||||
return [0, days, ps]
|
||||
}
|
||||
7
unikernel/duniverse/ptime/src/dune
Normal file
7
unikernel/duniverse/ptime/src/dune
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
(library
|
||||
(name ptime)
|
||||
(synopsis "POSIX time for OCaml")
|
||||
(public_name ptime)
|
||||
(modules ptime)
|
||||
(flags (:standard -w -6-27))
|
||||
(wrapped false))
|
||||
707
unikernel/duniverse/ptime/src/ptime.ml
Normal file
707
unikernel/duniverse/ptime/src/ptime.ml
Normal file
|
|
@ -0,0 +1,707 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Julian day and proleptic Gregorian calendar date conversion.
|
||||
|
||||
Formulae are from the calendar FAQ:
|
||||
http://www.tondering.dk/claus/cal/julperiod.php#formula
|
||||
|
||||
These formulae work for positive Julian days. They represent
|
||||
Gegorian calendar BCE year `y` by `-(y-1)`, e.g. 2 BCE is -1, this
|
||||
follows the convention of ISO 8601.
|
||||
|
||||
All timestamps in Ptime's [min;max] range are represented by
|
||||
positive Julian days and the formulae do not overflow on 32-bit
|
||||
platforms in this restricted range. *)
|
||||
|
||||
let jd_to_date jd =
|
||||
let a = jd + 32044 in
|
||||
let b = (4 * a + 3) / 146097 in
|
||||
let c = a - ((146097 * b) / 4) in
|
||||
let d = (4 * c + 3) / 1461 in
|
||||
let e = c - ((1461 * d) / 4) in
|
||||
let m = (5 * e + 2) / 153 in
|
||||
let day = e - ((153 * m + 2) / 5) + 1 in
|
||||
let month = m + 3 - (12 * (m / 10)) in
|
||||
let year = 100 * b + d - 4800 + (m / 10) in
|
||||
(year, month, day)
|
||||
|
||||
let jd_to_year jd = (* Same as above but only for the year *)
|
||||
let a = jd + 32044 in
|
||||
let b = (4 * a + 3) / 146097 in
|
||||
let c = a - ((146097 * b) / 4) in
|
||||
let d = (4 * c + 3) / 1461 in
|
||||
let e = c - ((1461 * d) / 4) in
|
||||
let m = (5 * e + 2) / 153 in
|
||||
100 * b + d - 4800 + (m / 10)
|
||||
|
||||
let jd_of_date (year, month, day) =
|
||||
let a = (14 - month) / 12 in
|
||||
let y = year + 4800 - a in
|
||||
let m = month + 12 * a - 3 in
|
||||
day + ((153 * m) + 2)/ 5 + 365 * y +
|
||||
(y / 4) - (y / 100) + (y / 400) - 32045
|
||||
|
||||
let jd_posix_epoch = 2_440_588 (* the Julian day of the POSIX epoch *)
|
||||
let jd_ptime_min = 1_721_060 (* the Julian day of Ptime.min *)
|
||||
let jd_ptime_max = 5_373_484 (* the Julian day of Ptime.max *)
|
||||
|
||||
(* Picosecond precision POSIX timestamps and time span representation.
|
||||
|
||||
POSIX timestamps and spans are represented by int * int64 pairs
|
||||
with the int64 in the range [0L;86_399_999_999_999_999L]. A pair
|
||||
[(d, ps)] denotes the POSIX picosecond duration [d] * 86_400e12 +
|
||||
[ps].
|
||||
|
||||
For a timestamp this can be seen as a POSIX day count from the
|
||||
epoch paired with a picosecond precision POSIX time point in that
|
||||
day starting from 00:00:00.
|
||||
|
||||
By definition with a negative [d] the [ps] duration brings us
|
||||
towards zero, *not* towards infinity:
|
||||
|
||||
|
||||
(d * 86_400e12) (d * 86_400e12 + ps) 0
|
||||
... -----+-----------------+-------------------+--------- ...
|
||||
[---------------->|
|
||||
ps
|
||||
|
||||
[d] is largely sufficent to represent all the days in Ptime's
|
||||
[min;max] range on both 32-bit and 64-bit platforms. *)
|
||||
|
||||
type t = int * int64
|
||||
|
||||
let ps_count_in_ps = 1L
|
||||
let ps_count_in_ns = 1_000L
|
||||
let ps_count_in_100ns = 100_000L
|
||||
let ps_count_in_us = 1_000_000L
|
||||
let ps_count_in_100us = 100_000_000L
|
||||
let ps_count_in_ms = 1_000_000_000L
|
||||
let ps_count_in_100ms = 100_000_000_000L
|
||||
let ps_count_in_s = 1_000_000_000_000L
|
||||
let ps_count_in_min = 60_000_000_000_000L
|
||||
let ps_count_in_hour = 3600_000_000_000_000L
|
||||
let ps_count_in_day = 86_400_000_000_000_000L
|
||||
let ps_day_max = 86_399_999_999_999_999L
|
||||
|
||||
let day_min = jd_ptime_min - jd_posix_epoch
|
||||
let day_max = jd_ptime_max - jd_posix_epoch
|
||||
|
||||
let epoch = (0, 0L) (* 1970-01-01 00:00:00 UTC *)
|
||||
let min = (day_min, 0L) (* 0000-01-01 00:00:00 UTC *)
|
||||
let max = (day_max, ps_day_max) (* 9999-12-31 23:59:59 UTC *)
|
||||
|
||||
(* POSIX time spans *)
|
||||
|
||||
type span = t
|
||||
|
||||
module Span = struct
|
||||
|
||||
let stdlib_abs = abs
|
||||
|
||||
(* Arithmetic *)
|
||||
|
||||
let neg = function
|
||||
| (d, 0L) -> (-d, 0L)
|
||||
| (d, ps) -> (-(d + 1), Int64.sub ps_count_in_day ps)
|
||||
|
||||
let add (d0, ps0) (d1, ps1) =
|
||||
let d = d0 + d1 in
|
||||
let ps = Int64.add ps0 ps1 in
|
||||
let ps_clamp = Int64.rem ps ps_count_in_day in
|
||||
let d = d + Int64.compare ps ps_clamp in
|
||||
d, ps_clamp
|
||||
|
||||
let sub s0 s1 = add s0 (neg s1)
|
||||
let abs (d, _ as s) = if d < 0 then neg s else s
|
||||
|
||||
(* POSIX time spans *)
|
||||
|
||||
type t = span
|
||||
|
||||
let zero = (0, 0L)
|
||||
let v (d, ps as s) =
|
||||
if ps < 0L || ps > ps_day_max
|
||||
then invalid_arg (Format.sprintf "illegal ptime time span: (%d,%Ld)" d ps)
|
||||
else s
|
||||
|
||||
let of_d_ps (d, ps as s) = if ps < 0L || ps > ps_day_max then None else Some s
|
||||
let unsafe_of_d_ps s = s
|
||||
let unsafe_of_d_ps_option s = s
|
||||
let to_d_ps s = s
|
||||
|
||||
let of_int_s secs =
|
||||
let d = stdlib_abs secs in
|
||||
let s = (d / 86_400, Int64.(mul (of_int (d mod 86_400)) ps_count_in_s)) in
|
||||
if secs < 0 then neg s else s
|
||||
|
||||
let day_int_min = min_int / 86_400
|
||||
let day_int_max = max_int / 86_400
|
||||
let to_int_s (d, ps) =
|
||||
if d < day_int_min || d > day_int_max then None else
|
||||
let days_s = d * 86_400 in
|
||||
let day_s = Int64.(to_int (div ps ps_count_in_s)) (* always positive *) in
|
||||
let secs = days_s + day_s in
|
||||
if secs < days_s (* positive overflow *) then None else Some secs
|
||||
|
||||
let min_int_float = float min_int
|
||||
let max_int_float = float max_int
|
||||
let of_float_s secs =
|
||||
if secs <> secs (* nan *) then None else
|
||||
let days = floor (secs /. 86_400.) in
|
||||
if days < min_int_float || days > max_int_float then None else
|
||||
let rem_s = mod_float secs 86_400. in
|
||||
let rem_s = if rem_s < 0. then 86_400. +. rem_s else rem_s in
|
||||
if rem_s >= 86_400. then
|
||||
(* Guard against a potential overflow in the computation of [rem_s] *)
|
||||
let days = days +. 1. in
|
||||
if days > max_int_float then None else
|
||||
Some (int_of_float days, 0L)
|
||||
else
|
||||
let frac_s, rem_s = modf rem_s in
|
||||
let rem_ps = Int64.(mul (of_float rem_s) ps_count_in_s) in
|
||||
let frac_ps = Int64.(of_float (frac_s *. 1e12)) in
|
||||
Some (int_of_float days, (Int64.add rem_ps frac_ps))
|
||||
|
||||
let to_float_s (d, ps) =
|
||||
let days_s = (float d) *. 86_400. in
|
||||
let day_s = Int64.(to_float (div ps ps_count_in_s)) in
|
||||
let day_rem_ps = Int64.(to_float (rem ps ps_count_in_s)) in
|
||||
days_s +. day_s +. (day_rem_ps *. 1e-12)
|
||||
|
||||
(* Predicates *)
|
||||
|
||||
let equal (d0, ps0) (d1, ps1) =
|
||||
(compare : int -> int -> int) d0 d1 = 0 &&
|
||||
Int64.compare ps0 ps1 = 0
|
||||
|
||||
let compare (d0, ps0) (d1, ps1) =
|
||||
let c = (compare : int -> int -> int) d0 d1 in
|
||||
if c <> 0 then c else (compare : int64 -> int64 -> int) ps0 ps1
|
||||
|
||||
(* Rounding *)
|
||||
|
||||
let round_div a b = (* a >= 0 and b > 0 *)
|
||||
if a = 0L then 0L else
|
||||
Int64.(div (add a (div b 2L)) b)
|
||||
|
||||
let frac_div = [| 1_000_000_000_000L;
|
||||
100_000_000_000L;
|
||||
10_000_000_000L;
|
||||
1_000_000_000L;
|
||||
100_000_000L;
|
||||
10_000_000L;
|
||||
1_000_000L;
|
||||
100_000L;
|
||||
10_000L;
|
||||
1_000L;
|
||||
100L;
|
||||
10L;
|
||||
1L; |]
|
||||
|
||||
let round ~frac_s:frac (sign, _ as t) =
|
||||
let frac = if frac < 0 then 0 else (if frac > 12 then 12 else frac) in
|
||||
let (d, ps) = if sign < 0 then neg t else t in
|
||||
let rps = Int64.mul (round_div ps frac_div.(frac)) frac_div.(frac) in
|
||||
let t = if rps > ps_day_max then (d + 1, 0L) else (d, rps) in
|
||||
if sign < 0 then neg t else t
|
||||
|
||||
let truncate ~frac_s:frac (sign, _ as t) =
|
||||
let frac = if frac < 0 then 0 else (if frac > 12 then 12 else frac) in
|
||||
let (d, ps) = if sign < 0 then neg t else t in
|
||||
let tps = Int64.(sub ps (rem ps frac_div.(frac))) in
|
||||
if sign < 0 then neg (d, tps) else (d, tps)
|
||||
|
||||
let truncate_down ~frac_s:frac (d, ps) =
|
||||
(d, Int64.(sub ps (rem ps frac_div.(frac ))))
|
||||
|
||||
(* Pretty printing *)
|
||||
|
||||
let dump ppf (d, ps) = Format.fprintf ppf "@[<1>(%d,@,%Ld)@]" d ps
|
||||
|
||||
(* Warning laborious code follows. Is there a better way ? *)
|
||||
|
||||
let divide_ps ~carry ps hi lo =
|
||||
let hi_d = Int64.(to_int (div ps hi)) in
|
||||
let rem_ps = Int64.rem ps hi in
|
||||
let lo_d = Int64.to_int (round_div rem_ps lo) in
|
||||
if lo_d = carry then hi_d + 1, 0 else hi_d, lo_d
|
||||
|
||||
let pp_y_d ppf ~neg d ps = (* assert d >= 0 *)
|
||||
let y, rem_d =
|
||||
let max_d = max_int / 4 in
|
||||
if d > max_d then (* d * 4 overflows *) d / 365, d mod 365 else
|
||||
let y = (d * 4) / 1461 (* / 365.25 *) in
|
||||
y, d - (y * 1461) / 4
|
||||
in
|
||||
let days = rem_d + Int64.to_int (round_div ps ps_count_in_day) in
|
||||
let y, days = if days = 366 then y + 1, 1 else y, days in
|
||||
let y = if neg then -y else y in
|
||||
Format.fprintf ppf "%dy" y;
|
||||
if days <> 0 then Format.fprintf ppf "%dd" days;
|
||||
()
|
||||
|
||||
let pp_d_h ppf ~neg d ps =
|
||||
let h, _ = divide_ps ~carry:1 ps ps_count_in_hour ps_count_in_hour in
|
||||
let d, h = if h = 24 then d + 1, 0 else d, h in
|
||||
if d = 366 then Format.fprintf ppf "%dy1d" (if neg then -1 else 1) else
|
||||
if d = 365 && h >= 6
|
||||
then Format.fprintf ppf "%dy" (if neg then -1 else 1) else
|
||||
let d = if neg then -d else d in
|
||||
Format.fprintf ppf "%dd" d;
|
||||
if h <> 0 then Format.fprintf ppf "%dh" h;
|
||||
()
|
||||
|
||||
let pp_h_m ppf ~neg ps =
|
||||
let h, m = divide_ps ~carry:60 ps ps_count_in_hour ps_count_in_min in
|
||||
if h = 24 then Format.fprintf ppf "%dd" (if neg then -1 else 1) else
|
||||
let h = if neg then -h else h in
|
||||
Format.fprintf ppf "%dh" h;
|
||||
if m <> 0 then Format.fprintf ppf "%dmin" m;
|
||||
()
|
||||
|
||||
let pp_m_s ppf ~neg ps =
|
||||
let m, s = divide_ps ~carry:60 ps ps_count_in_min ps_count_in_s in
|
||||
if m = 60 then Format.fprintf ppf "%dh" (if neg then -1 else 1) else
|
||||
let m = if neg then -m else m in
|
||||
Format.fprintf ppf "%dmin" m;
|
||||
if s <> 0 then Format.fprintf ppf "%ds" s;
|
||||
()
|
||||
|
||||
let pp_s ppf ~neg ps =
|
||||
let s, ms = divide_ps ~carry:1000 ps ps_count_in_s ps_count_in_ms in
|
||||
if s = 60 then Format.fprintf ppf "%dmin" (if neg then -1 else 1) else
|
||||
let s = if neg then -s else s in
|
||||
if ms <> 0 then Format.fprintf ppf "%d.%03ds" s ms else
|
||||
Format.fprintf ppf "%ds" s
|
||||
|
||||
let pp_unit higher_str hi hi_str frac_limit lo ppf ~neg ps =
|
||||
let pp_unit_integral ppf ~neg h =
|
||||
if h = 1000
|
||||
then Format.fprintf ppf "%d%s" (if neg then -1 else 1) higher_str
|
||||
else Format.fprintf ppf "%d%s" (if neg then -h else h) hi_str
|
||||
in
|
||||
if ps < frac_limit then begin
|
||||
let h, l = divide_ps ~carry:1000 ps hi lo in
|
||||
if h >= 100 || l = 0 then pp_unit_integral ppf ~neg h else
|
||||
let h = if neg then -h else h in
|
||||
Format.fprintf ppf "%d.%03d%s" h l hi_str
|
||||
end else begin
|
||||
let ms, _ = divide_ps ~carry:1 ps hi hi in
|
||||
pp_unit_integral ppf ~neg ms
|
||||
end
|
||||
|
||||
let pp_ms =
|
||||
pp_unit "s" ps_count_in_ms "ms" ps_count_in_100ms ps_count_in_us
|
||||
|
||||
let pp_us =
|
||||
pp_unit "ms" ps_count_in_us "us" ps_count_in_100us ps_count_in_ns
|
||||
|
||||
let pp_ns =
|
||||
pp_unit "us" ps_count_in_ns "ns" ps_count_in_100ns ps_count_in_ps
|
||||
|
||||
let pp_ps ppf ~neg ps =
|
||||
let ps = Int64.to_int ps in
|
||||
Format.fprintf ppf "%dps" (if neg then -ps else ps)
|
||||
|
||||
let pp ppf (sign, _ as s) =
|
||||
let neg = sign < 0 in
|
||||
match (abs s) with
|
||||
| (0, ps) ->
|
||||
if ps >= ps_count_in_hour then pp_h_m ppf ~neg ps else
|
||||
if ps >= ps_count_in_min then pp_m_s ppf ~neg ps else
|
||||
if ps >= ps_count_in_s then pp_s ppf ~neg ps else
|
||||
if ps >= ps_count_in_ms then pp_ms ppf ~neg ps else
|
||||
if ps >= ps_count_in_us then pp_us ppf ~neg ps else
|
||||
if ps >= ps_count_in_ns then pp_ns ppf ~neg ps else
|
||||
pp_ps ppf ~neg ps
|
||||
| (d, ps) ->
|
||||
if d > 365 then pp_y_d ppf ~neg d ps else
|
||||
pp_d_h ppf ~neg d ps
|
||||
end
|
||||
|
||||
(* POSIX timestamps *)
|
||||
|
||||
let v (d, ps as s) =
|
||||
if (ps < 0L || ps > ps_day_max || d < day_min || d > day_max)
|
||||
then invalid_arg (Format.sprintf "illegal ptime timestamp: (%d,%Ld)" d ps)
|
||||
else s
|
||||
|
||||
let unsafe_of_d_ps s = s
|
||||
|
||||
let of_span (d, _ as span) =
|
||||
if d < day_min || d > day_max then None else Some span
|
||||
|
||||
let to_span t = t
|
||||
|
||||
let of_float_s secs = match Span.of_float_s secs with
|
||||
| None -> None
|
||||
| Some d -> of_span d
|
||||
|
||||
let to_float_s = Span.to_float_s
|
||||
|
||||
let truncate = Span.truncate_down
|
||||
|
||||
let frac_s (_, ps) = (0, Int64.(rem ps ps_count_in_s))
|
||||
|
||||
(* Predicates *)
|
||||
|
||||
let equal = Span.equal
|
||||
let compare = Span.compare
|
||||
let is_earlier t ~than = compare t than = -1
|
||||
let is_later t ~than = compare t than = 1
|
||||
|
||||
(* POSIX arithmetic *)
|
||||
|
||||
let add_span t d = of_span (Span.add t d)
|
||||
let sub_span t d = of_span (Span.sub t d)
|
||||
let diff t1 t0 = Span.sub t1 t0
|
||||
|
||||
(* Time zone offsets between local and UTC timelines *)
|
||||
|
||||
type tz_offset_s = int
|
||||
|
||||
(* Date-time conversion
|
||||
|
||||
POSIX time counts seconds since 1970-01-01 00:00:00 UTC without
|
||||
counting leap seconds -- when a leap second occurs a POSIX second
|
||||
can be two SI seconds or zero SI second. Hence 86400 POSIX seconds
|
||||
always represent an UTC day and the translations below are accurate
|
||||
without having to refer to a leap seconds table. *)
|
||||
|
||||
type date = (int * int * int)
|
||||
type time = (int * int * int) * tz_offset_s
|
||||
|
||||
let max_month_day = (* max day number in a given year's month. *)
|
||||
let is_leap_year y = (y mod 4 = 0) && (y mod 100 <> 0 || y mod 400 = 0) in
|
||||
let mlen = [|31; 28 (* or not *); 31; 30; 31; 30; 31; 31; 30; 31; 30; 31|] in
|
||||
fun y m -> if (m = 2 && is_leap_year y) then 29 else mlen.(m - 1)
|
||||
|
||||
let is_date_valid (y, m, d) =
|
||||
0 <= y && y <= 9999 &&
|
||||
1 <= m && m <= 12 &&
|
||||
1 <= d && d <= max_month_day y m
|
||||
|
||||
let is_time_valid ((hh, mm, ss), _) =
|
||||
0 <= hh && hh <= 23 &&
|
||||
0 <= mm && mm <= 59 &&
|
||||
0 <= ss && ss <= 60
|
||||
|
||||
let of_date_time (date, ((hh, mm, ss), tz_offset_s as t)) =
|
||||
(* We first verify that the given date and time are Ptime-valid.
|
||||
Once this has been established we find find the number of Julian
|
||||
days since the epoch for the given proleptic Georgian calendar
|
||||
date. This gives us the POSIX day component of the timestamp. The
|
||||
remaining time fields are used to derive the picosecond precision
|
||||
time in that day compensated by the time zone offset. The final
|
||||
result is checked to be in Ptime's [min;max] range.
|
||||
|
||||
By definition POSIX timestamps cannot represent leap seconds.
|
||||
With the code below any date-time with a seconds value of 60
|
||||
(leap second addition) is mapped to the POSIX timestamp that
|
||||
happens 1 second later which is what POSIX mktime would to. Any
|
||||
formally non-existing UTC date-time with a seconds value of 59
|
||||
(leap second subtraction) is mapped on the POSIX timestamp that
|
||||
represents this non existing instant. *)
|
||||
if not (is_date_valid date && is_time_valid t) then None else
|
||||
let d = jd_of_date date - jd_posix_epoch in
|
||||
let hh_ps = Int64.(mul (of_int hh) ps_count_in_hour) in
|
||||
let mm_ps = Int64.(mul (of_int mm) ps_count_in_min) in
|
||||
let ss_ps = Int64.(mul (of_int ss) ps_count_in_s) in
|
||||
let ps = Int64.(add hh_ps (add mm_ps ss_ps)) in
|
||||
sub_span (d, ps) (Span.of_int_s tz_offset_s)
|
||||
|
||||
let to_date_time ?(tz_offset_s = 0) t =
|
||||
(* To render the timestamp in the given time zone offset we first
|
||||
express the timestamp in local time and then compute the date
|
||||
fields on that stamp as if it were UTC. If the local timestamp is
|
||||
not in [min;max] then its date fields cannot be valid according
|
||||
to the constraints guaranteed by Ptime and we fallback to UTC,
|
||||
i.e. a time zone offset of 0.
|
||||
|
||||
We then apply the following algorithm whose description makes
|
||||
sense on a POSIX timestamp (i.e. UTC) but works equally well to
|
||||
render the date-time fields of a local timestamp.
|
||||
|
||||
We first take take the POSIX day count [d] (equivalent by
|
||||
definition to an UTC day count) from the epoch, convert it to a
|
||||
Julian day and use this to get the proleptic Gregorian calendar
|
||||
date. The POSIX picoseconds [ps] in the day are are converted to
|
||||
a daytime according to to its various units.
|
||||
|
||||
By definition no POSIX timestamp can represent a date-time with a
|
||||
seconds value of 60 (leap second addition) and thus the function
|
||||
will never return a date-time with such a value. On the other
|
||||
hand it will return an inexisting UTC date-time with a seconds
|
||||
value of 59 whenever a leap second is subtracted since there is a
|
||||
POSIX timestamp that represents this instant. *)
|
||||
let (d, ps), tz_offset_s = match add_span t (Span.of_int_s tz_offset_s) with
|
||||
| None -> t, 0 (* fallback to UTC *)
|
||||
| Some local -> local, tz_offset_s
|
||||
in
|
||||
let jd = d + jd_posix_epoch in
|
||||
let date = jd_to_date jd in
|
||||
let hh = Int64.(to_int (div ps ps_count_in_hour)) in
|
||||
let hh_rem = Int64.rem ps ps_count_in_hour in
|
||||
let mm = Int64.(to_int (div hh_rem ps_count_in_min)) in
|
||||
let mm_rem = Int64.rem hh_rem ps_count_in_min in
|
||||
let ss = Int64.(to_int (div mm_rem ps_count_in_s)) in
|
||||
date, ((hh, mm, ss), tz_offset_s)
|
||||
|
||||
let of_date ?tz_offset_s:(tz = 0) date = of_date_time (date, ((00, 00, 00), tz))
|
||||
let to_date ?tz_offset_s t = fst (to_date_time ?tz_offset_s t)
|
||||
let of_year ?tz_offset_s y = of_date ?tz_offset_s (y, 01, 01)
|
||||
let to_year ?(tz_offset_s = 0) t =
|
||||
let d = match add_span t (Span.of_int_s tz_offset_s) with
|
||||
| None -> fst t (* fallback to UTC *) | Some (local_d, _) -> local_d
|
||||
in
|
||||
jd_to_year (d + jd_posix_epoch)
|
||||
|
||||
|
||||
type weekday = [ `Sun | `Mon | `Tue | `Wed | `Thu | `Fri | `Sat ]
|
||||
|
||||
let weekday_num ?(tz_offset_s = 0) t =
|
||||
let (d, _) = Span.add t (Span.of_int_s tz_offset_s) in
|
||||
(* N.B. in contrast to [to_date_time] we don't care if we fall outside
|
||||
[min;max]. Even if it happens the result of the computation is still
|
||||
correct *)
|
||||
let i = (d + 4 (* Epoch, d = 0, was a thu, we want 4 for that day *)) mod 7 in
|
||||
if i < 0 then 7 + i else i
|
||||
|
||||
let weekday =
|
||||
let wday = [| `Sun; `Mon; `Tue; `Wed; `Thu; `Fri; `Sat; |] in
|
||||
fun ?tz_offset_s t -> wday.(weekday_num ?tz_offset_s t)
|
||||
|
||||
(* RFC 3339 timestamp conversions *)
|
||||
|
||||
(* RFC 3339 timestamp parser *)
|
||||
|
||||
type error_range = int * int
|
||||
type rfc3339_error =
|
||||
[ `Invalid_stamp | `Eoi | `Exp_chars of char list | `Trailing_input ]
|
||||
|
||||
let pp_rfc3339_error ppf = function
|
||||
| `Invalid_stamp -> Format.fprintf ppf "@[invalid@ time@ stamp@]"
|
||||
| `Eoi -> Format.fprintf ppf "@[unexpected@ end@ of@ input@]"
|
||||
| `Trailing_input -> Format.fprintf ppf "@[trailing@ input@]"
|
||||
| `Exp_chars cs ->
|
||||
let rec pp_chars ppf = function
|
||||
| c :: cs -> Format.fprintf ppf "@ %C" c; pp_chars ppf cs
|
||||
| [] -> ()
|
||||
in
|
||||
Format.fprintf ppf "@[expected@ a@ character@ in:%a@]" pp_chars cs
|
||||
|
||||
let pp_range ppf (s, e) =
|
||||
if s = e then Format.pp_print_int ppf s else Format.fprintf ppf "%d-%d" s e
|
||||
|
||||
let _rfc3339_error_to_string (r, err) =
|
||||
Format.asprintf "@[<h>%a: %a@]" pp_range r pp_rfc3339_error err
|
||||
|
||||
let rfc3339_string_error = function
|
||||
| Ok _ as v -> v | Error (`RFC3339 e) -> Error (_rfc3339_error_to_string e)
|
||||
|
||||
let rfc3339_error_to_msg = function
|
||||
| Ok _ as v -> v | Error (`RFC3339 e) ->
|
||||
Error (`Msg (_rfc3339_error_to_string e))
|
||||
|
||||
exception RFC3339 of (int * int) * rfc3339_error (* Internal *)
|
||||
|
||||
let error r e = raise (RFC3339 (r, e))
|
||||
let error_pos p e = error (p, p) e
|
||||
let error_exp_digit p =
|
||||
error_pos p (`Exp_chars ['0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'])
|
||||
|
||||
let is_digit = function '0' .. '9' -> true | _ -> false
|
||||
|
||||
let parse_digits ~count pos max s =
|
||||
let stop = pos + count - 1 in
|
||||
if stop > max then error_pos max `Eoi else
|
||||
let rec loop k acc =
|
||||
if k > stop then acc else
|
||||
if is_digit s.[k] then loop (k+1) (acc * 10 + Char.code s.[k] - 0x30) else
|
||||
error_exp_digit k
|
||||
in
|
||||
loop pos 0
|
||||
|
||||
let parse_char c pos max s =
|
||||
if pos > max then error_pos max `Eoi else
|
||||
if s.[pos] = c then () else error_pos pos (`Exp_chars [c])
|
||||
|
||||
let parse_dt_sep ~strict pos max s =
|
||||
let is_dt_sep = function
|
||||
| 'T' -> true
|
||||
| 't' | ' ' when not strict -> true
|
||||
| _ -> false
|
||||
in
|
||||
if pos > max then error_pos max `Eoi else
|
||||
if is_dt_sep s.[pos] then () else
|
||||
error_pos pos (`Exp_chars (['T'] @ if strict then [] else ['t'; ' ']))
|
||||
|
||||
let decide_frac_or_tz ~strict pos max s =
|
||||
if pos > max then error_pos max `Eoi else
|
||||
match s.[pos] with
|
||||
| '.' -> `Frac
|
||||
| '+' | '-' | 'Z' -> `Tz
|
||||
| 'z' when not strict -> `Tz
|
||||
| c ->
|
||||
let chars = ['.'; '+'; '-'; 'Z'] @ if strict then [] else ['z'] in
|
||||
error_pos pos (`Exp_chars chars)
|
||||
|
||||
let parse_frac_ps pos max s =
|
||||
if pos > max then error_pos max `Eoi else
|
||||
if not (is_digit s.[pos]) then error_exp_digit pos else
|
||||
let rec loop k acc pow =
|
||||
if k > max then error_pos max `Eoi else
|
||||
if not (is_digit s.[k]) then (Some acc), k else
|
||||
let count = k - pos + 1 in
|
||||
if count > 12 then (* truncate *) loop (k + 1) acc pow else
|
||||
let pow = Int64.div pow 10L in
|
||||
let acc = Int64.(add acc (mul (of_int (Char.code s.[k] - 0x30)) pow)) in
|
||||
loop (k + 1) acc pow
|
||||
in
|
||||
loop pos 0L ps_count_in_s
|
||||
|
||||
let parse_tz_s ~strict pos max s =
|
||||
let parse_tz_mag sign pos =
|
||||
let hh_pos = pos in
|
||||
let hh = parse_digits ~count:2 hh_pos max s in
|
||||
let mm, mm_pos = match strict with
|
||||
| true ->
|
||||
let mm_pos = hh_pos + 3 in
|
||||
parse_char ':' (mm_pos - 1) max s;
|
||||
parse_digits ~count:2 mm_pos max s, mm_pos
|
||||
| false ->
|
||||
let next = hh_pos + 2 in
|
||||
if next > max || not (s.[next] = ':' || is_digit s.[next])
|
||||
then (0, hh_pos (* end pos of parse - 1, one is added at the end *))
|
||||
else
|
||||
let mm_pos = if s.[next] = ':' then hh_pos + 3 else hh_pos + 2 in
|
||||
parse_digits ~count:2 mm_pos max s, mm_pos
|
||||
in
|
||||
if hh > 23 then error (hh_pos, hh_pos + 1) `Invalid_stamp else
|
||||
if mm > 59 then error (mm_pos, mm_pos + 1) `Invalid_stamp else
|
||||
let secs = hh * 3600 + mm * 60 in
|
||||
let tz_s = match secs = 0 && sign = -1 with
|
||||
| true -> None (* -00:00 convention *)
|
||||
| false -> Some (sign * secs)
|
||||
in
|
||||
tz_s, mm_pos + 1
|
||||
in
|
||||
if pos > max then error_pos max `Eoi else
|
||||
match s.[pos] with
|
||||
| 'Z' -> Some 0, pos
|
||||
| 'z' when not strict -> Some 0, pos
|
||||
| '+' -> parse_tz_mag ( 1) (pos + 1)
|
||||
| '-' -> parse_tz_mag (-1) (pos + 1)
|
||||
| c ->
|
||||
let chars = ['+'; '-'; 'Z'] @ if strict then [] else ['z'] in
|
||||
error_pos pos (`Exp_chars chars)
|
||||
|
||||
let of_rfc3339 ?(strict = false) ?(sub = false) ?(start = 0) s =
|
||||
try
|
||||
let s_len = String.length s in
|
||||
let max = s_len - 1 in
|
||||
if s_len = 0 || start < 0 || start > max then error_pos start `Eoi else
|
||||
let y_pos = start in
|
||||
let m_pos = y_pos + 5 in
|
||||
let d_pos = m_pos + 3 in
|
||||
let hh_pos = d_pos + 3 in
|
||||
let mm_pos = hh_pos + 3 in
|
||||
let ss_pos = mm_pos + 3 in
|
||||
let decide_pos = ss_pos + 2 in
|
||||
let y = parse_digits ~count:4 y_pos max s in
|
||||
parse_char '-' (m_pos - 1) max s;
|
||||
let m = parse_digits ~count:2 m_pos max s in
|
||||
parse_char '-' (d_pos - 1) max s;
|
||||
let d = parse_digits ~count:2 d_pos max s in
|
||||
parse_dt_sep ~strict (hh_pos - 1) max s;
|
||||
let hh = parse_digits ~count:2 hh_pos max s in
|
||||
parse_char ':' (mm_pos - 1) max s;
|
||||
let mm = parse_digits ~count:2 mm_pos max s in
|
||||
parse_char ':' (ss_pos - 1) max s;
|
||||
let ss = parse_digits ~count:2 ss_pos max s in
|
||||
let frac, tz_pos = match decide_frac_or_tz ~strict decide_pos max s with
|
||||
| `Frac -> parse_frac_ps (decide_pos + 1) max s
|
||||
| `Tz -> None, decide_pos
|
||||
in
|
||||
let tz_s_opt, last_pos = parse_tz_s ~strict tz_pos max s in
|
||||
let tz_s = match tz_s_opt with None -> 0 | Some s -> s in
|
||||
match of_date_time ((y, m, d), ((hh, mm, ss), tz_s)) with
|
||||
| None -> error (start, last_pos) `Invalid_stamp
|
||||
| Some t ->
|
||||
let t, tz_s = match frac with
|
||||
| None | Some 0L -> t, tz_s
|
||||
| Some frac ->
|
||||
match add_span t (0, frac) with
|
||||
| None -> error (start, last_pos) `Invalid_stamp
|
||||
| Some t -> t, tz_s
|
||||
in
|
||||
if not sub && last_pos <> max
|
||||
then error_pos (last_pos + 1) `Trailing_input
|
||||
else Ok (t, tz_s_opt, last_pos - start + 1)
|
||||
with RFC3339 (r, e) -> Error (`RFC3339 (r, e))
|
||||
|
||||
(* RFC 3339 timestamp formatter *)
|
||||
|
||||
let rfc3339_adjust_tz_offset tz_offset_s =
|
||||
(* The RFC 3339 time zone offset field is limited in expression to
|
||||
the bounds below with minute precision. If the requested time
|
||||
zone offset exceeds these bounds or is not an *integral* number
|
||||
of minutes we simply use UTC. An alternative would be to
|
||||
compensate the offset *and* the timestamp but it's more
|
||||
complicated to explain and maybe more surprising to the user. *)
|
||||
let min = -86340 (* -23h59 in secs *) in
|
||||
let max = +86340 (* +23h59 in secs *) in
|
||||
if min <= tz_offset_s && tz_offset_s <= max && tz_offset_s mod 60 = 0
|
||||
then tz_offset_s, false
|
||||
else 0 (* UTC *), true
|
||||
|
||||
let s_frac_of_ps frac ps =
|
||||
Int64.(div (rem ps ps_count_in_s) Span.frac_div.(frac))
|
||||
|
||||
let to_rfc3339 ?(space = false) ?frac_s:(frac = 0) ?tz_offset_s (_, ps as t) =
|
||||
let buf = Buffer.create 255 in
|
||||
let tz_offset_s, tz_unknown = match tz_offset_s with
|
||||
| Some tz -> rfc3339_adjust_tz_offset tz
|
||||
| None -> 0, true
|
||||
in
|
||||
let (y, m, d), ((hh, ss, mm), tz_offset_s) = to_date_time ~tz_offset_s t in
|
||||
let dt_sep = if space then ' ' else 'T' in
|
||||
Printf.bprintf buf "%04d-%02d-%02d%c%02d:%02d:%02d" y m d dt_sep hh ss mm;
|
||||
let frac = if frac < 0 then 0 else (if frac > 12 then 12 else frac) in
|
||||
if frac <> 0 then Printf.bprintf buf ".%0*Ld" frac (s_frac_of_ps frac ps);
|
||||
if tz_offset_s = 0 && not tz_unknown then Printf.bprintf buf "Z" else
|
||||
begin
|
||||
let tz_sign = if tz_offset_s < 0 || tz_unknown then '-' else '+' in
|
||||
let tz_min = abs (tz_offset_s / 60) in
|
||||
let tz_hh = tz_min / 60 in
|
||||
let tz_mm = tz_min mod 60 in
|
||||
Printf.bprintf buf "%c%02d:%02d" tz_sign tz_hh tz_mm;
|
||||
end;
|
||||
Buffer.contents buf
|
||||
|
||||
let pp_rfc3339 ?space ?frac_s ?tz_offset_s () ppf t =
|
||||
Format.fprintf ppf "%s" (to_rfc3339 ?space ?frac_s ?tz_offset_s t)
|
||||
|
||||
(* Pretty printing *)
|
||||
|
||||
let pp_human ?frac_s:(frac = 0) ?tz_offset_s () ppf (_, ps as t) =
|
||||
let tz_offset_s, tz_unknown = match tz_offset_s with
|
||||
| Some tz -> rfc3339_adjust_tz_offset tz
|
||||
| None -> 0, true
|
||||
in
|
||||
let (y, m, d), ((hh, ss, mm), tz_offset_s) = to_date_time ~tz_offset_s t in
|
||||
Format.fprintf ppf "%04d-%02d-%02d %02d:%02d:%02d" y m d hh ss mm;
|
||||
let frac = if frac < 0 then 0 else (if frac > 12 then 12 else frac) in
|
||||
if frac <> 0 then Format.fprintf ppf ".%0*Ld" frac (s_frac_of_ps frac ps);
|
||||
let tz_sign = if tz_offset_s < 0 || tz_unknown then '-' else '+' in
|
||||
let tz_min = abs (tz_offset_s / 60) in
|
||||
let tz_hh = tz_min / 60 in
|
||||
let tz_mm = tz_min mod 60 in
|
||||
Format.fprintf ppf " %c%02d:%02d" tz_sign tz_hh tz_mm;
|
||||
()
|
||||
|
||||
let pp = pp_human ~tz_offset_s:0 ()
|
||||
let dump = Span.dump
|
||||
612
unikernel/duniverse/ptime/src/ptime.mli
Normal file
612
unikernel/duniverse/ptime/src/ptime.mli
Normal file
|
|
@ -0,0 +1,612 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(** POSIX time values.
|
||||
|
||||
Consult the {{!basics}basics} and a few {{!notes}notes
|
||||
and limitations}.
|
||||
|
||||
{b References}
|
||||
{ul
|
||||
{- 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}
|
||||
{- G. Klyne et al.
|
||||
{{:http://tools.ietf.org/html/rfc3339}
|
||||
{e Date and Time on the Internet: Timestamps}}. RFC 3339, 2002.}} *)
|
||||
|
||||
(** {1:timespans POSIX time spans} *)
|
||||
|
||||
type span
|
||||
(** The type for signed picosecond precision POSIX time spans. A value
|
||||
of this type represent the POSIX duration between two POSIX
|
||||
timestamps. *)
|
||||
|
||||
(** POSIX time spans.
|
||||
|
||||
{b WARNING.} A POSIX time span is not equal to an SI second based time
|
||||
span see the {{!basics}basics}. *)
|
||||
module Span : sig
|
||||
|
||||
(** {1:spans POSIX time spans} *)
|
||||
|
||||
type t = span
|
||||
(** The type for signed, picosecond precision, POSIX time spans. *)
|
||||
|
||||
val v : int * int64 -> span
|
||||
(** [v s] is like {!of_d_ps}[ s] but raises [Invalid_argument] if
|
||||
[s] is not in the right range. Use {!of_d_ps} to deal with
|
||||
untrusted input. *)
|
||||
|
||||
val zero : span
|
||||
(** [zero] is the neutral element of {!add}. *)
|
||||
|
||||
val of_d_ps : int * int64 -> span option
|
||||
(** [of_d_ps (d, ps)] is a span for the signed POSIX picosecond
|
||||
span [d] * 86_400e12 + [ps]. [d] is a signed number of POSIX
|
||||
days and [ps] a number of picoseconds in the range
|
||||
\[[0];[86_399_999_999_999_999L]\]. [None] is returned if
|
||||
[ps] is not in the right range. *)
|
||||
|
||||
(**/**)
|
||||
val unsafe_of_d_ps : int * int64 -> span
|
||||
val unsafe_of_d_ps_option : (int * int64) option -> span option
|
||||
(**/**)
|
||||
|
||||
val to_d_ps : span -> int * int64
|
||||
(** [to_d_ps d] is the span [d] as a pair [(d, ps)] expressing the
|
||||
POSIX picosecond span [d] * 86_400e12 + [ps] with
|
||||
[ps] in the range \[[0];[86_399_999_999_999_999L]\] *)
|
||||
|
||||
val of_int_s : int -> span
|
||||
(** [of_int_s secs] is a span from the signed integer POSIX second
|
||||
span [secs]. *)
|
||||
|
||||
val to_int_s : span -> int option
|
||||
(** [to_int_s d] is the span [d] as a signed integer POSIX second
|
||||
span, if [int]'s range can represent it (note that this
|
||||
depends on {!Sys.word_size}). Subsecond precision numbers are
|
||||
truncated. *)
|
||||
|
||||
val of_float_s : float -> span option
|
||||
(** [of_float_s secs] is a span from the signed floating point POSIX
|
||||
second span [d]. Subpicosecond precision numbers are truncated.
|
||||
|
||||
[None] is returned if [secs] cannot be represented as a span.
|
||||
This occurs on {!Stdlib.nan} or if the duration in POSIX
|
||||
days cannot fit on an [int] (on 32-bit platforms this means the
|
||||
absolute magnitude of the duration is greater than ~2'941'758
|
||||
years). *)
|
||||
|
||||
val to_float_s : span -> float
|
||||
(** [to_float_s s] is the span [d] as floating point POSIX seconds.
|
||||
|
||||
{b Warning.} The magnitude of [s] may not be represented exactly
|
||||
by the floating point value. *)
|
||||
|
||||
(** {1:predicates Predicates} *)
|
||||
|
||||
val equal : span -> span -> bool
|
||||
(** [equal d d'] is [true] iff [d] and [d'] are the same time span. *)
|
||||
|
||||
val compare : span -> span -> int
|
||||
(** [compare d d'] is a total order on durations that is compatible
|
||||
with signed time span order. *)
|
||||
|
||||
(** {1:arith Arithmetic}
|
||||
|
||||
{b Note.} The following functions rollover on overflows. *)
|
||||
|
||||
val neg : span -> span
|
||||
(** [neg d] is the span [d] negated. *)
|
||||
|
||||
val add : span -> span -> span
|
||||
(** [add d d'] is [d] + [d']. *)
|
||||
|
||||
val sub : span -> span -> span
|
||||
(** [sub d d'] is [d] - [d']. *)
|
||||
|
||||
val abs : span -> span
|
||||
(** [abs d] is the absolute value of span [d]. *)
|
||||
|
||||
(** {1:rounding Rounding} *)
|
||||
|
||||
val round : frac_s:int -> span -> span
|
||||
(** [round ~frac_s t] is [t] rounded to the [frac_s] decimal
|
||||
fractional second. Ties are rounded away from zero. [frac_s] is
|
||||
clipped to the range \[[0];[12]\]. *)
|
||||
|
||||
val truncate : frac_s:int -> span -> span
|
||||
(** [truncate ~frac_s t] is [t] truncated to the [frac_s] decimal
|
||||
fractional second. [frac_s] is clipped to the range
|
||||
\[[0];[12]\]. *)
|
||||
|
||||
(** {1:print Pretty printing} *)
|
||||
|
||||
val pp : Format.formatter -> span -> unit
|
||||
(** [pp ppf d] prints an unspecified, approximative, representation of [d]
|
||||
on [ppf].
|
||||
|
||||
The representation is not fixed-width, depends on the magnitude of [d]
|
||||
and uses locale independent
|
||||
{{:http://www.bipm.org/en/publications/si-brochure/chapter3.html}SI
|
||||
prefixes} on seconds and
|
||||
{{:http://www.bipm.org/en/publications/si-brochure/table6.html}accepted
|
||||
non-SI units}. Years are counted in Julian years (365.25
|
||||
SI-accepted days) as
|
||||
{{:http://www.iau.org/publications/proceedings_rules/units/}defined}
|
||||
by the International Astronomical Union (IUA).
|
||||
|
||||
The representation is approximative. In particular beyond 60
|
||||
seconds it only keeps the two most significant time units and
|
||||
rounds towards the infinity. The latter means that case arising,
|
||||
it always {e over} approximates durations.
|
||||
|
||||
{b Warning} Becomes unprecise (but does not overflow) if the
|
||||
absolute number of POSIX days in the time span is greater than [max_int /
|
||||
4] (on 32-bit platforms this is ~735'439 years) *)
|
||||
|
||||
val dump : Format.formatter -> span -> unit
|
||||
(** [dump ppf s] prints an unspecified raw representation of [d]
|
||||
on [ppf]. *)
|
||||
end
|
||||
|
||||
(** {1:timestamps POSIX timestamps} *)
|
||||
|
||||
type t
|
||||
(** The type for picosecond precision POSIX timestamps in the range
|
||||
\[{!min};{!max}\]. Note that POSIX timestamps, and hence values of
|
||||
this type, are by definition always on the UTC timeline. *)
|
||||
|
||||
val v : int * int64 -> t
|
||||
(** [v s] is [of_span (Span.v s)] but raise [Invalid_argument] if [s]
|
||||
is not in the right range. Use {!Span.of_d_ps} and {!of_span}
|
||||
to deal with untrusted input. *)
|
||||
|
||||
val epoch : t
|
||||
(** [epoch] is 1970-01-01 00:00:00 UTC. *)
|
||||
|
||||
val min : t
|
||||
(** [min] is 0000-01-01 00:00:00 UTC, the earliest timestamp
|
||||
representable by {!Ptime}. *)
|
||||
|
||||
val max : t
|
||||
(** [max] is 9999-12-31 23:59:59.999999999999 UTC, the latest timestamp
|
||||
representable by {!Ptime}. *)
|
||||
|
||||
val of_span : span -> t option
|
||||
(** [of_span d] is the POSIX time stamp that:
|
||||
{ul
|
||||
{- Happens at the POSIX span [d] {e after} {!epoch}
|
||||
if [d] is positive.}
|
||||
{- Happens at the POSIX span [d] {e before} {!epoch}
|
||||
if [d] is negative.}}
|
||||
[None] is returned if the timestamp is not in the range
|
||||
\[{!min};{!max}\]. *)
|
||||
|
||||
val to_span : t -> span
|
||||
(** [to_span t] is the signed POSIX span that happen between [t]
|
||||
and {!epoch}:
|
||||
{ul
|
||||
{- If the number is positive [t] happens {e after} {!epoch}.}
|
||||
{- If the number is negative [t] happens {e before} {!epoch}.}} *)
|
||||
|
||||
(**/**)
|
||||
val unsafe_of_d_ps : int * int64 -> t
|
||||
(**/**)
|
||||
|
||||
val of_float_s : float -> t option
|
||||
(** [of_float_s d] is like {!of_span} but with [d] as a floating point
|
||||
second POSIX span [d]. This function is compatible with the result
|
||||
of {!Unix.gettimeofday}. Decimal fractional seconds beyond [1e-12]
|
||||
are truncated. *)
|
||||
|
||||
val to_float_s : t -> float
|
||||
(** [to_float_s t] is like {!to_span} but returns a floating point second
|
||||
POSIX span.
|
||||
|
||||
{b Warning.} Due to floating point inaccuracies do not expect the
|
||||
function to round trip with {!of_float_s}; especially near
|
||||
{!Ptime.min} and {!Ptime.max}. *)
|
||||
|
||||
val truncate : frac_s:int -> t -> t
|
||||
(** [truncate ~frac_s t] is [t] truncated to the [frac_s] decimal
|
||||
fractional second. Effectively this reduces precision without
|
||||
rounding, the timestamp remains in the second it is in. [frac_s]
|
||||
is clipped to the range \[[0];[12]\]. *)
|
||||
|
||||
val frac_s : t -> span
|
||||
(** [frac_s t] is the (positive) fractional second duration in [t]. *)
|
||||
|
||||
(** {1:predicates Predicates} *)
|
||||
|
||||
val equal : t -> t -> bool
|
||||
(** [equal t t'] is [true] iff [t] and [t'] are the same timestamps. *)
|
||||
|
||||
val compare : t -> t -> int
|
||||
(** [compare t t'] is a total order on timestamps that is compatible
|
||||
with timeline order. *)
|
||||
|
||||
val is_earlier : t -> than:t -> bool
|
||||
(** [is_earlier t ~than] is [true] iff [compare t than = -1]. *)
|
||||
|
||||
val is_later : t -> than:t -> bool
|
||||
(** [is_later t than] is [true] iff [compare t than = 1]. *)
|
||||
|
||||
(** {1:posix_arithmetic POSIX arithmetic}
|
||||
|
||||
{b WARNING.} A POSIX time span is not equal to an SI second based
|
||||
time span, see the {{!basics}basics}. Do not use these functions
|
||||
to perform calendar arithmetic or measure wall-clock durations,
|
||||
you will fail. *)
|
||||
|
||||
val add_span : t -> span -> t option
|
||||
(** [add_span t d] is timestamp [t + d], that is [t] with the signed
|
||||
POSIX span [d] added. [None] is returned if the result is not
|
||||
in the range \[{!min};{!max}\]. *)
|
||||
|
||||
val sub_span : t -> span -> t option
|
||||
(** [sub_span t d] is the timestamp [t - d], that is [t] with the
|
||||
signed POSIX span [d] subtracted. [None] is returned if the result
|
||||
is not in the range \[{!min};{!max}\]. *)
|
||||
|
||||
val diff : t -> t -> span
|
||||
(** [diff t t'] is the signed POSIX span [t - t'] that happens between
|
||||
the timestamps [t] and [t']. *)
|
||||
|
||||
(** {1:tz_offset Time zone offsets between local and UTC timelines} *)
|
||||
|
||||
type tz_offset_s = int
|
||||
(** The type for time zone offsets between local and UTC timelines
|
||||
in seconds. This is the signed difference in seconds between the local
|
||||
timeline and the UTC timeline:
|
||||
{[
|
||||
tz_offset_s = local - UTC
|
||||
]}
|
||||
{ul
|
||||
{- A value of [-3600] means that the local timeline is sixty minutes
|
||||
{e behind} the UTC timeline.}
|
||||
{- A value of [3600] means that the local timeline is sixty
|
||||
minutes {e ahead} the UTC timeline.}} *)
|
||||
|
||||
(** {1:date_time Date-time value conversions}
|
||||
|
||||
A {e date-time} represents a point on the UTC timeline by pairing
|
||||
a date in the proleptic Gregorian calendar and a second precision
|
||||
daytime in a local timeline with stated relationship to the UTC
|
||||
timeline. *)
|
||||
|
||||
type date = int * int * int
|
||||
(** The type for big-endian proleptic Gregorian dates. A triple
|
||||
[(y, m, d)] with:
|
||||
{ul
|
||||
{- [y] the year from [0] to [9999]. [0] denotes -1 BCE
|
||||
(this follows the
|
||||
{{:http://www.iso.org/iso/home/standards/iso8601.htm}ISO 8601}
|
||||
convention).}
|
||||
{- [m] is the month from [1] to [12]}
|
||||
{- [d] is the day from [1] to [28], [29], [30] or [31]
|
||||
depending on [m] and [y]}}
|
||||
|
||||
A date is said to be {e valid} iff the values [(y, m, d)] are
|
||||
in the range mentioned above and represent an existing date in the
|
||||
proleptic Gregorian calendar. *)
|
||||
|
||||
type time = (int * int * int) * tz_offset_s
|
||||
(** The type for daytimes on a local timeline. Pairs a triple [(hh,
|
||||
mm, ss)] denoting the time on the local timeline and a [tz_offset]
|
||||
stating the {{!tz_offset_s}relationship} of the local timeline to
|
||||
the UTC timeline.
|
||||
|
||||
The [(hh, mm, ss)] components are understood and constrainted as
|
||||
follows:
|
||||
{ul
|
||||
{- [hh] is the hour from [0] to [23].}
|
||||
{- [mm] is the minute from [0] to [59].}
|
||||
{- [ss] is the seconds from [0] to [60]. [60] may happen whenever
|
||||
a leap second is added.}}
|
||||
A [time] value is said to be {e valid} iff the values [(hh, mm, ss)]
|
||||
are in the ranges mentioned above. *)
|
||||
|
||||
(** {2:datetimes Date and time} *)
|
||||
|
||||
val of_date_time : date * time -> t option
|
||||
(** [of_date_time dt] is the POSIX timestamp corresponding to
|
||||
date-time [dt] or [None] if [dt] has an {{!date}invalid date},
|
||||
{{!time}invalid time} or the date-time is not in the range
|
||||
\[{!min};{!max}\].
|
||||
|
||||
{b Leap seconds.} Any date-time with a seconds value of [60], hence
|
||||
representing a leap second addition, is mapped to the date-time
|
||||
that happens 1 second later. Any date-time with a seconds value of
|
||||
[59] is mapped to the POSIX timestamp that represents this
|
||||
instant, if a leap second was subtracted at that point, this is
|
||||
the POSIX timestamp that represents this inexisting instant. See
|
||||
the {{!basics}basics}. *)
|
||||
|
||||
val to_date_time : ?tz_offset_s:tz_offset_s -> t -> date * time
|
||||
(** [to_date_time ~tz_offset_s t] is the date-time of the timestamp [t].
|
||||
|
||||
[tz_offset_s] hints the time zone offset used for the resulting
|
||||
daytime component (defaults to [0], i.e. UTC). The offset is not
|
||||
honoured and fallbacks to [0] in case the resulting date-time
|
||||
rendering of the timestamp would yield an {{!date}invalid
|
||||
date}. This means that you should always interpret the resulting
|
||||
time component with the time zone offset it is paired with in the
|
||||
result and not assume it will be the one you gave to the
|
||||
function. Note that for real-world time zone offsets the fallback
|
||||
to [0] will only happen around {!Ptime.min} and {!Ptime.max}.
|
||||
Formally the fallback occurs whenever [add_span t (Span.of_int_s
|
||||
tz_offset_s)] is [None].
|
||||
|
||||
{b Leap seconds.} No POSIX timestamp can represent a date-time
|
||||
with a leap second added, hence this function will never return a
|
||||
date-time with a [60] seconds value. This function does return
|
||||
inexisting UTC date-times with [59] seconds whenever a leap second is
|
||||
subtracted since POSIX timestamps do represent them. See the
|
||||
{{!basics}basics}.
|
||||
|
||||
{b Subsecond precision.} POSIX timestamps with subsecond precision
|
||||
are floored, i.e. the date-time always has the second mentioned in
|
||||
the timestamp. *)
|
||||
|
||||
(** {2:dates Date} *)
|
||||
|
||||
val of_date : ?tz_offset_s:tz_offset_s -> date -> t option
|
||||
(** [of_date d] is
|
||||
[of_date_time (d, ((00, 00, 00), tz_offset_s))]. [tz_offset_s]
|
||||
defaults to 0, i.e. UTC. *)
|
||||
|
||||
val to_date : ?tz_offset_s:tz_offset_s -> t -> date
|
||||
(** [to_date t] is [fst (to_date_time ?tz_offset_s t)]. *)
|
||||
|
||||
(** {2:years Year} *)
|
||||
|
||||
val of_year : ?tz_offset_s:tz_offset_s -> int -> t option
|
||||
(** [of_year y] is [of_date ?tz_offset_s (y, 01, 01)]. *)
|
||||
|
||||
val to_year : ?tz_offset_s:tz_offset_s -> t -> int
|
||||
(** [to_year t] is the first component of [(to_date ?tz_offset_s t))] but
|
||||
more efficient. *)
|
||||
|
||||
(** {2:weekdays Week days} *)
|
||||
|
||||
type weekday = [ `Sun | `Mon | `Tue | `Wed | `Thu | `Fri | `Sat ]
|
||||
(** The type for the days of the 7-day week. *)
|
||||
|
||||
val weekday : ?tz_offset_s:tz_offset_s -> t -> weekday
|
||||
(** [weekday ~tz_offset_s t] is the day in the 7-day week of timestamp [t]
|
||||
expressed in the time zone offset [ts_offset_s] (defaults to [0]). *)
|
||||
|
||||
val weekday_num : ?tz_offset_s:tz_offset_s -> t -> int
|
||||
(** [weekday_num] is like {!weekday} but returns a weekday number, 0
|
||||
is sunday, 1 is monday, …, 6 is saturday etc. *)
|
||||
|
||||
(** {1:rfc3339 RFC 3339 timestamp conversions} *)
|
||||
|
||||
type error_range = int * int
|
||||
(** The type for error ranges, starting and ending position. *)
|
||||
|
||||
type rfc3339_error =
|
||||
[ `Invalid_stamp
|
||||
| `Eoi
|
||||
| `Exp_chars of char list
|
||||
| `Trailing_input ]
|
||||
(** The type for RFC 3339 timestamp parsing errors. [`Invalid_stamp]
|
||||
means that either the time stamp is not in the range
|
||||
\[{!min};{!max}\], or the date is invalid, or one of the fields is
|
||||
not in the right range. *)
|
||||
|
||||
val pp_rfc3339_error : Format.formatter -> rfc3339_error -> unit
|
||||
(** [pp_rfc3339_error ppf e] prints an unspecified representation of
|
||||
[e] on [ppf]. *)
|
||||
|
||||
val rfc3339_error_to_msg : ('a, [`RFC3339 of error_range * rfc3339_error])
|
||||
result -> ('a, [> `Msg of string]) result
|
||||
(** [rfc3339_error_to_msg r] converts RFC 3339 parse errors to error
|
||||
messages. *)
|
||||
|
||||
val rfc3339_string_error :
|
||||
('a, [`RFC3339 of error_range * rfc3339_error]) result -> ('a, string) result
|
||||
(** [rfc3339_string_error r] converts RFC 3339 parse errors errors to
|
||||
string errors. *)
|
||||
|
||||
val of_rfc3339 : ?strict:bool -> ?sub:bool -> ?start:int -> string ->
|
||||
((t * tz_offset_s option * int),
|
||||
[> `RFC3339 of error_range * rfc3339_error]) result
|
||||
(** [of_rfc3339 ~strict ~sub ~start s] parses an RFC 3339
|
||||
{{:https://tools.ietf.org/html/rfc3339#section-5.6}[date-time]}
|
||||
starting at [start] (defaults to [0]) in [s] to a triple [(t, tz, count)]
|
||||
with:
|
||||
{ul
|
||||
{- [t] the POSIX timestamp (hence on the UTC timeline).}
|
||||
{- [tz], the optional {{!tz_offset_s}time zone offset} found in the
|
||||
timestamp. [None] is returned iff the date-time satisfies the
|
||||
{{:https://tools.ietf.org/html/rfc3339#section-4.3}unknown local
|
||||
offset convention}.}
|
||||
{- [count] the number of bytes read starting at [start] to parse the
|
||||
timestamp. If [sub] is [false] (default) this is always
|
||||
[String.length s - start] and [Error `Trailing_input] is returned
|
||||
if there are still bytes in [s] after the date-time was parsed. Use
|
||||
[~sub:true] for allowing trailing input to exist.}
|
||||
{- [strict] if [false] (default) the pasring function does
|
||||
not error on timestamp with lowercase ['T'] or ['Z'] characters, or
|
||||
space separated date and times, and `hhmm` and `hh` timezone
|
||||
offsets (strict mandates [hh:mm]). This allows to parse a slightly
|
||||
larger subset of ISO 8601 than what RFC 3339 allows}}
|
||||
|
||||
{b Notes and limitations.}
|
||||
{ul
|
||||
{- If [start] is not an index of [s], [Error ((start, start), `Eoi)] is
|
||||
returned.}
|
||||
{- RFC 3339 allows a few degenerate (I say) timestamps with
|
||||
non-zero time zone offsets to be parsed at the boundaries that
|
||||
correspond to timestamps that cannot be expressed in UTC in RFC
|
||||
3339 itself (e.g. [0000-01-01T00:00:00+00:01]). The function
|
||||
errors on these timestamps with [`Invalid_stamp] as they cannot
|
||||
be represented in the range \[{!min};{!max}\].}
|
||||
{- Leap seconds are allowed on any date-time and handled as in
|
||||
{!of_date_time}}
|
||||
{- Fractional parts beyond the picosecond ([1e-12]) are truncated.}} *)
|
||||
|
||||
val to_rfc3339 : ?space:bool -> ?frac_s:int -> ?tz_offset_s:tz_offset_s ->
|
||||
t -> string
|
||||
(** [to_rfc3339_tz ~space ~frac_s ~tz_offset_s t] formats the timestamp
|
||||
[t] according to a RFC 3339
|
||||
{{:https://tools.ietf.org/html/rfc3339#section-5.6}[date-time]}
|
||||
production with:
|
||||
{ul
|
||||
{- [tz_offset_s] hints the time zone offset to use, use [0] for UTC.
|
||||
The hint is ignored in the following cases: if [tz_offset_s] is not an
|
||||
integral number of minutes and its magnitude not in the range permitted
|
||||
by the standard, if [add_span t (Span.of_int_s tz_offset_s)] is [None]
|
||||
(the resulting timestamp rendering would not be RFC 3339 compliant).
|
||||
If either the hint is ignored or [tz_offset_s] is unspecified then
|
||||
the
|
||||
{{:https://tools.ietf.org/html/rfc3339#section-4.3}unknown local offset
|
||||
convention} is used to render the time zone component.}
|
||||
{- [frac_s], clipped to the range \[[0];[12]\] specifies that exactly
|
||||
[frac_s] decimal digits of the fractional second of [t] are
|
||||
rendered (defaults to [0]).}
|
||||
{- [space] if [true] the date and time separator is a space
|
||||
rather than a ['T'] (not recommended but may be allowed by the
|
||||
protocol you are dealing with, defaults to [false]).}} *)
|
||||
|
||||
val pp_rfc3339 : ?space:bool -> ?frac_s:int -> ?tz_offset_s:tz_offset_s ->
|
||||
unit -> Format.formatter -> t -> unit
|
||||
(** [pp_rfc3339 ?space ?frac_s ?tz_offset_s () ppf t] is
|
||||
[Format.fprintf ppf "%s" (to_rfc3339 ?space ?frac_s ?tz_offset_s t)]. *)
|
||||
|
||||
(** {1:print Pretty printing} *)
|
||||
|
||||
val pp_human : ?frac_s:int -> ?tz_offset_s:tz_offset_s -> unit ->
|
||||
Format.formatter -> t -> unit
|
||||
(** [pp_human ~frac_s ~tz_offset_s () ppf t] prints an unspecified, human
|
||||
readable, locale-independent, representation of [t] with:
|
||||
{ul
|
||||
{- [tz_offset_s] hints the time zone offset to use. The hint is ignored
|
||||
in the following cases: if [tz_offset_s] is not an integral number of
|
||||
minutes and its magnitude not in the range permitted by the standard,
|
||||
if [add_span t (Span.of_int_s tz_offset_s)] is [None].
|
||||
If either the hint is ignored or [tz_offset_s] is unspecified then
|
||||
RFC 3339's
|
||||
{{:https://tools.ietf.org/html/rfc3339#section-4.3}unknown local offset
|
||||
convention} is used to render the time zone component.}
|
||||
{- [frac_s] clipped to the range \[[0];[12]\] specifies that exactly
|
||||
[frac_s] decimal digits of the fractional second of [t] are
|
||||
rendered (defaults to [0]).}}
|
||||
|
||||
{b Note.} The output of this function is similar to but {b not}
|
||||
compliant with RFC 3339, it should only be used for presentation,
|
||||
not as a serialization format. *)
|
||||
|
||||
val pp : Format.formatter -> t -> unit
|
||||
(** [pp] is [pp_human ~tz_offset_s:0]. *)
|
||||
|
||||
val dump : Format.formatter -> t -> unit
|
||||
(** [dump ppf t] prints an unspecified raw representation of [t]
|
||||
on [ppf]. *)
|
||||
|
||||
(** {1:basics Basics}
|
||||
|
||||
POSIX time counts POSIX seconds since the epoch 1970-01-01
|
||||
00:00:00 UTC. As such a POSIX timestamp is {b always} on the UTC
|
||||
timeline.
|
||||
|
||||
POSIX time doesn't count leap seconds, so by definition it cannot
|
||||
represent them. One way of viewing this is that whenever a leap
|
||||
second is added a POSIX second lasts two SI seconds and whenever a
|
||||
leap second is subtracted a POSIX second lasts zero SI second.
|
||||
|
||||
{!Ptime} does not provide any mean to convert the duration between
|
||||
two POSIX timestamps to SI seconds. The reason is that in order to
|
||||
accurately find this number, a
|
||||
{{:http://www.ietf.org/timezones/data/leap-seconds.list}leap
|
||||
second table} is needed. However since this table may change every
|
||||
six months, {!Ptime} decides not to include it so as not to
|
||||
potentially become incorrect every six months.
|
||||
|
||||
This decision has the following implications. First it should be
|
||||
realised that the durations mentioned by the {!add_span},
|
||||
{!sub_span} and {!diff} functions are expressed in {e
|
||||
POSIX seconds} which may represent zero, one, or two SI
|
||||
seconds. For example if we add 1 second with
|
||||
{!add_span} to the POSIX timestamp for 1998-12-31 23:59:59 UTC,
|
||||
what we get is the timestamp for 1999-01-01 00:00:00 UTC:
|
||||
{[
|
||||
let get = function None -> assert false | Some v -> v
|
||||
let utc d t = get @@ Ptime.of_date_time (d, (t, 0))
|
||||
let t0 = utc (1998, 12, 31) (23, 59, 59)
|
||||
let t1 = utc (1999, 01, 01) (00, 00, 00)
|
||||
let one_s = Ptime.Span.of_int_s 1
|
||||
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t1)
|
||||
]}
|
||||
However since the leap second 1998-12-31 23:59:60 UTC exists,
|
||||
{e two} actual SI seconds elapsed between [t0] and [t1]. Now if we use
|
||||
{!diff} to find the POSIX duration that elapsed between
|
||||
[t0] and [t1] we get one POSIX second:
|
||||
{[
|
||||
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) one_s)
|
||||
]}
|
||||
But still, two SI seconds elapsed between these two points in
|
||||
time. Note also that no value of type {!t} can represent the UTC
|
||||
timetamp 1998-12-31 23:59:60 and hence {!Ptime.to_date_time}
|
||||
will never return a date-time with a seconds value of [60]. In
|
||||
fact both 1998-12-31 23:59:60 UTC and 1999-01-01 00:00:00 UTC are
|
||||
represented by the same timestamp:
|
||||
{[
|
||||
let t2 = utc (1998, 12, 31) (23, 59, 60)
|
||||
let () = assert (Ptime.equal t1 t2)
|
||||
]}
|
||||
This is true of any added leap second, we map it on the first second
|
||||
of the next minute, thus matching the behaviour
|
||||
of POSIX's
|
||||
{{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/mktime.html}
|
||||
mktime} function.
|
||||
|
||||
If a leap second is subtracted on a day the following occurs –
|
||||
2015, as of writing this never happened. Let YYYY-06-30 23:59:58
|
||||
be the instant a leap second is subtracted, this means that the
|
||||
next UTC date-time, one SI second later, is YYYY-07-01
|
||||
00:00:00. However if we diff the two instants:
|
||||
{[
|
||||
let y = 9999 (* hypothetical year were this happens *)
|
||||
let t0 = utc (y, 06, 30) (23, 59, 58)
|
||||
let t1 = utc (y, 07, 01) (00, 00, 00)
|
||||
let two_s = Ptime.Span.of_int_s 2
|
||||
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) two_s)
|
||||
]}
|
||||
We get two POSIX seconds, but only one SI second
|
||||
elapsed between these two points in time. It should also
|
||||
be noted that POSIX time will represent a point that never
|
||||
existed in time namely YYYY-06-30 23:59:59, the POSIX second
|
||||
with 0 SI second duration and that {!Ptime.to_date_time}
|
||||
will return a date-time value for this timestamp even though
|
||||
it never existed:
|
||||
{[
|
||||
let t2 = utc (y, 06, 30) (23, 59, 59)
|
||||
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t2)
|
||||
]}
|
||||
|
||||
{1:notes Notes and limitations}
|
||||
|
||||
The following points should be taken into account
|
||||
{ul
|
||||
{- {!Ptime} is not a calendar library and will never be.}
|
||||
{- {!Ptime} can only represent picosecond precision timestamps in
|
||||
the range \[{!Ptime.min};{!Ptime.max}\]. It is however able to
|
||||
convert {e any} of these timestamps to a valid date-time or RFC
|
||||
3339 timestamp.}
|
||||
{- POSIX time in general is ill-suited to measure wall-clock
|
||||
time spans for the following reasons.
|
||||
{ul
|
||||
{- POSIX time counts time in POSIX seconds. POSIX
|
||||
seconds can represent 2, 1 or 0 SI seconds. [Ptime]
|
||||
offers no mechanism to determine the SI duration between
|
||||
two timestamps, see the {{!basics}basics}.}
|
||||
{- The POSIX timestamps returned by your platform are not
|
||||
monotonic: they are subject to operating system time
|
||||
adjustements and can even go back in time. If you need to
|
||||
measure time spans in a single program run use a monotonic
|
||||
time source (e.g. {!Mtime}).}}}}
|
||||
*)
|
||||
1
unikernel/duniverse/ptime/src/ptime.mllib
Normal file
1
unikernel/duniverse/ptime/src/ptime.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Ptime
|
||||
7
unikernel/duniverse/ptime/src/ptime_top_init.ml
Normal file
7
unikernel/duniverse/ptime/src/ptime_top_init.ml
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
#install_printer Ptime.pp;;
|
||||
#install_printer Ptime.Span.pp;;
|
||||
6
unikernel/duniverse/ptime/src/top/dune
Normal file
6
unikernel/duniverse/ptime/src/top/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(library
|
||||
(name ptime_top)
|
||||
(public_name ptime.top)
|
||||
(libraries compiler-libs.toplevel ptime)
|
||||
(flags (:standard -w -6-27))
|
||||
(wrapped false))
|
||||
6
unikernel/duniverse/ptime/src/top/ptime_top.ml
Normal file
6
unikernel/duniverse/ptime/src/top/ptime_top.ml
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let () = ignore (Toploop.use_file Format.err_formatter "ptime_top_init.ml")
|
||||
1
unikernel/duniverse/ptime/src/top/ptime_top.mllib
Normal file
1
unikernel/duniverse/ptime/src/top/ptime_top.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Ptime_top
|
||||
25
unikernel/duniverse/ptime/test/examples.ml
Normal file
25
unikernel/duniverse/ptime/test/examples.ml
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2024 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: CC0-1.0
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let get = function None -> assert false | Some v -> v
|
||||
let utc d t = get @@ Ptime.of_date_time (d, (t, 0))
|
||||
let t0 = utc (1998, 12, 31) (23, 59, 59)
|
||||
let t1 = utc (1999, 01, 01) (00, 00, 00)
|
||||
let one_s = Ptime.Span.of_int_s 1
|
||||
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t1)
|
||||
|
||||
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) one_s)
|
||||
|
||||
let t2 = utc (1998, 12, 31) (23, 59, 60)
|
||||
let () = assert (Ptime.equal t1 t2)
|
||||
|
||||
let y = 9999 (* hypothetical year were this happens *)
|
||||
let t0 = utc (y, 06, 30) (23, 59, 58)
|
||||
let t1 = utc (y, 07, 01) (00, 00, 00)
|
||||
let two_s = Ptime.Span.of_int_s 2
|
||||
let () = assert (Ptime.Span.equal (Ptime.diff t1 t0) two_s)
|
||||
|
||||
let t2 = utc (y, 06, 30) (23, 59, 59)
|
||||
let () = assert (Ptime.equal (get @@ Ptime.add_span t0 one_s) t2)
|
||||
33
unikernel/duniverse/ptime/test/min_clock.ml
Normal file
33
unikernel/duniverse/ptime/test/min_clock.ml
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
(*
|
||||
Compile with:
|
||||
|
||||
ocamlfind ocamlopt \
|
||||
-package ptime.clock -linkpkg -o min_clock.native min_clock.ml
|
||||
|
||||
ocamlfind ocamlc \
|
||||
-package ptime.clock -linkpkg -o min_clock.byte min_clock.ml
|
||||
|
||||
js_of_ocaml \
|
||||
$(ocamlfind query -format "%+(jsoo_runtime)" -r ptime.clock) \
|
||||
min_clock.byte
|
||||
*)
|
||||
|
||||
let pp_period ppf = function
|
||||
| None -> Format.fprintf ppf "unknown"
|
||||
| Some p -> Ptime.Span.pp ppf p
|
||||
|
||||
let pp_tz ppf = function
|
||||
| None -> Format.fprintf ppf "unknown"
|
||||
| Some tz -> Format.fprintf ppf "%ds" tz
|
||||
|
||||
let main () =
|
||||
let now = Ptime_clock.now () in
|
||||
let tz_offset_s = Ptime_clock.current_tz_offset_s () in
|
||||
let period = Ptime_clock.period () in
|
||||
Format.printf "Clock period: %a@." pp_period period;
|
||||
Format.printf " TZ offset: %a@." pp_tz tz_offset_s;
|
||||
Format.printf " Now UTC : %a@." Ptime.pp now;
|
||||
Format.printf " Now local: %a@." Ptime.(pp_human ?tz_offset_s ()) now;
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else main ()
|
||||
144
unikernel/duniverse/ptime/test/test_base.ml
Normal file
144
unikernel/duniverse/ptime/test/test_base.ml
Normal file
|
|
@ -0,0 +1,144 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let span_of_d_ps ?__POS__ s = Ptime.Span.of_d_ps s |> Test.get_some ?__POS__
|
||||
|
||||
let test_base () =
|
||||
Test.test "stamp constants and base constructors" @@ fun () ->
|
||||
let of_span s = Ptime.(of_span (span_of_d_ps s)) in
|
||||
let get_of_span s = match of_span s with None -> assert false | Some s -> s in
|
||||
let to_raw_span t = Ptime.(Span.to_d_ps (to_span t)) in
|
||||
T.raw_span ~__POS__
|
||||
(to_raw_span Ptime.epoch) (0, 0L);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (0, 0L)) (Some Ptime.epoch);
|
||||
T.raw_span ~__POS__
|
||||
(to_raw_span Ptime.min) (-719528, 0L);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (-719528, 0L)) (Some Ptime.min);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (-719529, 86_399_999_999_999_999L)) None;
|
||||
T.raw_span ~__POS__
|
||||
(to_raw_span Ptime.max) (2932896, 86_399_999_999_999_999L);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (2932896, 86_399_999_999_999_999L)) (Some Ptime.max);
|
||||
T.stamp_option ~__POS__
|
||||
(of_span (2932897, 0L)) None;
|
||||
Test.float ~__POS__
|
||||
(Ptime.to_float_s Ptime.epoch) 0.;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s 0.) (Some Ptime.epoch);
|
||||
Test.float ~__POS__
|
||||
(Ptime.to_float_s Ptime.min) ~-.62167219200.;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s ~-.62167219200.) (Some Ptime.min);
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s ~-.62167219201.) None;
|
||||
Test.float ~__POS__
|
||||
(Ptime.to_float_s (Ptime.truncate ~frac_s:0 Ptime.max)) 253402300799.;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s 253402300799.)
|
||||
(Some (Ptime.truncate ~frac_s:0 Ptime.max));
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s 253402300800.) None;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s nan) None;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s infinity) None;
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_float_s ~-.infinity) None;
|
||||
T.raw_span ~__POS__
|
||||
Ptime.(Span.to_d_ps (frac_s Ptime.max)) (0, 999_999_999_999L);
|
||||
T.span ~__POS__
|
||||
(Ptime.frac_s @@ get_of_span (0, 100_000_000_000L))
|
||||
(span_of_d_ps (0, 100_000_000_000L));
|
||||
T.span ~__POS__
|
||||
(Ptime.frac_s @@ get_of_span (-1, 100_000_000_000L))
|
||||
(span_of_d_ps (0, 100_000_000_000L));
|
||||
()
|
||||
|
||||
let test_predicates () =
|
||||
Test.test "stamp predicates" @@ fun () ->
|
||||
Test.bool ~__POS__ Ptime.(is_earlier min ~than:min) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier min ~than:epoch) true;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier min ~than:max) true;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier epoch ~than:min) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier epoch ~than:epoch) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier epoch ~than:max) true;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier max ~than:min) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier max ~than:epoch) false;
|
||||
Test.bool ~__POS__ Ptime.(is_earlier max ~than:max) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later min ~than:min) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later min ~than:epoch) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later min ~than:max) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later epoch ~than:min) true;
|
||||
Test.bool ~__POS__ Ptime.(is_later epoch ~than:epoch) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later epoch ~than:max) false;
|
||||
Test.bool ~__POS__ Ptime.(is_later max ~than:min) true;
|
||||
Test.bool ~__POS__ Ptime.(is_later max ~than:epoch) true;
|
||||
Test.bool ~__POS__ Ptime.(is_later max ~than:max) false;
|
||||
()
|
||||
|
||||
let test_posix_arithmetic () =
|
||||
Test.test "stamp POSIX arithmetic" @@ fun () ->
|
||||
let span ps = span_of_d_ps (0, ps) in
|
||||
let nspan ps = Ptime.Span.(neg (span_of_d_ps (0, ps))) in
|
||||
(* Test limits *)
|
||||
T.stamp_option ~__POS__ Ptime.(add_span max (span 1L)) None;
|
||||
T.stamp_option ~__POS__ Ptime.(add_span min (nspan (1L))) None;
|
||||
T.stamp_option ~__POS__ Ptime.(sub_span min (span 1L)) None;
|
||||
T.stamp_option ~__POS__ Ptime.(sub_span max (nspan (1L))) None;
|
||||
(* Test arithmetic *)
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_span (span 10L)) Ptime.(add_span epoch (span 10L));
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_span (nspan 10L)) Ptime.(sub_span epoch (span 10L));
|
||||
T.stamp_option ~__POS__
|
||||
(Ptime.of_span (nspan (10L))) Ptime.(sub_span epoch (span 10L));
|
||||
Test.block @@ fun () ->
|
||||
let of_span ps =
|
||||
let s = span_of_d_ps (0, Int64.abs ps) in
|
||||
Ptime.of_span (if ps < 0L then Ptime.Span.neg s else s)
|
||||
in
|
||||
let get ?__POS__ s = of_span s |> Test.get_some ?__POS__ in
|
||||
let t0 = get ~__POS__ 20L in
|
||||
let t1 = get ~__POS__ 10L in
|
||||
let t2 = get ~__POS__ (-10L) in
|
||||
T.span ~__POS__ (Ptime.diff t0 t1) (span 10L);
|
||||
T.span ~__POS__ (Ptime.diff t1 t0) (nspan 10L);
|
||||
T.span ~__POS__ (Ptime.diff t2 t0) (nspan 30L);
|
||||
T.span ~__POS__ (Ptime.diff t0 t2) (span 30L);
|
||||
()
|
||||
|
||||
let test_truncation () =
|
||||
Test.test "stamp truncation" @@ fun () ->
|
||||
let p ~frac_s t =
|
||||
let d1 = Ptime.(diff t min) |> Ptime.Span.truncate ~frac_s
|
||||
and d2 = Ptime.diff (Ptime.truncate ~frac_s t) Ptime.min in
|
||||
T.span ~__POS__ d1 d2
|
||||
in
|
||||
let t ~frac_s ps =
|
||||
p ~frac_s (Ptime.v (0, ps));
|
||||
p ~frac_s (Ptime.v (1, ps));
|
||||
p ~frac_s (Ptime.v (-1, ps));
|
||||
p ~frac_s (Ptime.v (2932896, ps));
|
||||
p ~frac_s (Ptime.v (-719528, ps));
|
||||
in
|
||||
for i = 0 to 12 do
|
||||
t ~frac_s:i 0L;
|
||||
t ~frac_s:i 86_399_999_999_999_999L;
|
||||
t ~frac_s:i 86_399_000_000_000_000L;
|
||||
done;
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_base ();
|
||||
test_predicates ();
|
||||
test_posix_arithmetic ();
|
||||
test_truncation ();
|
||||
()
|
||||
133
unikernel/duniverse/ptime/test/test_date.ml
Normal file
133
unikernel/duniverse/ptime/test/test_date.ml
Normal file
|
|
@ -0,0 +1,133 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let test_bounds () =
|
||||
Test.test "calendar date field bounds" @@ fun () ->
|
||||
let valid_date ?__POS__ d =
|
||||
Test.holds ?__POS__ (Option.is_some (Ptime.of_date ?tz_offset_s:None d))
|
||||
in
|
||||
let wrong_date ?__POS__ d =
|
||||
Test.holds ?__POS__ (Option.is_none (Ptime.of_date ?tz_offset_s:None d))
|
||||
in
|
||||
(* Check year bounds *)
|
||||
wrong_date ~__POS__ (-1, 01, 01);
|
||||
valid_date ~__POS__ (0, 01, 01);
|
||||
valid_date ~__POS__ (1, 01, 01);
|
||||
valid_date ~__POS__ (9999, 01, 01);
|
||||
wrong_date ~__POS__ (10000, 01, 01);
|
||||
wrong_date ~__POS__ (10001, 01, 01);
|
||||
(* Check month bounds *)
|
||||
wrong_date ~__POS__ (0, 00, 01);
|
||||
valid_date ~__POS__ (0, 01, 01);
|
||||
valid_date ~__POS__ (0, 12, 01);
|
||||
wrong_date ~__POS__ (0, 13, 01);
|
||||
(* Check day bounds in 2015 (month lengths) *)
|
||||
(* Jan 2015 *)
|
||||
wrong_date ~__POS__ (2015, 01, -1);
|
||||
valid_date ~__POS__ (2015, 01, 01);
|
||||
valid_date ~__POS__ (2015, 01, 31);
|
||||
wrong_date ~__POS__ (2015, 01, 32);
|
||||
(* Feb 2015, is not leap *)
|
||||
wrong_date ~__POS__ (2015, 02, -1);
|
||||
valid_date ~__POS__ (2015, 02, 01);
|
||||
valid_date ~__POS__ (2015, 02, 28);
|
||||
wrong_date ~__POS__ (2015, 02, 29);
|
||||
(* Mar 2015 *)
|
||||
wrong_date ~__POS__ (2015, 03, -1);
|
||||
valid_date ~__POS__ (2015, 03, 01);
|
||||
valid_date ~__POS__ (2015, 03, 31);
|
||||
wrong_date ~__POS__ (2015, 03, 32);
|
||||
(* Apr 2015 *)
|
||||
wrong_date ~__POS__ (2015, 04, -1);
|
||||
valid_date ~__POS__ (2015, 04, 01);
|
||||
valid_date ~__POS__ (2015, 04, 30);
|
||||
wrong_date ~__POS__ (2015, 04, 31);
|
||||
(* May 2015 *)
|
||||
wrong_date ~__POS__ (2015, 05, -1);
|
||||
valid_date ~__POS__ (2015, 05, 01);
|
||||
valid_date ~__POS__ (2015, 05, 31);
|
||||
wrong_date ~__POS__ (2015, 05, 32);
|
||||
(* June 2015 *)
|
||||
wrong_date ~__POS__ (2015, 06, -1);
|
||||
valid_date ~__POS__ (2015, 06, 01);
|
||||
valid_date ~__POS__ (2015, 06, 30);
|
||||
wrong_date ~__POS__ (2015, 06, 31);
|
||||
(* July 2015 *)
|
||||
wrong_date ~__POS__ (2015, 07, -1);
|
||||
valid_date ~__POS__ (2015, 07, 01);
|
||||
valid_date ~__POS__ (2015, 07, 31);
|
||||
wrong_date ~__POS__ (2015, 07, 32);
|
||||
(* Aug 2015 *)
|
||||
wrong_date ~__POS__ (2015, 08, -1);
|
||||
valid_date ~__POS__ (2015, 08, 01);
|
||||
valid_date ~__POS__ (2015, 08, 31);
|
||||
wrong_date ~__POS__ (2015, 08, 32);
|
||||
(* Sept 2015 *)
|
||||
wrong_date ~__POS__ (2015, 09, -1);
|
||||
valid_date ~__POS__ (2015, 09, 01);
|
||||
valid_date ~__POS__ (2015, 09, 30);
|
||||
wrong_date ~__POS__ (2015, 09, 31);
|
||||
(* Oct 2015 *)
|
||||
wrong_date ~__POS__ (2015, 10, -1);
|
||||
valid_date ~__POS__ (2015, 10, 01);
|
||||
valid_date ~__POS__ (2015, 10, 31);
|
||||
wrong_date ~__POS__ (2015, 10, 32);
|
||||
(* Nov 2015 *)
|
||||
wrong_date ~__POS__ (2015, 11, -1);
|
||||
valid_date ~__POS__ (2015, 11, 01);
|
||||
valid_date ~__POS__ (2015, 11, 30);
|
||||
wrong_date ~__POS__ (2015, 11, 31);
|
||||
(* Dec 2015 *)
|
||||
wrong_date ~__POS__ (2015, 12, -1);
|
||||
valid_date ~__POS__ (2015, 12, 01);
|
||||
valid_date ~__POS__ (2015, 12, 31);
|
||||
wrong_date ~__POS__ (2015, 12, 32);
|
||||
(* 1500 is not leap *)
|
||||
valid_date ~__POS__ (1500, 02, 28);
|
||||
wrong_date ~__POS__ (1500, 02, 29);
|
||||
(* 1700 is not leap *)
|
||||
valid_date ~__POS__ (1700, 02, 28);
|
||||
wrong_date ~__POS__ (1700, 02, 29);
|
||||
(* 1800 is not leap *)
|
||||
valid_date ~__POS__ (1800, 02, 28);
|
||||
wrong_date ~__POS__ (1800, 02, 29);
|
||||
(* 1900 is not leap, Lotus 1-2-3 & Excel bug *)
|
||||
valid_date ~__POS__ (1900, 02, 28);
|
||||
wrong_date ~__POS__ (1900, 02, 29);
|
||||
(* 2000 is leap *)
|
||||
valid_date ~__POS__ (2000, 02, 28);
|
||||
valid_date ~__POS__ (2000, 02, 29);
|
||||
wrong_date ~__POS__ (2000, 02, 30);
|
||||
(* 2010 is not leap *)
|
||||
valid_date ~__POS__ (2010, 02, 28);
|
||||
wrong_date ~__POS__ (2010, 02, 29);
|
||||
(* 2012 is leap *)
|
||||
valid_date ~__POS__ (2012, 02, 29);
|
||||
valid_date ~__POS__ (2012, 02, 29);
|
||||
wrong_date ~__POS__ (2012, 02, 30);
|
||||
(* 2100 is not leap *)
|
||||
valid_date ~__POS__ (2100, 02, 28);
|
||||
wrong_date ~__POS__ (2100, 02, 29);
|
||||
()
|
||||
|
||||
let test_stamp_trips () =
|
||||
Test.test "random valid dates to stamps round trips" @@ fun () ->
|
||||
let of_date ?__POS__ d =
|
||||
Ptime.of_date ?tz_offset_s:None d |> Test.get_some ?__POS__
|
||||
in
|
||||
for i = 1 to Rand.loop_len () do
|
||||
let date = Rand.date () in
|
||||
let trip = Ptime.to_date (of_date date) in
|
||||
T.date ~__POS__ date trip
|
||||
done;
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_bounds ();
|
||||
test_stamp_trips ();
|
||||
()
|
||||
211
unikernel/duniverse/ptime/test/test_date_time.ml
Normal file
211
unikernel/duniverse/ptime/test/test_date_time.ml
Normal file
|
|
@ -0,0 +1,211 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let stamp_of_date_time ?__POS__ d =
|
||||
Ptime.of_date_time d |> Test.get_some ?__POS__
|
||||
|
||||
let valid_date_time ?__POS__ d =
|
||||
Test.holds ?__POS__ (Option.is_some (Ptime.of_date_time d))
|
||||
|
||||
let wrong_date_time ?__POS__ d =
|
||||
Test.holds ?__POS__ (Option.is_none (Ptime.of_date_time d))
|
||||
|
||||
let test_time_bounds () =
|
||||
Test.test "date-time time field bounds" @@ fun () ->
|
||||
let min_date = Ptime.to_date Ptime.min in
|
||||
let min_utc t = min_date, (t, 0) in
|
||||
(* Check hour bounds *)
|
||||
wrong_date_time ~__POS__ (min_utc (-2, 00, 00));
|
||||
wrong_date_time ~__POS__ (min_utc (-1, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (01, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (23, 00, 00));
|
||||
wrong_date_time ~__POS__ (min_utc (24, 00, 00));
|
||||
(* Check minute bounds *)
|
||||
wrong_date_time ~__POS__ (min_utc (00, -2, 00));
|
||||
wrong_date_time ~__POS__ (min_utc (00, -1, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 01, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 59, 00));
|
||||
wrong_date_time ~__POS__ (min_utc (00, 60, 00));
|
||||
(* Check second bounds *)
|
||||
wrong_date_time ~__POS__ (min_utc (00, 00, -2));
|
||||
wrong_date_time ~__POS__ (min_utc (00, 00, -1));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 00));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 01));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 59));
|
||||
valid_date_time ~__POS__ (min_utc (00, 00, 60));
|
||||
wrong_date_time ~__POS__ (min_utc (00, 00, 61));
|
||||
()
|
||||
|
||||
let test_tz () =
|
||||
Test.test "testing date-time time zone calculations" @@ fun () ->
|
||||
(* Timestamps with tz offsets around Ptime.{max,min} *)
|
||||
wrong_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), +1));
|
||||
valid_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), +0));
|
||||
valid_date_time ~__POS__ ((0000, 01, 01), ((00, 00, 00), -1));
|
||||
wrong_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 59), -1));
|
||||
wrong_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 60), +0));
|
||||
valid_date_time ~__POS__ ((9999, 12, 31), ((23, 59, 60), +1));
|
||||
(* Convert time zones *)
|
||||
let nyc_tz = -4 * 3600 in
|
||||
let cam_tz = +1 * 3600 in
|
||||
let lau_tz = +2 * 3600 in
|
||||
let new_york = ((2015, 06, 27), ((18, 30, 01), nyc_tz)) in
|
||||
let cambridge = ((2015, 06, 27), ((23, 30, 01), cam_tz)) in
|
||||
let lausanne = ((2015, 06, 28), ((00, 30, 01), lau_tz)) in
|
||||
let nyc_stamp = stamp_of_date_time new_york in
|
||||
let cam_stamp = stamp_of_date_time cambridge in
|
||||
let lau_stamp = stamp_of_date_time lausanne in
|
||||
T.stamp ~__POS__ nyc_stamp cam_stamp;
|
||||
T.stamp ~__POS__ cam_stamp lau_stamp;
|
||||
T.date_time ~__POS__
|
||||
(Ptime.to_date_time ~tz_offset_s:nyc_tz nyc_stamp) new_york;
|
||||
T.date_time ~__POS__
|
||||
(Ptime.to_date_time ~tz_offset_s:cam_tz nyc_stamp) cambridge;
|
||||
T.date_time ~__POS__
|
||||
(Ptime.to_date_time ~tz_offset_s:lau_tz nyc_stamp) lausanne;
|
||||
()
|
||||
|
||||
let test_subsecond () =
|
||||
Test.test "subsecond stamp to date-time" @@ fun () ->
|
||||
let span_of_d_ps ?__POS__ s =
|
||||
Ptime.Span.of_d_ps s |> Test.get_some ?__POS__
|
||||
in
|
||||
let add, sub =
|
||||
let add t ps = Ptime.(add_span t (span_of_d_ps (0, ps))) |> Test.get_some in
|
||||
let sub t ps = Ptime.(sub_span t (span_of_d_ps (0, ps))) |> Test.get_some in
|
||||
add, sub
|
||||
in
|
||||
let b0 = sub Ptime.epoch 750_000_000_000L in
|
||||
let b1 = sub Ptime.epoch 500_000_000_000L in
|
||||
let b2 = sub Ptime.epoch 250_000_000_000L in
|
||||
let b = (1969, 12, 31), ((23, 59, 59), +0) in
|
||||
T.date_time ~__POS__ b (Ptime.to_date_time b0);
|
||||
T.date_time ~__POS__ b (Ptime.to_date_time b1);
|
||||
T.date_time ~__POS__ b (Ptime.to_date_time b2);
|
||||
let a0 = add Ptime.epoch 750_000_000_000L in
|
||||
let a1 = add Ptime.epoch 500_000_000_000L in
|
||||
let a2 = add Ptime.epoch 250_000_000_000L in
|
||||
let a = (1970, 01, 01), ((00, 00, 00), +0) in
|
||||
T.date_time ~__POS__ a (Ptime.to_date_time a0);
|
||||
T.date_time ~__POS__ a (Ptime.to_date_time a1);
|
||||
T.date_time ~__POS__ a (Ptime.to_date_time a2);
|
||||
()
|
||||
|
||||
let test_leap_sec () =
|
||||
Test.test "testing leap second date-times" @@ fun () ->
|
||||
let after_leap_sec = (1999, 01, 01), ((00, 00, 00), 0) in
|
||||
let t0 = stamp_of_date_time ((1998, 12, 31), ((23, 59, 59), 0)) in
|
||||
let t1 = stamp_of_date_time ((1998, 12, 31), ((23, 59, 60), 0)) in
|
||||
let t2 = stamp_of_date_time after_leap_sec in
|
||||
T.stamp ~__POS__ t1 t2
|
||||
(* leap sec is represented by second that comes after *);
|
||||
T.stamp_option ~__POS__ (Some t1) Ptime.(add_span t0 (Span.of_int_s 1));
|
||||
T.date_time ~__POS__ after_leap_sec (Ptime.to_date_time t1);
|
||||
T.date_time ~__POS__ after_leap_sec (Ptime.to_date_time t2);
|
||||
T.span ~__POS__ (Ptime.diff t2 t0) (Ptime.Span.of_int_s 1);
|
||||
T.span ~__POS__ (Ptime.diff t1 t0) (Ptime.Span.of_int_s 1);
|
||||
T.span ~__POS__ (Ptime.diff t2 t1) (Ptime.Span.of_int_s 0);
|
||||
()
|
||||
|
||||
let test_stamp_trips () =
|
||||
Test.test "random stamps to date-time round trips" @@ fun () ->
|
||||
let stamp_of_posix_s s = Ptime.of_float_s s |> Test.get_some in
|
||||
let trip ?tz_offset_s t =
|
||||
let back = stamp_of_posix_s (floor (Ptime.to_float_s t)) in
|
||||
let trip = stamp_of_date_time (Ptime.to_date_time ?tz_offset_s t) in
|
||||
T.stamp ~__POS__ back trip
|
||||
in
|
||||
for i = 1 to Rand.loop_len () do
|
||||
trip ~tz_offset_s:0 (* UTC *) (Rand.float_stamp ());
|
||||
trip ~tz_offset_s:(Rand.tz_offset_s ()) (Rand.float_stamp ())
|
||||
done
|
||||
|
||||
let test_round_trips () =
|
||||
Test.test "random valid date-times to stamp round trips" @@ fun () ->
|
||||
let is_leap_sec = function
|
||||
| (_, _, _), ((_, _, 60), _) -> true
|
||||
| _ -> false
|
||||
in
|
||||
let rec rand_date_time_stamp () = (* biased *)
|
||||
let date = Rand.date () in
|
||||
let time = Rand.time () in
|
||||
let tz = Rand.tz_offset_s () in
|
||||
let dt = (date, (time, tz)) in
|
||||
match Ptime.of_date_time dt with
|
||||
| Some _ -> dt
|
||||
| None ->
|
||||
let dt = date, (time, 0) (* try in UTC *) in
|
||||
begin match Ptime.of_date_time dt with
|
||||
| None -> rand_date_time_stamp () (* start again *)
|
||||
| Some _ -> dt
|
||||
end
|
||||
in
|
||||
let add_posix_s =
|
||||
let span s = Ptime.Span.of_float_s s |> Test.get_some in
|
||||
let add_posix_s t s = Ptime.(add_span t (span s)) |> Test.get_some in
|
||||
add_posix_s
|
||||
in
|
||||
for i = 1 to Rand.loop_len () do
|
||||
let (_, (_, tz_offset_s) as dt) = rand_date_time_stamp () in
|
||||
let stamp = stamp_of_date_time dt in
|
||||
if not (is_leap_sec dt)
|
||||
then begin
|
||||
let ((y, _, _), _ as dt') = Ptime.to_date_time ~tz_offset_s stamp in
|
||||
assert (Ptime.to_year ~tz_offset_s stamp = y);
|
||||
T.date_time ~__POS__ dt dt'
|
||||
end
|
||||
else begin
|
||||
(* Verify we map the leap sec on the the second after. *)
|
||||
let before_leap_dt = match dt with
|
||||
| date, ((hh, ss, 60), tz) -> date, ((hh, ss, 59), tz)
|
||||
| _ -> assert false
|
||||
in
|
||||
let stamp' = add_posix_s (stamp_of_date_time before_leap_dt) 1. in
|
||||
T.stamp ~__POS__ stamp stamp'
|
||||
end
|
||||
done;
|
||||
()
|
||||
|
||||
let test_weekday () =
|
||||
Test.test "Ptime.{weekday_num,weekday}" @@ fun () ->
|
||||
let module Weekday = struct
|
||||
type t = Ptime.weekday
|
||||
let equal = ( = )
|
||||
let pp ppf v = Format.pp_print_string ppf @@ match v with
|
||||
| `Mon -> "`Mon" | `Tue -> "`Tue" | `Wed -> "`Wed" | `Thu -> "`Thu"
|
||||
| `Fri -> "`Fri" | `Sat -> "`Sat" | `Sun -> "`Sun"
|
||||
end
|
||||
in
|
||||
let weekday ?__POS__ = Test.eq ?__POS__ (module Weekday) in
|
||||
let eq ?__POS__ ?tz_offset_s c wday =
|
||||
let s = stamp_of_date_time (c, ((0, 0, 0), 0)) in
|
||||
weekday ?__POS__ (Ptime.weekday ?tz_offset_s s) wday
|
||||
in
|
||||
eq ~__POS__ (1970, 01, 01) `Thu;
|
||||
eq ~__POS__ ~tz_offset_s:(-1) (1970, 01, 01) `Wed;
|
||||
eq ~__POS__ ~tz_offset_s:86400 (1970, 01, 01) `Fri;
|
||||
eq ~__POS__ (1871, 03, 18) `Sat;
|
||||
eq ~__POS__ ~tz_offset_s:(-1) (1871, 03, 18) `Fri;
|
||||
eq ~__POS__ ~tz_offset_s:86400 (1871, 03, 18) `Sun;
|
||||
eq ~__POS__ (1995, 09, 12) `Tue;
|
||||
eq ~__POS__ ~tz_offset_s:(-1) (1995, 09, 12) `Mon;
|
||||
eq ~__POS__ ~tz_offset_s:86400 (1995, 09, 12) `Wed;
|
||||
eq ~__POS__ ~tz_offset_s:172800 (1995, 09, 12) `Thu;
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_time_bounds ();
|
||||
test_tz ();
|
||||
test_subsecond ();
|
||||
test_leap_sec ();
|
||||
test_stamp_trips ();
|
||||
test_round_trips ();
|
||||
test_weekday ();
|
||||
()
|
||||
26
unikernel/duniverse/ptime/test/test_gmtime.ml
Normal file
26
unikernel/duniverse/ptime/test/test_gmtime.ml
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let test_stamp_to_date_time () =
|
||||
Test.test "random Ptime-valid stamps to date-time" @@ fun () ->
|
||||
if Sys.word_size > 32 then begin
|
||||
T.date_time_gmtime_witness ~__POS__ Ptime.min;
|
||||
T.date_time_gmtime_witness ~__POS__ Ptime.(truncate ~frac_s:0 max);
|
||||
end;
|
||||
for i = 1 to Rand.loop_len () do
|
||||
T.date_time_gmtime_witness ~__POS__ (Rand.stamp ())
|
||||
done;
|
||||
()
|
||||
|
||||
let main () =
|
||||
Test.main @@ fun () ->
|
||||
Test.Cli.parse ();
|
||||
test_stamp_to_date_time ();
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
30
unikernel/duniverse/ptime/test/test_gmtime_all.ml
Normal file
30
unikernel/duniverse/ptime/test/test_gmtime_all.ml
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let exhaustive_min_max =
|
||||
if Sys.word_size > 32
|
||||
then Ptime.(to_float_s min), Ptime.(to_float_s (truncate ~frac_s:0 max))
|
||||
else Int32.(to_float min_int), Int32.(to_float max_int)
|
||||
|
||||
let test_exhaustive () =
|
||||
Test.test "each Ptime-valid second stamp to date-time" @@ fun () ->
|
||||
let min, max = exhaustive_min_max in
|
||||
let rec loop t =
|
||||
if t > max then () else
|
||||
let stamp = Ptime.of_float_s t |> Option.get in
|
||||
T.date_time_gmtime_witness ~__POS__ stamp;
|
||||
loop (t +. 1.0)
|
||||
in
|
||||
loop min
|
||||
|
||||
let main () =
|
||||
Test.main @@ fun () ->
|
||||
test_exhaustive ();
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
18
unikernel/duniverse/ptime/test/test_ptime.ml
Normal file
18
unikernel/duniverse/ptime/test/test_ptime.ml
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
|
||||
let main () =
|
||||
Test.main @@ fun () ->
|
||||
Test.Cli.parse ();
|
||||
Test_span.tests ();
|
||||
Test_base.tests ();
|
||||
Test_date.tests ();
|
||||
Test_date_time.tests ();
|
||||
Test_rfc3339.tests ();
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
276
unikernel/duniverse/ptime/test/test_rfc3339.ml
Normal file
276
unikernel/duniverse/ptime/test/test_rfc3339.ml
Normal file
|
|
@ -0,0 +1,276 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let stamp_of_s ?__POS__ v = Ptime.of_float_s v |> Test.get_some ?__POS__
|
||||
|
||||
let test_stamp_conversions () =
|
||||
Test.test "stamp to RFC 3339 conversions" @@ fun () ->
|
||||
let stamp_of_date_time ?__POS__ v =
|
||||
Ptime.of_date_time v |> Test.get_some ?__POS__
|
||||
in
|
||||
let dt ?space ?frac_s ?tz_offset_s dt =
|
||||
Ptime.to_rfc3339 ?space ?frac_s ?tz_offset_s (stamp_of_date_time dt)
|
||||
in
|
||||
let stamp ?space ?frac_s ?tz_offset_s s =
|
||||
Ptime.to_rfc3339 ?space ?frac_s ?tz_offset_s s
|
||||
in
|
||||
let dt0 = (1999, 01, 02), ((01, 02, 03), 0) in
|
||||
Test.string ~__POS__ "1999-01-02T01:02:03Z"
|
||||
(dt ~tz_offset_s:0 dt0);
|
||||
Test.string ~__POS__ "1999-01-02 01:02:03Z"
|
||||
(dt ~tz_offset_s:0 ~space:true dt0);
|
||||
Test.string ~__POS__ "1999-01-02T01:02:03-00:00"
|
||||
(dt dt0);
|
||||
Test.string ~__POS__ "1999-01-02 01:02:03-00:00"
|
||||
(dt ~space:true dt0);
|
||||
Test.string ~__POS__ "1999-01-02T02:03:03+01:01"
|
||||
(dt ~tz_offset_s:3660 dt0);
|
||||
Test.string ~__POS__ "1999-01-02T00:01:03-01:01"
|
||||
(dt ~tz_offset_s:(-3660) dt0);
|
||||
Test.string ~__POS__ "1999-01-02T01:02:03-00:00"
|
||||
(dt ~tz_offset_s:1 dt0);
|
||||
Test.string ~__POS__ "1999-01-02T01:02:03-00:00"
|
||||
(dt ~tz_offset_s:12960000 dt0);
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.75Z"
|
||||
(stamp ~frac_s:2 ~tz_offset_s:0 (stamp_of_s (-.(1. /. 4.))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.25Z"
|
||||
(stamp ~frac_s:2 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. 4.))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:01.001953125Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s ( 1. +. (1. /. (2. ** 9.)))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.001953125Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. (2. ** 9.)))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:01.125Z"
|
||||
(stamp ~frac_s:3 ~tz_offset_s:0 (stamp_of_s ( 1. +. (1. /. (2. ** 3.)))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.125Z"
|
||||
(stamp ~frac_s:3 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. (2. ** 3.)))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:01.5Z"
|
||||
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s ( 1. +. (1. /. (2. ** 1.)))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:59.5Z"
|
||||
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s (-1. +. (1. /. (2. ** 1.)))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:02.001953125Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s ( 2. +. (1. /. (2. ** 9.)))));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58.001953125Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s (-2. +. (1. /. (2. ** 9.)))));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:02.000000000Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s ( 2.)));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58.000000000Z"
|
||||
(stamp ~frac_s:9 ~tz_offset_s:0 (stamp_of_s (-2.)));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:02.0Z"
|
||||
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s ( 2.)));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58.0Z"
|
||||
(stamp ~frac_s:1 ~tz_offset_s:0 (stamp_of_s (-2.)));
|
||||
Test.string ~__POS__ "1970-01-01T00:00:02Z"
|
||||
(stamp ~frac_s:0 ~tz_offset_s:0 (stamp_of_s ( 2.)));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58Z"
|
||||
(stamp ~frac_s:0 ~tz_offset_s:0 (stamp_of_s (-2.)));
|
||||
Test.string ~__POS__ "1969-12-31T23:59:58Z"
|
||||
(stamp ~frac_s:(-1) ~tz_offset_s:0 (stamp_of_s (-2.)));
|
||||
Test.string ~__POS__ "9999-12-31T23:59:59.999999999999Z"
|
||||
(stamp ~frac_s:12 ~tz_offset_s:0 Ptime.max);
|
||||
Test.string ~__POS__ "0000-01-01T00:00:00.000000000000Z"
|
||||
(stamp ~frac_s:12 ~tz_offset_s:0 Ptime.min);
|
||||
Test.string ~__POS__ "0000-01-01T00:00:00.000000000000Z"
|
||||
(stamp ~frac_s:13 ~tz_offset_s:0 Ptime.min);
|
||||
()
|
||||
|
||||
let test_parse () =
|
||||
Test.test "RFC 3339 to stamp conversions" @@ fun () ->
|
||||
let test_result =
|
||||
let ok =
|
||||
let equal (t, tz, c) (t', tz',c') =
|
||||
Ptime.equal t t' && tz = tz' && c = c'
|
||||
in
|
||||
let pp ppf (t, tz, count) =
|
||||
Fmt.pf ppf "(%a, %a, %d)"
|
||||
Ptime.dump t (Test.Fmt.option Fmt.int) tz count
|
||||
in
|
||||
Test.Eq.make ~equal ~pp ()
|
||||
in
|
||||
let error =
|
||||
let pp ppf = function `RFC3339 ((s, e), err) ->
|
||||
Fmt.pf ppf "@[<1>%d-%d:@ @[%a@]@]" s e Ptime.pp_rfc3339_error err
|
||||
in
|
||||
Test.Eq.make ~pp ()
|
||||
in
|
||||
fun ?__POS__ -> Test.result' ?__POS__ ~ok ~error
|
||||
in
|
||||
let edigit = `Exp_chars ['0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'] in
|
||||
let etz = `Exp_chars ['+'; '-'; 'Z'; 'z'] in
|
||||
let etz_strict = `Exp_chars ['+'; '-'; 'Z'] in
|
||||
let edtsep = `Exp_chars ['T';'t';' '] in
|
||||
let edtsep_strict = `Exp_chars ['T'] in
|
||||
let p ?strict ?sub ?start ?len s = Ptime.of_rfc3339 ?strict ?sub ?start s in
|
||||
let err (s,e) err = Error (`RFC3339 ((s, e), err)) in
|
||||
let err_pos pos e = err (pos, pos) e in
|
||||
let ok s ~tz ~count = Ok (stamp_of_s s, tz, count) in
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:02.001953125Z")
|
||||
(ok ( 2. +. (1. /. (2. ** 9.))) ~tz:(Some 0) ~count:30);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:02.001953125-00:00")
|
||||
(ok ( 2. +. (1. /. (2. ** 9.))) ~tz:None ~count:35);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.001953125Z")
|
||||
(ok (-2. +. (1. /. (2. ** 9.))) ~tz:(Some 0) ~count:30);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.001953125-00:00")
|
||||
(ok (-2. +. (1. /. (2. ** 9.))) ~tz:None ~count:35);
|
||||
test_result ~__POS__
|
||||
(p "1969-13-31T23:59:58.5Z")
|
||||
(err (0, 21) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.Z")
|
||||
(err_pos 20 edigit);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.5")
|
||||
(err_pos 20 `Eoi);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.5a")
|
||||
(err_pos 21 etz);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.5Za")
|
||||
(err_pos 22 `Trailing_input);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31t23:59:58.5Z")
|
||||
(ok (-1.5) ~tz:(Some 0) ~count:22);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31 23:59:58.5z")
|
||||
(ok (-1.5) ~tz:(Some 0) ~count:22);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58.5Z")
|
||||
(ok (-1.5) ~tz:(Some 0) ~count:22);
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31a23:59:58.5Z")
|
||||
(err_pos 10 edtsep);
|
||||
test_result ~__POS__
|
||||
(p ~strict:true "1969-12-31 23:59:58.5Z")
|
||||
(err_pos 10 edtsep_strict);
|
||||
test_result ~__POS__
|
||||
(p ~strict:true "1969-12-31t23:59:58.5Z")
|
||||
(err_pos 10 edtsep_strict);
|
||||
test_result ~__POS__
|
||||
(p ~strict:true "1969-12-31T23:59:58.5z")
|
||||
(err_pos 21 etz_strict);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5+00:01")
|
||||
(ok (-59.5) ~tz:(Some 60) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5+01:01")
|
||||
(ok (-3659.5) ~tz:(Some 3660) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5-00:01")
|
||||
(ok (60.5) ~tz:(Some ~-60) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.00+01:01")
|
||||
(ok (-3660.00) ~tz:(Some 3660) ~count:28);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.25+01:01")
|
||||
(ok (-3659.75) ~tz:(Some 3660) ~count:28);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.25-00:01")
|
||||
(ok (60.25) ~tz:(Some ~-60) ~count:28);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00-23:59")
|
||||
(ok (86340.) ~tz:(Some ~-86340) ~count:25);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00-23:59")
|
||||
(ok (86340.) ~tz:(Some ~-86340) ~count:25);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00+23:59")
|
||||
(ok (-86340.) ~tz:(Some 86340) ~count:25);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00+23:59")
|
||||
(ok (-86340.) ~tz:(Some 86340) ~count:25);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5-01:01")
|
||||
(ok (3660.5) ~tz:(Some ~-3660) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5-24:01")
|
||||
(err (22, 23) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.5-01:60")
|
||||
(err (25, 26) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p ~sub:true ~start:1 "X1969-12-31T23:59:58.5ZX")
|
||||
(ok (-1.5) ~tz:(Some 0) ~count:22);
|
||||
test_result ~__POS__
|
||||
(p ~start:1 "X1969-12-31T23:59:58.5ZX")
|
||||
(err_pos 23 `Trailing_input);
|
||||
test_result ~__POS__
|
||||
(p "1969X12-31T23:59:58Z")
|
||||
(err_pos 4 (`Exp_chars ['-']));
|
||||
test_result ~__POS__
|
||||
(p "1969-12X31T23:59:58Z")
|
||||
(err_pos 7 (`Exp_chars ['-']));
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23X59:58Z")
|
||||
(err_pos 13 (`Exp_chars [':']));
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59X58Z")
|
||||
(err_pos 16 (`Exp_chars [':']));
|
||||
test_result ~__POS__
|
||||
(p ~strict:true "1969-12-31T23:59:58+00X00")
|
||||
(err_pos 22 (`Exp_chars [':']));
|
||||
test_result ~__POS__
|
||||
(p "1969-12-31T23:59:58+00X00")
|
||||
(err_pos 22 `Trailing_input);
|
||||
test_result ~__POS__
|
||||
(p ~start:(-1) "1970-01-01")
|
||||
(err_pos (-1) `Eoi);
|
||||
test_result ~__POS__
|
||||
(p ~start:11 "1970-01-01")
|
||||
(err_pos 11 `Eoi);
|
||||
test_result ~__POS__
|
||||
(p "")
|
||||
(err_pos 0 `Eoi);
|
||||
test_result ~__POS__
|
||||
(p "0000-01-01T00:00:00+00:01")
|
||||
(err (0, 24) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "9999-12-31T23:59:59-00:01")
|
||||
(err (0, 24) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "1900-02-29T01:02:03Z")
|
||||
(err (0, 19) `Invalid_stamp);
|
||||
test_result ~__POS__
|
||||
(p "01-02-29T01:02:03Z")
|
||||
(err_pos 2 edigit);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.00+0101")
|
||||
(ok (-3660.00) ~tz:(Some 3660) ~count:27);
|
||||
test_result ~__POS__
|
||||
(p "1970-01-01T00:00:00.00+01")
|
||||
(ok (-3600.00) ~tz:(Some 3600) ~count:25);
|
||||
()
|
||||
|
||||
let test_stamp_trips () =
|
||||
Test.test "random stamps to RFC 3339 round trips" @@ fun () ->
|
||||
let stamp_of_rfc3339 ?__POS__ s =
|
||||
Ptime.of_rfc3339 s |> Ptime.rfc3339_string_error |> Test.get_ok ?__POS__
|
||||
in
|
||||
let trip ?__POS__:pos ?tz_offset_s t =
|
||||
let back = stamp_of_s ?__POS__:pos (floor (Ptime.to_float_s t)) in
|
||||
let trip, tz, _ =
|
||||
stamp_of_rfc3339 ?__POS__:pos (Ptime.to_rfc3339 ?tz_offset_s t)
|
||||
in
|
||||
T.stamp ~__POS__ back trip;
|
||||
in
|
||||
for i = 1 to Rand.loop_len () do
|
||||
trip ~__POS__ ?tz_offset_s:(Some 0)(* UTC *) (Rand.float_stamp ());
|
||||
trip ~__POS__ ?tz_offset_s:None (* Unknown *) (Rand.float_stamp ());
|
||||
trip ~__POS__ ?tz_offset_s:(Some (Rand.tz_offset_s ()))
|
||||
(Rand.float_stamp ())
|
||||
done;
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_stamp_conversions ();
|
||||
test_parse ();
|
||||
test_stamp_trips ();
|
||||
()
|
||||
337
unikernel/duniverse/ptime/test/test_span.ml
Normal file
337
unikernel/duniverse/ptime/test/test_span.ml
Normal file
|
|
@ -0,0 +1,337 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
open Testing_ptime
|
||||
|
||||
let p s = Ptime.Span.of_d_ps s |> Test.get_some
|
||||
let n s = Ptime.Span.(neg (p s))
|
||||
let pps ps = p (0, ps)
|
||||
let nps ps = n (0, ps)
|
||||
|
||||
let test_conversions () =
|
||||
Test.test "span constants and conversions" @@ fun () ->
|
||||
(* Ints *)
|
||||
let trip_int ?__POS__ secs =
|
||||
Test.option ?__POS__ ~some:Test.Eq.int
|
||||
Ptime.Span.(to_int_s (of_int_s secs)) (Some secs)
|
||||
in
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s 0) Ptime.Span.zero;
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s 1) (pps 1_000_000_000_000L);
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s (-1)) (nps 1_000_000_000_000L);
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s 86_400) (p (1, 0L));
|
||||
T.span ~__POS__ (Ptime.Span.of_int_s (-86_400)) (n (1, 0L));
|
||||
trip_int ~__POS__ (86_400);
|
||||
trip_int ~__POS__ (-86_400);
|
||||
trip_int ~__POS__ (234_322_342);
|
||||
trip_int ~__POS__ (-234_322_352);
|
||||
trip_int ~__POS__ (1);
|
||||
trip_int ~__POS__ (-1);
|
||||
trip_int ~__POS__ (0);
|
||||
(* Floats *)
|
||||
let trip_float ?__POS__ secs =
|
||||
let of_float secs = Ptime.Span.of_float_s secs |> Test.get_some ?__POS__ in
|
||||
Test.float ?__POS__ (Ptime.Span.to_float_s (of_float secs)) secs
|
||||
in
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s 1.0000000000005) (Some (pps 1_000_000_000_000L));
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (-1.0000000000005)) (Some (nps 1_000_000_000_000L));
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s 0.) (Some Ptime.Span.zero);
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (min_float)) (Some Ptime.Span.zero);
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (-.min_float))(Some Ptime.Span.zero);
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s max_float) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (-.max_float)) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s nan) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s infinity) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_float_s (-.infinity)) None;
|
||||
trip_float ~__POS__ 0.;
|
||||
trip_float ~__POS__ (-0.);
|
||||
trip_float ~__POS__ 1.;
|
||||
trip_float ~__POS__ (-1.);
|
||||
trip_float ~__POS__ (float (1 lsl 30 - 1));
|
||||
trip_float ~__POS__ (float (- (1 lsl 30)));
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_d_ps (23, -1L)) None;
|
||||
T.span_option ~__POS__
|
||||
(Ptime.Span.of_d_ps (23, 86_400_000_000_000_000L)) None;
|
||||
()
|
||||
|
||||
let test_predicates () =
|
||||
Test.test "span predicates" @@ fun () ->
|
||||
Test.bool ~__POS__ (Ptime.Span.equal Ptime.Span.zero Ptime.Span.zero) true;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal Ptime.Span.zero (pps 1L)) false;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal Ptime.Span.zero (nps 1L)) false;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (p (30, 3434L)) (p (30, 3434L))) true;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (p (30, 3434L)) (p (30, 3435L))) false;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (n (30, 3434L)) (n (30, 3434L))) true;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (n (30, 3434L)) (n (30, 3435L))) false;
|
||||
Test.bool ~__POS__ (Ptime.Span.equal (n (30, 3434L)) (p (30, 3434L))) false;
|
||||
Test.int ~__POS__ (Ptime.Span.compare Ptime.Span.zero Ptime.Span.zero) 0;
|
||||
Test.int ~__POS__ (Ptime.Span.compare Ptime.Span.zero (pps 1L)) (-1);
|
||||
Test.int ~__POS__ (Ptime.Span.compare Ptime.Span.zero (nps 1L)) 1;
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (n (30, 3434L))) 0;
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (n (30, 3435L))) 1;
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (p (30, 3435L))) (-1);
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (n (30, 3433L))) (-1);
|
||||
Test.int ~__POS__ (Ptime.Span.compare (n (30, 3434L)) (p (30, 3433L))) (-1);
|
||||
()
|
||||
|
||||
let test_arithmetic () =
|
||||
Test.test "span arithmetic" @@ fun () ->
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.add (pps 86_399_999_999_999_999L) (pps 1L)) (p (1, 0L));
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.add (nps 86_399_999_999_999_999L) (nps 1L)) (n (1, 0L));
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.sub Ptime.Span.zero (pps 1L)) (nps 1L);
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.sub Ptime.Span.zero (nps 1L)) (pps 1L);
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.add (nps 1L) (pps 1L)) Ptime.Span.zero;
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.abs (n (3, 342L))) (p (3, 342L));
|
||||
T.span ~__POS__
|
||||
(Ptime.Span.abs (p (3, 342L))) (p (3, 342L));
|
||||
()
|
||||
|
||||
let test_rounding () =
|
||||
Test.test "span rounding" @@ fun () ->
|
||||
let r ~frac a b =
|
||||
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (3, b));
|
||||
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (3, b))
|
||||
in
|
||||
let r_carry ~frac a =
|
||||
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (4, 0L));
|
||||
T.span ~__POS__ (Ptime.Span.round ~frac_s:frac (p (3, a))) (p (4, 0L))
|
||||
in
|
||||
let t ~frac a b =
|
||||
T.span ~__POS__ (Ptime.Span.truncate ~frac_s:frac (p (3, a))) (p (3, b));
|
||||
T.span ~__POS__ (Ptime.Span.truncate ~frac_s:frac (n (3, a))) (n (3, b))
|
||||
in
|
||||
for i = 0 to 12 do r ~frac:i 0L 0L done;
|
||||
r_carry ~frac:(-1) 86_399_500_000_000_000L;
|
||||
r_carry ~frac:0 86_399_500_000_000_000L;
|
||||
r ~frac:0 86_399_499_999_999_999L 86_399_000_000_000_000L;
|
||||
r ~frac:0 10_001_500_000_000_000L 10_002_000_000_000_000L;
|
||||
r ~frac:0 10_001_499_999_999_999L 10_001_000_000_000_000L;
|
||||
r_carry ~frac:1 86_399_950_000_000_000L;
|
||||
r ~frac:1 86_399_949_999_999_999L 86_399_900_000_000_000L;
|
||||
r ~frac:1 10_001_150_000_000_000L 10_001_200_000_000_000L;
|
||||
r ~frac:1 10_001_149_999_999_999L 10_001_100_000_000_000L;
|
||||
r_carry ~frac:2 86_399_995_000_000_000L;
|
||||
r ~frac:2 86_399_994_999_999_999L 86_399_990_000_000_000L;
|
||||
r ~frac:2 10_001_115_000_000_000L 10_001_120_000_000_000L;
|
||||
r ~frac:2 10_001_114_999_999_999L 10_001_110_000_000_000L;
|
||||
r_carry ~frac:3 86_399_999_500_000_000L;
|
||||
r ~frac:3 86_399_999_499_999_999L 86_399_999_000_000_000L;
|
||||
r ~frac:3 10_001_111_500_000_000L 10_001_112_000_000_000L;
|
||||
r ~frac:3 10_001_111_499_999_999L 10_001_111_000_000_000L;
|
||||
r_carry ~frac:4 86_399_999_950_000_000L;
|
||||
r ~frac:4 86_399_999_949_999_999L 86_399_999_900_000_000L;
|
||||
r ~frac:4 10_001_111_150_000_000L 10_001_111_200_000_000L;
|
||||
r ~frac:4 10_001_111_149_999_999L 10_001_111_100_000_000L;
|
||||
r_carry ~frac:5 86_399_999_995_000_000L;
|
||||
r ~frac:5 86_399_999_994_999_999L 86_399_999_990_000_000L;
|
||||
r ~frac:5 10_001_111_115_000_000L 10_001_111_120_000_000L;
|
||||
r ~frac:5 10_001_111_114_999_999L 10_001_111_110_000_000L;
|
||||
r_carry ~frac:6 86_399_999_999_500_000L;
|
||||
r ~frac:6 86_399_999_999_499_999L 86_399_999_999_000_000L;
|
||||
r ~frac:6 10_001_111_111_500_000L 10_001_111_112_000_000L;
|
||||
r ~frac:6 10_001_111_111_499_999L 10_001_111_111_000_000L;
|
||||
r_carry ~frac:7 86_399_999_999_950_000L;
|
||||
r ~frac:7 86_399_999_999_949_999L 86_399_999_999_900_000L;
|
||||
r ~frac:7 10_001_111_111_150_000L 10_001_111_111_200_000L;
|
||||
r ~frac:7 10_001_111_111_149_999L 10_001_111_111_100_000L;
|
||||
r_carry ~frac:8 86_399_999_999_995_000L;
|
||||
r ~frac:8 86_399_999_999_994_999L 86_399_999_999_990_000L;
|
||||
r ~frac:8 10_001_111_111_115_000L 10_001_111_111_120_000L;
|
||||
r ~frac:8 10_001_111_111_114_999L 10_001_111_111_110_000L;
|
||||
r_carry ~frac:9 86_399_999_999_999_500L;
|
||||
r ~frac:9 86_399_999_999_999_499L 86_399_999_999_999_000L;
|
||||
r ~frac:9 10_001_111_111_111_500L 10_001_111_111_112_000L;
|
||||
r ~frac:9 10_001_111_111_111_499L 10_001_111_111_111_000L;
|
||||
r_carry ~frac:10 86_399_999_999_999_950L;
|
||||
r ~frac:10 86_399_999_999_999_949L 86_399_999_999_999_900L;
|
||||
r ~frac:10 10_001_111_111_111_150L 10_001_111_111_111_200L;
|
||||
r ~frac:10 10_001_111_111_111_149L 10_001_111_111_111_100L;
|
||||
r_carry ~frac:11 86_399_999_999_999_995L;
|
||||
r ~frac:11 86_399_999_999_999_994L 86_399_999_999_999_990L;
|
||||
r ~frac:11 10_001_111_111_111_115L 10_001_111_111_111_120L;
|
||||
r ~frac:11 10_001_111_111_111_114L 10_001_111_111_111_110L;
|
||||
r ~frac:12 86_399_999_999_999_999L 86_399_999_999_999_999L;
|
||||
r ~frac:12 10_001_111_111_111_115L 10_001_111_111_111_115L;
|
||||
r ~frac:12 10_001_111_111_111_114L 10_001_111_111_111_114L;
|
||||
r ~frac:13 10_001_111_111_111_114L 10_001_111_111_111_114L;
|
||||
for i = 0 to 12 do t ~frac:i 0L 0L done;
|
||||
t ~frac:(-1) 86_399_999_999_999_999L 86_399_000_000_000_000L;
|
||||
t ~frac:0 86_399_999_999_999_999L 86_399_000_000_000_000L;
|
||||
t ~frac:1 86_399_999_999_999_999L 86_399_900_000_000_000L;
|
||||
t ~frac:2 86_399_999_999_999_999L 86_399_990_000_000_000L;
|
||||
t ~frac:3 86_399_999_999_999_999L 86_399_999_000_000_000L;
|
||||
t ~frac:4 86_399_999_999_999_999L 86_399_999_900_000_000L;
|
||||
t ~frac:5 86_399_999_999_999_999L 86_399_999_990_000_000L;
|
||||
t ~frac:6 86_399_999_999_999_999L 86_399_999_999_000_000L;
|
||||
t ~frac:7 86_399_999_999_999_999L 86_399_999_999_900_000L;
|
||||
t ~frac:8 86_399_999_999_999_999L 86_399_999_999_990_000L;
|
||||
t ~frac:9 86_399_999_999_999_999L 86_399_999_999_999_000L;
|
||||
t ~frac:10 86_399_999_999_999_999L 86_399_999_999_999_900L;
|
||||
t ~frac:11 86_399_999_999_999_999L 86_399_999_999_999_990L;
|
||||
t ~frac:12 86_399_999_999_999_999L 86_399_999_999_999_999L;
|
||||
t ~frac:13 86_399_999_999_999_999L 86_399_999_999_999_999L;
|
||||
()
|
||||
|
||||
let test_pretty_printing () =
|
||||
Test.test "span retty printing" @@ fun () ->
|
||||
let fmt s = Format.asprintf "%a" Ptime.Span.pp s in
|
||||
let n s = fmt @@ Ptime.Span.(neg (p s)) in
|
||||
let p s = fmt @@ p s in
|
||||
let pps ps = p (0, ps) in
|
||||
let nps ps = n (0, ps) in
|
||||
(* y d *)
|
||||
Test.string ~__POS__ (p (366, 0L)) "1y1d";
|
||||
Test.string ~__POS__ (n (366, 0L)) "-1y1d";
|
||||
Test.string ~__POS__ (p (1461, 0L)) "4y";
|
||||
Test.string ~__POS__ (n (1461, 0L)) "-4y";
|
||||
Test.string ~__POS__ (p (1461, 43_200_000_000_000_000L)) "4y1d";
|
||||
Test.string ~__POS__ (n (1461, 43_200_000_000_000_000L)) "-4y1d";
|
||||
Test.string ~__POS__ (p (1461, 43_199_199_199_199_199L)) "4y";
|
||||
Test.string ~__POS__ (n (1461, 43_199_199_199_199_199L)) "-4y";
|
||||
Test.string ~__POS__ (p (1462, 43_200_000_000_000_000L)) "4y2d";
|
||||
Test.string ~__POS__ (n (1462, 43_200_000_000_000_000L)) "-4y2d";
|
||||
Test.string ~__POS__ (p (1462, 43_199_199_199_199_199L)) "4y1d";
|
||||
Test.string ~__POS__ (n (1462, 43_199_199_199_199_199L)) "-4y1d";
|
||||
(* d h *)
|
||||
Test.string ~__POS__ (p (365, 84_600_000_000_000_000L)) "1y1d";
|
||||
Test.string ~__POS__ (n (365, 84_600_000_000_000_000L)) "-1y1d";
|
||||
Test.string ~__POS__ (p (365, 84_599_999_999_999_999L)) "1y";
|
||||
Test.string ~__POS__ (n (365, 84_599_999_999_999_999L)) "-1y";
|
||||
Test.string ~__POS__ (p (365, 19_800_000_000_000_000L)) "1y";
|
||||
Test.string ~__POS__ (n (365, 19_800_000_000_000_000L)) "-1y";
|
||||
Test.string ~__POS__ (p (365, 19_799_999_999_999_999L)) "365d5h";
|
||||
Test.string ~__POS__ (n (365, 19_799_999_999_999_999L)) "-365d5h";
|
||||
Test.string ~__POS__ (p (1, 84_600_000_000_000_000L)) "2d";
|
||||
Test.string ~__POS__ (n (1, 84_600_000_000_000_000L)) "-2d";
|
||||
Test.string ~__POS__ (p (1, 84_599_999_999_999_999L)) "1d23h";
|
||||
Test.string ~__POS__ (n (1, 84_599_999_999_999_999L)) "-1d23h";
|
||||
Test.string ~__POS__ (p (2, 0L)) "2d";
|
||||
Test.string ~__POS__ (n (2, 0L)) "-2d";
|
||||
(* h m *)
|
||||
Test.string ~__POS__ (pps 86_370_000_000_000_000L) "1d";
|
||||
Test.string ~__POS__ (nps 86_370_000_000_000_000L) "-1d";
|
||||
Test.string ~__POS__ (pps 86_369_999_999_999_999L) "23h59min";
|
||||
Test.string ~__POS__ (nps 86_369_999_999_999_999L) "-23h59min";
|
||||
Test.string ~__POS__ (pps 3660_000_000_000_000L) "1h1min";
|
||||
Test.string ~__POS__ (nps 3660_000_000_000_000L) "-1h1min";
|
||||
Test.string ~__POS__ (pps 3630_000_000_000_000L) "1h1min";
|
||||
Test.string ~__POS__ (pps 3629_999_999_999_999L) "1h";
|
||||
Test.string ~__POS__ (nps 3629_999_999_999_999L) "-1h";
|
||||
Test.string ~__POS__ (pps 3600_000_000_000_000L) "1h";
|
||||
Test.string ~__POS__ (nps 3600_000_000_000_000L) "-1h";
|
||||
(* m s *)
|
||||
Test.string ~__POS__ (pps 3599_500_000_000_000L) "1h";
|
||||
Test.string ~__POS__ (nps 3599_500_000_000_000L) "-1h";
|
||||
Test.string ~__POS__ (pps 3599_499_999_999_999L) "59min59s";
|
||||
Test.string ~__POS__ (nps 3599_499_999_999_999L) "-59min59s";
|
||||
Test.string ~__POS__ (pps 60_500_000_000_000L) "1min1s";
|
||||
Test.string ~__POS__ (nps 60_500_000_000_000L) "-1min1s";
|
||||
Test.string ~__POS__ (pps 60_499_000_000_000L) "1min";
|
||||
Test.string ~__POS__ (nps 60_499_000_000_000L) "-1min";
|
||||
Test.string ~__POS__ (pps 60_000_000_000_000L) "1min";
|
||||
Test.string ~__POS__ (nps 60_000_000_000_000L) "-1min";
|
||||
(* s *)
|
||||
Test.string ~__POS__ (pps 59_999_500_000_000L) "1min";
|
||||
Test.string ~__POS__ (nps 59_999_500_000_000L) "-1min";
|
||||
Test.string ~__POS__ (pps 59_999_499_999_999L) "59.999s";
|
||||
Test.string ~__POS__ (nps 59_999_499_999_999L) "-59.999s";
|
||||
Test.string ~__POS__ (pps 1_999_500_000_000L) "2s";
|
||||
Test.string ~__POS__ (nps 1_999_500_000_000L) "-2s";
|
||||
Test.string ~__POS__ (pps 1_999_499_999_999L) "1.999s";
|
||||
Test.string ~__POS__ (nps 1_999_499_999_999L) "-1.999s";
|
||||
Test.string ~__POS__ (pps 1_534_500_000_000L) "1.535s";
|
||||
Test.string ~__POS__ (nps 1_534_500_000_000L) "-1.535s";
|
||||
Test.string ~__POS__ (pps 1_534_499_999_999L) "1.534s";
|
||||
Test.string ~__POS__ (nps 1_534_499_999_999L) "-1.534s";
|
||||
Test.string ~__POS__ (pps 1_000_000_000_000L) "1s";
|
||||
Test.string ~__POS__ (nps 1_000_000_000_000L) "-1s";
|
||||
Test.string ~__POS__ (pps 1_136_000_000_000L) "1.136s";
|
||||
Test.string ~__POS__ (nps 1_136_000_000_000L) "-1.136s";
|
||||
Test.string ~__POS__ (pps 1_036_000_000_000L) "1.036s";
|
||||
Test.string ~__POS__ (nps 1_036_000_000_000L) "-1.036s";
|
||||
(* ms *)
|
||||
Test.string ~__POS__ (pps 999_500_000_000L) "1s";
|
||||
Test.string ~__POS__ (nps 999_500_000_000L) "-1s";
|
||||
Test.string ~__POS__ (pps 999_499_999_999L) "999ms";
|
||||
Test.string ~__POS__ (nps 999_499_999_999L) "-999ms";
|
||||
Test.string ~__POS__ (pps 1_999_500_000L) "2ms";
|
||||
Test.string ~__POS__ (nps 1_999_500_000L) "-2ms";
|
||||
Test.string ~__POS__ (pps 1_999_499_999L) "1.999ms";
|
||||
Test.string ~__POS__ (nps 1_999_499_999L) "-1.999ms";
|
||||
Test.string ~__POS__ (pps 1_332_500_000L) "1.333ms";
|
||||
Test.string ~__POS__ (nps 1_332_500_000L) "-1.333ms";
|
||||
Test.string ~__POS__ (pps 1_332_499_999L) "1.332ms";
|
||||
Test.string ~__POS__ (nps 1_332_499_999L) "-1.332ms";
|
||||
Test.string ~__POS__ (pps 1_036_000_000L) "1.036ms";
|
||||
Test.string ~__POS__ (nps 1_036_000_000L) "-1.036ms";
|
||||
Test.string ~__POS__ (pps 1_000_000_000L) "1ms";
|
||||
Test.string ~__POS__ (nps 1_000_000_000L) "-1ms";
|
||||
(* us *)
|
||||
Test.string ~__POS__ (pps 999_500_000L) "1ms";
|
||||
Test.string ~__POS__ (nps 999_500_000L) "-1ms";
|
||||
Test.string ~__POS__ (pps 999_499_999L) "999us";
|
||||
Test.string ~__POS__ (nps 999_499_999L) "-999us";
|
||||
Test.string ~__POS__ (pps 1_999_500L) "2us";
|
||||
Test.string ~__POS__ (nps 1_999_500L) "-2us";
|
||||
Test.string ~__POS__ (pps 1_999_499L) "1.999us";
|
||||
Test.string ~__POS__ (nps 1_999_499L) "-1.999us";
|
||||
Test.string ~__POS__ (pps 1_332_500L) "1.333us";
|
||||
Test.string ~__POS__ (nps 1_332_500L) "-1.333us";
|
||||
Test.string ~__POS__ (pps 1_332_499L) "1.332us";
|
||||
Test.string ~__POS__ (nps 1_332_499L) "-1.332us";
|
||||
Test.string ~__POS__ (pps 1_036_000L) "1.036us";
|
||||
Test.string ~__POS__ (nps 1_036_000L) "-1.036us";
|
||||
Test.string ~__POS__ (pps 1_000_000L) "1us";
|
||||
Test.string ~__POS__ (nps 1_000_000L) "-1us";
|
||||
(* ns *)
|
||||
Test.string ~__POS__ (pps 999_500L) "1us";
|
||||
Test.string ~__POS__ (nps 999_500L) "-1us";
|
||||
Test.string ~__POS__ (pps 999_499L) "999ns";
|
||||
Test.string ~__POS__ (nps 999_499L) "-999ns";
|
||||
Test.string ~__POS__ (pps 1_995L) "1.995ns";
|
||||
Test.string ~__POS__ (nps 1_995L) "-1.995ns";
|
||||
Test.string ~__POS__ (pps 1_994L) "1.994ns";
|
||||
Test.string ~__POS__ (nps 1_994L) "-1.994ns";
|
||||
Test.string ~__POS__ (pps 1_332L) "1.332ns";
|
||||
Test.string ~__POS__ (nps 1_332L) "-1.332ns";
|
||||
Test.string ~__POS__ (pps 1_036L) "1.036ns";
|
||||
Test.string ~__POS__ (nps 1_036L) "-1.036ns";
|
||||
Test.string ~__POS__ (pps 1_000L) "1ns";
|
||||
Test.string ~__POS__ (nps 1_000L) "-1ns";
|
||||
(* ps *)
|
||||
Test.string ~__POS__ (pps 999L) "999ps";
|
||||
Test.string ~__POS__ (nps 999L) "-999ps";
|
||||
Test.string ~__POS__ (pps 50L) "50ps";
|
||||
Test.string ~__POS__ (nps 50L) "-50ps";
|
||||
Test.string ~__POS__ (pps 1L) "1ps";
|
||||
Test.string ~__POS__ (nps 1L) "-1ps";
|
||||
Test.string ~__POS__ (pps 0L) "0ps";
|
||||
Test.string ~__POS__ (nps 0L) "0ps";
|
||||
()
|
||||
|
||||
let tests () =
|
||||
test_conversions ();
|
||||
test_predicates ();
|
||||
test_arithmetic ();
|
||||
test_rounding ();
|
||||
test_pretty_printing ();
|
||||
()
|
||||
139
unikernel/duniverse/ptime/test/testing_ptime.ml
Normal file
139
unikernel/duniverse/ptime/test/testing_ptime.ml
Normal file
|
|
@ -0,0 +1,139 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The ptime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Ptime test unit comonalities *)
|
||||
|
||||
open B0_std
|
||||
open B0_testing
|
||||
|
||||
module T = struct
|
||||
|
||||
(* Time spans *)
|
||||
|
||||
let eq_raw_span =
|
||||
let raw_span ppf (d, ps) = Fmt.pf ppf "@[<1>(%d,@ %Ld)@]" d ps in
|
||||
Test.Eq.make ~pp:raw_span ()
|
||||
|
||||
let raw_span ?__POS__ = Test.eq ?__POS__ eq_raw_span
|
||||
|
||||
let eq_span = Test.Eq.make ~equal:Ptime.Span.equal ~pp:Ptime.Span.dump ()
|
||||
let span ?__POS__ = Test.eq ?__POS__ eq_span
|
||||
let span_option ?__POS__ = Test.option ?__POS__ ~some:eq_span
|
||||
|
||||
(* Timestamps *)
|
||||
|
||||
let eq_stamp = Test.Eq.make ~equal:Ptime.equal ~pp:Ptime.dump ()
|
||||
let stamp ?__POS__ = Test.eq ?__POS__ eq_stamp
|
||||
let stamp_option ?__POS__ = Test.option ?__POS__ ~some:eq_stamp
|
||||
|
||||
(* Dates *)
|
||||
|
||||
module Date = struct
|
||||
type t = Ptime.date
|
||||
let equal = ( = )
|
||||
let pp ppf (y,m,d) = Fmt.pf ppf "(%d, %d, %d)" y m d
|
||||
end
|
||||
|
||||
let date ?__POS__ = Test.eq ?__POS__ (module Date)
|
||||
|
||||
(* Date time *)
|
||||
|
||||
module Date_time = struct
|
||||
type t = Ptime.date * Ptime.time
|
||||
let equal = ( = )
|
||||
let pp ppf ((y, m, d), ((hh, mm, ss), tz)) =
|
||||
Fmt.pf ppf "(%d, %d, %d), ((%d, %d, %d), %d)" y m d hh mm ss tz
|
||||
end
|
||||
|
||||
let date_time ?__POS__ = Test.eq ?__POS__ (module Date_time)
|
||||
|
||||
let gmtime_to_date_time t =
|
||||
let t = Ptime.to_float_s t in
|
||||
let t = floor t (* see https://github.com/ocaml/ocaml/issues/6921 *) in
|
||||
let tm = Unix.gmtime t in
|
||||
let d = (tm.Unix.tm_year + 1900), (tm.Unix.tm_mon + 1), (tm.Unix.tm_mday) in
|
||||
let t = tm.Unix.tm_hour, tm.Unix.tm_min, tm.Unix.tm_sec in
|
||||
(d, (t, 0)), tm.Unix.tm_wday
|
||||
|
||||
let date_time_gmtime_witness ?__POS__:pos t =
|
||||
let fail ?__POS__ n ~checks:_ =
|
||||
Test.log_fail ?__POS__ "On stamp %g" (Ptime.to_float_s t)
|
||||
in
|
||||
Test.block ?__POS__:pos ~fail @@ fun () ->
|
||||
let dt, wday = gmtime_to_date_time t in
|
||||
let ut = Ptime.to_date_time t in
|
||||
Test.eq ~__POS__ (module Date_time) dt ut;
|
||||
Test.int ~__POS__ (Ptime.weekday_num t) wday
|
||||
end
|
||||
|
||||
module Rand = struct
|
||||
|
||||
(* Random loop length *)
|
||||
|
||||
let loop_len = ref 100_000
|
||||
let loop_len () = !loop_len
|
||||
|
||||
(* Random Ptime-valid stamps from floats *)
|
||||
|
||||
let float_stamp_range min max =
|
||||
let bound = max -. min in
|
||||
fun () ->
|
||||
let r = Random.State.float (Test.Rand.state ()) bound (* inclusive *) in
|
||||
let stamp = min +. r in
|
||||
match Ptime.(of_float_s stamp) with
|
||||
| None -> Fmt.failwith "cannot convert valid random stamp %f" stamp
|
||||
| Some t -> t
|
||||
|
||||
let float_stamp_32bits =
|
||||
let min_stamp = Int32.(to_float min_int) in
|
||||
let max_stamp = Int32.(to_float max_int) in
|
||||
float_stamp_range min_stamp max_stamp
|
||||
|
||||
let float_stamp : unit -> Ptime.t =
|
||||
let min_stamp = Ptime.(to_float_s min) in
|
||||
let max_stamp = Ptime.(to_float_s max) in
|
||||
float_stamp_range min_stamp max_stamp
|
||||
|
||||
let stamp =
|
||||
if Sys.word_size = 32 then float_stamp_32bits else float_stamp
|
||||
|
||||
(* Random Ptime-valid dates *)
|
||||
|
||||
let date : unit -> (int * int * int) =
|
||||
let month_len = [|31; 28; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31 |] in
|
||||
let is_leap y = (y mod 4 = 0) && (y mod 100 <> 0 || y mod 400 = 0) in
|
||||
fun () ->
|
||||
let rstate = Test.Rand.state () in
|
||||
let rint bound = Random.State.int rstate bound in
|
||||
let y = rint 10_000 in
|
||||
let m = 1 + rint 11 in
|
||||
let m_len = if (m = 2 && is_leap y) then 29 else month_len.(m - 1) in
|
||||
let d = 1 + rint m_len in
|
||||
(y, m, d)
|
||||
|
||||
(* Random times *)
|
||||
|
||||
let tz_interval_s = (1 lsl 30 - 1) (* max of Random.int *)
|
||||
let tz_offset_s : unit -> int =
|
||||
fun () ->
|
||||
let rstate = Test.Rand.state () in
|
||||
(* N.B. We don't cover the whole spectrum *)
|
||||
(Random.State.int rstate tz_interval_s) - (tz_interval_s / 2)
|
||||
|
||||
let min_tz_interval_s = 2000
|
||||
let min_tz_offset_s : unit -> int =
|
||||
fun () ->
|
||||
let rstate = Test.Rand.state () in
|
||||
((Random.State.int rstate min_tz_interval_s) - (min_tz_interval_s / 2)) * 60
|
||||
|
||||
let time : unit -> (int * int * int) =
|
||||
fun () ->
|
||||
let rstate = Test.Rand.state () in
|
||||
let rint bound = Random.State.int rstate bound in
|
||||
let hh = rint 24 in
|
||||
let mm = rint 60 in
|
||||
let ss = rint 61 in
|
||||
(hh, mm, ss)
|
||||
end
|
||||
Loading…
Add table
Add a link
Reference in a new issue