diff options
| author | Stephane Glondu <steph@glondu.net> | 2021-11-22 12:56:45 +0100 |
|---|---|---|
| committer | Stéphane Glondu <steph@glondu.net> | 2021-11-22 12:56:45 +0100 |
| commit | 7422585704c97a5e300dbef86d92cef57b7eca73 (patch) | |
| tree | 4d086bf9354a2b21b9e620c0ff481f8d9dd64ff2 | |
New upstream version 1.3.0
| -rw-r--r-- | B0.ml | 78 | ||||
| -rw-r--r-- | BRZO | 2 | ||||
| -rw-r--r-- | CHANGES.md | 84 | ||||
| -rw-r--r-- | LICENSE.md | 13 | ||||
| -rw-r--r-- | README.md | 49 | ||||
| -rw-r--r-- | _tags | 22 | ||||
| -rwxr-xr-x | build-tests | 15 | ||||
| -rw-r--r-- | doc/index.mld | 11 | ||||
| -rw-r--r-- | myocamlbuild.ml | 61 | ||||
| -rw-r--r-- | opam | 36 | ||||
| -rw-r--r-- | pkg/META | 45 | ||||
| -rwxr-xr-x | pkg/pkg.ml | 26 | ||||
| -rw-r--r-- | src-jsoo/mtime_clock.ml | 98 | ||||
| -rw-r--r-- | src-jsoo/mtime_clock.mli | 125 | ||||
| -rw-r--r-- | src-jsoo/mtime_clock.mllib | 1 | ||||
| -rw-r--r-- | src-os/libmtime_clock_stubs.clib | 1 | ||||
| -rw-r--r-- | src-os/mtime_clock.ml | 40 | ||||
| -rw-r--r-- | src-os/mtime_clock.mli | 125 | ||||
| -rw-r--r-- | src-os/mtime_clock.mllib | 1 | ||||
| -rw-r--r-- | src-os/mtime_clock_stubs.c | 227 | ||||
| -rw-r--r-- | src/mtime.ml | 184 | ||||
| -rw-r--r-- | src/mtime.mli | 262 | ||||
| -rw-r--r-- | src/mtime.mllib | 1 | ||||
| -rw-r--r-- | src/mtime_clock.mli | 125 | ||||
| -rw-r--r-- | src/mtime_top.ml | 22 | ||||
| -rw-r--r-- | src/mtime_top.mllib | 1 | ||||
| -rw-r--r-- | src/mtime_top_init.ml | 23 | ||||
| -rw-r--r-- | test-jsoo/test_jsoo.html | 48 | ||||
| -rw-r--r-- | test-jsoo/test_jsoo.ml | 42 | ||||
| -rw-r--r-- | test-jsoo/test_node.ml | 22 | ||||
| -rw-r--r-- | test-jsoo/tests.ml | 275 | ||||
| -rw-r--r-- | test-os/min_os.ml | 15 | ||||
| -rw-r--r-- | test-os/test.ml | 22 | ||||
| -rw-r--r-- | test-os/tests.ml | 275 |
34 files changed, 2377 insertions, 0 deletions
@@ -0,0 +1,78 @@ +open B0_kit.V000 +open B00_std +open Result.Syntax + +(* OCaml library names *) + +let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel" +let js_of_ocaml = B0_ocaml.libname "js_of_ocaml" + +let mtime = B0_ocaml.libname "mtime" +let mtime_top = B0_ocaml.libname "mtime.top" +let mtime_clock_os = B0_ocaml.libname "mtime.clock.os" +let mtime_clock_jsoo = B0_ocaml.libname "mtime.clock.jsoo" + +(* Libraries *) + +let mtime_lib = + let srcs = Fpath.[`File (v "src/mtime.mli"); `File (v "src/mtime.ml")] in + let requires = [] in + B0_ocaml.lib mtime ~doc:"The mtime library" ~srcs ~requires + +let mtime_top = + let srcs = Fpath.[`File (v "src/mtime_top.ml")] in + let requires = [compiler_libs_toplevel] in + B0_ocaml.lib mtime_top ~doc:"The mtime.top library" ~srcs ~requires + +let mtime_clock_os_lib = + let srcs = Fpath.[`Dir (v "src-os") ] in + let requires = [mtime] in + B0_ocaml.lib mtime_clock_os ~doc:"The mtime clock OS library" ~srcs ~requires + +let mtime_clock_jsoo_lib = + let srcs = Fpath.[`Dir (v "src-jsoo") ] in + let requires = [mtime; js_of_ocaml] in + let doc = "The mtime clock JSOO library" in + B0_ocaml.lib mtime_clock_jsoo ~doc ~srcs ~requires + +(* Tests *) + +let test = + let srcs = Fpath.[`File (v "test-os/test.ml"); + `File (v "test-os/tests.ml")] + in + let meta = B0_meta.(empty |> tag test) in + let requires = [ mtime; mtime_clock_os ] in + B0_ocaml.exe "test" ~doc:"Test suite" ~srcs ~meta ~requires + +(* Packs *) + +let default = + let meta = + let open B0_meta in + empty + |> tag B0_opam.tag + |> add authors ["The mtime programmers"] + |> add maintainers ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"] + |> add homepage "https://erratique.ch/software/mtime" + |> add online_doc "https://erratique.ch/software/mtime/doc/" + |> add licenses ["ISC"] + |> add repo "git+https://erratique.ch/repos/mtime.git" + |> add issues "https://github.com/dbuenzli/mtime/issues" + |> add description_tags + ["time"; "monotonic"; "system"; "org:erratique"] + |> add B0_opam.Meta.depopts ["js_of_ocaml", ""] + |> add B0_opam.Meta.conflicts + [ "js_of_ocaml", {|<= "3.3.0"|}] + |> add B0_opam.Meta.depends + [ "ocaml", {|>= "4.03.0"|}; + "ocamlfind", {|build|}; + "ocamlbuild", {|build|}; + "topkg", {|build & >= "1.0.3"|}; + ] + |> add B0_opam.Meta.build + {|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%" + "--with-js_of_ocaml" "%{js_of_ocaml:installed}%"]]|} + in + B0_pack.v "default" ~doc:"mtime package" ~meta ~locked:true @@ + B0_unit.list () @@ -0,0 +1,2 @@ +(srcs-x pkg test-jsoo test-os myocamlbuild.ml + src/mtime_top.ml src/mtime_top_init.ml)
\ No newline at end of file diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 index 0000000..10e52ed --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,84 @@ +v1.3.0 2021-10-20 Zagreb +------------------------ + +* Add Windows support. Thanks to Andreas Hauptmann for the patch + and Corentin Leruth for the integration. + +v1.2.0 2019-07-19 Zagreb +------------------------ + +* Add support for node.js. Thanks to Fabian (@copy) for the patch. +* Support for js_of_ocaml 3.4.0. +* Add MTIME_OS environment variable for specifying the OS at build time. + +v1.1.0 2017-06-24 London +------------------------ + +* Add `Mtime.Span.{add,zero,one,min_span,max_span}`. + +v1.0.0 2017-05-09 La Forclaz (VS) +--------------------------------- + +This is a major breaking release with a new API. Thanks to David +Sheets for contributions and discussions. The API was changed to +mirror and follow the conventions and design of `Ptime`. The `Mtime` +module now only provides platform independent datatypes for supporting +monotonic clock readings. Platform dependent access to monotonic +clocks is provided by the `Mtime_clock` modules. The `Mtime.t` type +was added for monotonic timestamps. + +* Rename packages `mtime.{jsoo,os}` to `mtime.{clock.jsoo,clock.os}` + which implement the new `Mtime_clock` interface. The `mtime` package + has the platform independent support. +* Remove `Mtime.available`, `Mtime_clock` functions now raise `Sys_error` + on unsupported platforms or errors. +* Add a raw interface to `Mtime_clock` which statisfies MirageOS's monotonic + clock signature. +* Move `Mtime.{elapsed,counter,count}` to + `Mtime_clock.{elapsed,counter,count}`. +* Add `Mtime.t` a type to represent system-relative monotonic + timestamps and related functions. Thanks to David Sheets for the + patch and his patience. +* Add the `Mtime.Span` module for functions on monotonic time + spans. Most of the previous platform independent support is now + provided by this module. See below. +* Move `Mtime.to_ns_uint64` to `Mtime.Span.to_uint64_ns`. +* Move other `Mtime.to_*` to `Mtime.Span.to_*`. +* Move `Mtime.pp_span[_s]` to `Mtime.Span.pp[_float__s]`. +* Add `Mtime.Span.{compare,equal}`. Thanks to David Sheets for the patch. +* Add `Mtime.Span.of_uint64_ns`. Thanks to David Sheets for the patch. + +v0.8.4 2017-02-05 La Forclaz (VS) +--------------------------------- + +* Fix package for -custom linking. Thanks to @orbitz for the report. +* Build depend on topkg. +* Relicense from BSD3 to ISC. + +v0.8.3 2015-12-22 Cambridge (UK) +-------------------------------- + +* Fix Linux bytecode builds. Thanks to Edwin Török for the report. +* Really make js_of_ocaml an optional dependency. + + +v0.8.2 2015-05-17 La Forclaz (VS) +--------------------------------- + +* Simpler toploop support (internal change). +* Improve Linux build support by recording link flags against librt in + the cma and cmxa (this seems to be needed in certain distributions). + Thanks to David Scott for the report and the fix. + + +v0.8.1 2015-03-23 La Forclaz (VS) +--------------------------------- + +* Fix broken arithmetic on 32-bit platform with POSIX clocks. Thanks to + Stephen Dolan for the report and the fix. + + +v0.8.0 2015-03-19 La Forclaz (VS) +--------------------------------- + +First release. diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..091d4b0 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,13 @@ +Copyright (c) 2015 The mtime 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. diff --git a/README.md b/README.md new file mode 100644 index 0000000..32d8023 --- /dev/null +++ b/README.md @@ -0,0 +1,49 @@ +Mtime — Monotonic wall-clock time for OCaml +------------------------------------------------------------------------------- +v1.3.0 + +Mtime has platform independent support for monotonic wall-clock time +in pure OCaml. This time increases monotonically and is not subject to +operating system calendar time adjustments. The library has types to +represent nanosecond precision timestamps and time spans. + +The additional Mtime_clock library provide access to a system +monotonic clock. + +Mtime has a no dependency. Mtime_clock depends on your system library. +The optional JavaScript support depends on [js_of_ocaml][jsoo]. Mtime +and its libraries are distributed under the ISC license. + +[jsoo]: http://ocsigen.org/js_of_ocaml/ + +Home page: http://erratique.ch/software/mtime + +## Installation + +Mtime can be installed with `opam`: + + opam install mtime + opam install js_of_ocaml mtime # mtime with jsoo support + +If you don't use `opam` consult the [`opam`](opam) file for build +instructions. + +## Documentation + +The documentation and API reference is automatically generated from +the source interfaces. It can be consulted [online][doc] or via +`odig doc mtime`. + +[doc]: http://erratique.ch/software/mtime/doc + + +## Sample programs + +If you installed mtime with `opam` sample programs are located in +the directory `opam config var mtime:doc`. + +In the distribution sample programs and tests are located in the +`test*` directories. They can be built and run with: + + topkg build --tests true && topkg test + @@ -0,0 +1,22 @@ +true : bin_annot, safe_string + +# Ideally we should not have this and use_mtime +# would give us the right link order, see +# https://github.com/ocaml/ocamlbuild/issues/122 +<src> : include + +<src/mtime_top*> : package(compiler-libs.toplevel) + +<src-os/mtime_clock.{cma,cmxa}> : record_mtime_clock_os_stubs +<src-os/mtime_clock.cmxs> : link_mtime_clock_os_stubs + +# use_mtime is missing, see above +<test-os/*> : use_mtime_clock_os +<test-os/test.byte> : custom + +<{src,test}-jsoo/*> : package(js_of_ocaml) + +# use_mtime is missing, see above +<test-jsoo/*> : use_mtime_clock_jsoo + +<_b0> : -traverse
\ No newline at end of file diff --git a/build-tests b/build-tests new file mode 100755 index 0000000..66e7d99 --- /dev/null +++ b/build-tests @@ -0,0 +1,15 @@ +#!/bin/sh + +# Work around https://github.com/ocaml/ocamlbuild/issues/122 + +set -e + +OCAMLBUILD=${OCAMLBUILD:="ocamlbuild -tag debug -classic-display \ + -no-links -use-ocamlfind" } + +$OCAMLBUILD -I src -I src-jsoo \ + test-jsoo/test_node.js test-jsoo/test_jsoo.js test-jsoo/test_jsoo.html + +$OCAMLBUILD -I src -I src-os \ + test-os/min_os.byte test-os/min_os.native \ + test-os/test.byte test-os/test.native diff --git a/doc/index.mld b/doc/index.mld new file mode 100644 index 0000000..4dc6af6 --- /dev/null +++ b/doc/index.mld @@ -0,0 +1,11 @@ +{0 Mtime {%html: <span class="version">v1.3.0</span>%}} + +Mtime has platform independent support for monotonic wall-clock time +in pure OCaml. + +{1:api API} + +{!modules: +Mtime +Mtime_clock +} diff --git a/myocamlbuild.ml b/myocamlbuild.ml new file mode 100644 index 0000000..a1d9bab --- /dev/null +++ b/myocamlbuild.ml @@ -0,0 +1,61 @@ + +open Ocamlbuild_plugin +open Command + +let os = try Sys.getenv "MTIME_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 js_rule () = + let dep = "%.byte" in + let prod = "%.js" in + let f env _ = + let dep = env dep in + let prod = env prod in + let tags = tags_of_pathname prod ++ "js_of_ocaml" in + Cmd (S [A "js_of_ocaml"; T tags; A "-o"; + Px prod; P dep]) + in + rule "js_of_ocaml: .byte -> .js" ~dep ~prod f + +let lib s = + match !Ocamlbuild_plugin.Options.ext_lib with + | "" -> s ^ ".a" + | x -> s ^ "." ^ x + +let () = + dispatch begin function + | After_rules -> + js_rule (); + + (* mtime *) + + ocaml_lib ~tag_name:"use_mtime" ~dir:"src" "src/mtime"; + + (* mtime-clock-os *) + + dep ["record_mtime_clock_os_stubs"] ["src-os/libmtime_clock_stubs.a"]; + flag_and_dep + ["link"; "ocaml"; "link_mtime_clock_os_stubs"] + (P (lib "src-os/libmtime_clock_stubs")); + flag ["library"; "ocaml"; "byte"; "record_mtime_clock_os_stubs"] + (S ([A "-dllib"; A "-lmtime_clock_stubs"] @ system_support_lib)); + flag ["library"; "ocaml"; (* byte and native *) + "record_mtime_clock_os_stubs"] + (S ([A "-cclib"; A "-lmtime_clock_stubs"] @ system_support_lib)); + + ocaml_lib ~tag_name:"use_mtime_clock_os" + ~dir:"src-os" "src-os/mtime_clock"; + flag ["link"; "ocaml"; "use_mtime_clock_os"] + (S [A "-ccopt"; A "-Lsrc-os"]); + + (* mtime-jsoo *) + ocaml_lib ~tag_name:"use_mtime_clock_jsoo" ~dir:"src-jsoo" + "src-jsoo/mtime_clock"; + + | _ -> () + end @@ -0,0 +1,36 @@ +version: "1.3.0" +opam-version: "2.0" +name: "mtime" +synopsis: """Monotonic wall-clock time for OCaml""" +maintainer: ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"] +authors: ["The mtime programmers"] +homepage: "https://erratique.ch/software/mtime" +doc: "https://erratique.ch/software/mtime/doc/" +dev-repo: "git+https://erratique.ch/repos/mtime.git" +bug-reports: "https://github.com/dbuenzli/mtime/issues" +license: ["ISC"] +tags: ["time" "monotonic" "system" "org:erratique"] +depends: ["ocaml" {>= "4.03.0"} + "ocamlfind" {build} + "ocamlbuild" {build} + "topkg" {build & >= "1.0.3"}] +depopts: ["js_of_ocaml"] +conflicts: ["js_of_ocaml" {<= "3.3.0"}] +build: [["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%" + "--with-js_of_ocaml" "%{js_of_ocaml:installed}%"]] +description: """ +Mtime has platform independent support for monotonic wall-clock time +in pure OCaml. This time increases monotonically and is not subject to +operating system calendar time adjustments. The library has types to +represent nanosecond precision timestamps and time spans. + +The additional Mtime_clock library provide access to a system +monotonic clock. + +Mtime has a no dependency. Mtime_clock depends on your system library. +The optional JavaScript support depends on [js_of_ocaml][jsoo]. Mtime +and its libraries are distributed under the ISC license. + +[jsoo]: http://ocsigen.org/js_of_ocaml/ + +Home page: http://erratique.ch/software/mtime""" diff --git a/pkg/META b/pkg/META new file mode 100644 index 0000000..7dbe8b7 --- /dev/null +++ b/pkg/META @@ -0,0 +1,45 @@ +description = "Monotonic wall-clock time for OCaml" +version = "1.3.0" +requires = "" +archive(byte) = "mtime.cma" +archive(native) = "mtime.cmxa" +plugin(byte) = "mtime.cma" +plugin(native) = "mtime.cmxs" + +package "top" ( + description = "Mtime toplevel support" + version = "1.3.0" + requires = "mtime" + archive(byte) = "mtime_top.cma" + archive(native) = "mtime_top.cmxa" + plugin(byte) = "mtime_top.cma" + plugin(native) = "mtime_top.cmxs" +) + +package "clock" ( + description = "Monotonic time clocks" + version = "1.3.0" + requires = "" + + package "os" ( + directory="os" + description = "Mtime_clock for native OS" + version = "1.3.0" + requires = "mtime" + archive(byte) = "mtime_clock.cma" + archive(native) = "mtime_clock.cmxa" + plugin(byte) = "mtime_clock.cma" + plugin(native) = "mtime_clock.cmxs" + exists_if = "mtime_clock.cma" ) + + package "jsoo" ( + directory="jsoo" + description = "Mtime_clock for js_of_ocaml" + version = "1.3.0" + requires = "mtime js_of_ocaml" + archive(byte) = "mtime_clock.cma" + archive(native) = "mtime_clock.cmxa" + plugin(byte) = "mtime_clock.cma" + plugin(native) = "mtime_clock.cmxs" + exists_if = "mtime_clock.cma" ) +) diff --git a/pkg/pkg.ml b/pkg/pkg.ml new file mode 100755 index 0000000..634ef76 --- /dev/null +++ b/pkg/pkg.ml @@ -0,0 +1,26 @@ +#!/usr/bin/env ocaml +#use "topfind" +#require "topkg" +open Topkg + +let jsoo = Conf.with_pkg "js_of_ocaml" + +let () = + Pkg.describe "mtime" @@ fun c -> + let jsoo = Conf.value c jsoo in + Ok [ Pkg.mllib "src/mtime.mllib"; + Pkg.mllib ~api:[] "src/mtime_top.mllib"; + Pkg.lib "src/mtime_top_init.ml"; + Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld"; + Pkg.mllib "src-os/mtime_clock.mllib" ~dst_dir:"os/"; + Pkg.clib "src-os/libmtime_clock_stubs.clib" ~lib_dst_dir:"os/"; + Pkg.mllib ~cond:jsoo "src-jsoo/mtime_clock.mllib" ~dst_dir:"jsoo"; +(* Unable to find a way to convince ocamlbuild to make these work + because of https://github.com/ocaml/ocamlbuild/issues/122 + + Pkg.test "test-os/min_os"; + Pkg.test "test-os/test"; + Pkg.test ~run:false ~cond:jsoo ~auto:false "test-jsoo/test_jsoo.js"; + Pkg.test ~run:false ~cond:jsoo ~auto:false "test-jsoo/test_jsoo.html"; +*) + Pkg.doc "test-os/min_os.ml" ] diff --git a/src-jsoo/mtime_clock.ml b/src-jsoo/mtime_clock.ml new file mode 100644 index 0000000..9604059 --- /dev/null +++ b/src-jsoo/mtime_clock.ml @@ -0,0 +1,98 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Js_of_ocaml + +let us_to_ns = 1000L (* microsecond to nanosecond uint64 multiplier *) + +(* Get a handle on JavaScript's performance.now *) + +let performance_now_ms_unavailable () = + raise (Sys_error ("performance.now () is not available")) + +let performance_now_ms = + let has_perf = Js.Unsafe.get Dom_html.window "performance" in + match Js.Optdef.to_option has_perf with + | None -> + let typeof_require = Js.typeof (Js.Unsafe.pure_js_expr "require") in + if Js.to_string typeof_require = "function" then + let require = Js.Unsafe.pure_js_expr "require" in + let args = [| Js.Unsafe.inject (Js.string "perf_hooks") |] in + let perf_hooks = Js.Unsafe.fun_call require args in + let performance = Js.Unsafe.get perf_hooks "performance" in + fun () -> Js.Unsafe.meth_call performance "now" [||] + else + performance_now_ms_unavailable + | Some p -> + if Js.Optdef.test (Js.Unsafe.get p "now") then + fun () -> Js.Unsafe.meth_call p "now" [||] + else + performance_now_ms_unavailable + +(* Conversion of DOMHighResTimeStamp to uint64 nanosecond timestamps. + + The spec https://www.w3.org/TR/hr-time-3 says DOMHighResTimeStamp + are double milliseconds that *should* be accurate to 5 microseconds. + We simply assume we have microsecond precision and multiply the + stamps given by performance.now () by 1e3 to get double microseconds. + + We then use Int64.of_float on these double microseconds to get an + uint64 in microseconds. This works in practice for the following + reasons. Let us assume we have the largest integer microsecond + timestamp representable exactly in double, i.e. 2^53 : + + 1) Assuming the zero of performance.now is when the tab is created, + our 2^53 timestamp only occurs after: + + 2^53 / 1_000_000 / (24 * 3600 * 365.25) ≅ 285.4 Julian years + + 2) 2^53 < Int64.max_int = 2^63 - 1, so seing the result of + Int64.of_float as unsigned for this timestamp is correct and in + the defined domain of the conversion function (the truncated float + must lie in [Int64.min_int;Int64.max_int] for defined behaviour). + + So the Int64.of_float conversion is unlikely to be problematic and + we simply bring the resulting uint64 microsecond to an uint64 + nanosecond by multiplying by 1000L, which for 2^53 microseconds + remains smaller than Int64.max_int, yielding a correct uint64 + nanosecond timestamp for a reasonable time range. *) + +(* Raw interface *) + +let now_us () = performance_now_ms () *. 1e3 + +let start_us = now_us () +let elapsed_ns () = Int64.(mul (of_float @@ now_us () -. start_us) us_to_ns) +let now_ns () = Int64.(mul (of_float @@ now_us ()) us_to_ns) +let period_ns () = None + +(* Monotonic clock *) + +let elapsed () = Mtime.Span.of_uint64_ns (elapsed_ns ()) +let now () = Mtime.of_uint64_ns (now_ns ()) +let period () = Mtime.Span.unsafe_of_uint64_ns_option (period_ns ()) + +(* Counters *) + +type counter = float +let counter = now_us +let count c = + Mtime.Span.of_uint64_ns (Int64.(mul (of_float @@ now_us () -. c)) us_to_ns) + +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/src-jsoo/mtime_clock.mli b/src-jsoo/mtime_clock.mli new file mode 100644 index 0000000..72c78f2 --- /dev/null +++ b/src-jsoo/mtime_clock.mli @@ -0,0 +1,125 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Monotonic time clock. + + [Mtime_clock] provides access to a system monotonic clock. This + time increases monotonically and is not subject to operating + system calendar time adjustments. + + Only use {!Mtime_clock.now} if you need inter-process time + correlation, otherwise prefer {!Mtime_clock.elapsed} and + {{!Mtime_clock.counters}counters}. + + Consult important information about {{!err}error handling} + and {{!platform_support}platform support}. + + Concrete implementation of this interfaces are provided by the + [mtime.clock.os] and [mtime.clock.jsoo] packages against which you + should compile depending on your target. *) + +(** {1:clock Monotonic clock} *) + +val elapsed : unit -> Mtime.span +(** [elapsed ()] is the monotonic time span elapsed since the + beginning of the program. + + @raise Sys_error see {{!err}error handling} *) + +val now : unit -> Mtime.t +(** [now ()] is the current system-relative monotonic timestamp. Its + absolute value is meaningless. + + @raise Sys_error see {{!err}error handling} *) + +val period : unit -> Mtime.span option +(** [period ()] is the clock's period as a monotonic time span (if + available). *) + +(** {1:counters Time counters} *) + +type counter +(** The type for monotonic wall-clock time counters. *) + +val counter : unit -> counter +(** [counter ()] is a counter counting from now on. + + @raise Sys_error see {{!err}error handling} *) + +val count : counter -> Mtime.span +(** [count c] is the monotonic time span elapsed since [c] was created. *) + +(** {1:raw Monotonic clock raw interface} *) + +val elapsed_ns : unit -> int64 +(** [elapsed_ns ()] is the {e unsigned} 64-bit integer nanosecond monotonic + time span elapsed since the beginning of the program. + + @raise Sys_error see {{!err}error handling} *) + +val now_ns : unit -> int64 +(** [now_ns ()] is an {e unsigned} 64-bit integer nanosecond + system-relative monotonic timestamp. The absolute value is + meaningless. + + @raise Sys_error see {{!err}error handling} *) + +val period_ns : unit -> int64 option +(** [period_ns ()] is the clock's period as an {e unsigned} 64-bit + integer nanosecond monotonic time span (if available). *) + +(** {1:err Error handling} + + The functions {!elapsed}, {!now}, {!val-counter}, {!elapsed_ns} and + {!now_ns} raise [Sys_error] whenever they can't determine the + current time or that it doesn't fit in [Mtime]'s range. Usually + 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_MONOTONIC.} + {- Darwin uses + {{:https://developer.apple.com/library/mac/qa/qa1398/_index.html}[mach_absolute_time]}.} + {- Windows uses + {{:https://msdn.microsoft.com/en-us/library/windows/desktop/aa373083%28v=vs.85%29.aspx}Performance counters}. } + {- JavaScript uses + {{:http://www.w3.org/TR/hr-time/}[performance.now]} (consult + {{:http://caniuse.com/#feat=high-resolution-time}availability}) + which returns a + {{:http://www.w3.org/TR/hr-time/#sec-DOMHighResTimeStamp}double + floating point value} in milliseconds with + resolution up to the microsecond.} + {- JavaScript running on Node.js uses the built-in + {{:https://nodejs.org/api/perf_hooks.html#perf_hooks_performance_now}[perf_hooks]} + module, which provides an interface compatible to the [performance] + module in browsers.}} +*) + + +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/src-jsoo/mtime_clock.mllib b/src-jsoo/mtime_clock.mllib new file mode 100644 index 0000000..11e2547 --- /dev/null +++ b/src-jsoo/mtime_clock.mllib @@ -0,0 +1 @@ +Mtime_clock
\ No newline at end of file diff --git a/src-os/libmtime_clock_stubs.clib b/src-os/libmtime_clock_stubs.clib new file mode 100644 index 0000000..3ea2529 --- /dev/null +++ b/src-os/libmtime_clock_stubs.clib @@ -0,0 +1 @@ +mtime_clock_stubs.o diff --git a/src-os/mtime_clock.ml b/src-os/mtime_clock.ml new file mode 100644 index 0000000..1a6219c --- /dev/null +++ b/src-os/mtime_clock.ml @@ -0,0 +1,40 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Raw interface *) + +external elapsed_ns : unit -> int64 = "ocaml_mtime_clock_elapsed_ns" +external now_ns : unit -> int64 = "ocaml_mtime_clock_now_ns" +external period_ns : unit -> int64 option = "ocaml_mtime_clock_period_ns" + +let () = ignore (elapsed_ns ()) (* Initalize elapsed_ns's origin. *) + +(* Monotonic clock *) + +let elapsed () = Mtime.Span.of_uint64_ns (elapsed_ns ()) +let now () = Mtime.of_uint64_ns (now_ns ()) +let period () = Mtime.Span.unsafe_of_uint64_ns_option (period_ns ()) + +(* Counters *) + +type counter = int64 +let counter = elapsed_ns +let count c = Mtime.Span.of_uint64_ns (Int64.sub (elapsed_ns ()) c) + +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/src-os/mtime_clock.mli b/src-os/mtime_clock.mli new file mode 100644 index 0000000..72c78f2 --- /dev/null +++ b/src-os/mtime_clock.mli @@ -0,0 +1,125 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Monotonic time clock. + + [Mtime_clock] provides access to a system monotonic clock. This + time increases monotonically and is not subject to operating + system calendar time adjustments. + + Only use {!Mtime_clock.now} if you need inter-process time + correlation, otherwise prefer {!Mtime_clock.elapsed} and + {{!Mtime_clock.counters}counters}. + + Consult important information about {{!err}error handling} + and {{!platform_support}platform support}. + + Concrete implementation of this interfaces are provided by the + [mtime.clock.os] and [mtime.clock.jsoo] packages against which you + should compile depending on your target. *) + +(** {1:clock Monotonic clock} *) + +val elapsed : unit -> Mtime.span +(** [elapsed ()] is the monotonic time span elapsed since the + beginning of the program. + + @raise Sys_error see {{!err}error handling} *) + +val now : unit -> Mtime.t +(** [now ()] is the current system-relative monotonic timestamp. Its + absolute value is meaningless. + + @raise Sys_error see {{!err}error handling} *) + +val period : unit -> Mtime.span option +(** [period ()] is the clock's period as a monotonic time span (if + available). *) + +(** {1:counters Time counters} *) + +type counter +(** The type for monotonic wall-clock time counters. *) + +val counter : unit -> counter +(** [counter ()] is a counter counting from now on. + + @raise Sys_error see {{!err}error handling} *) + +val count : counter -> Mtime.span +(** [count c] is the monotonic time span elapsed since [c] was created. *) + +(** {1:raw Monotonic clock raw interface} *) + +val elapsed_ns : unit -> int64 +(** [elapsed_ns ()] is the {e unsigned} 64-bit integer nanosecond monotonic + time span elapsed since the beginning of the program. + + @raise Sys_error see {{!err}error handling} *) + +val now_ns : unit -> int64 +(** [now_ns ()] is an {e unsigned} 64-bit integer nanosecond + system-relative monotonic timestamp. The absolute value is + meaningless. + + @raise Sys_error see {{!err}error handling} *) + +val period_ns : unit -> int64 option +(** [period_ns ()] is the clock's period as an {e unsigned} 64-bit + integer nanosecond monotonic time span (if available). *) + +(** {1:err Error handling} + + The functions {!elapsed}, {!now}, {!val-counter}, {!elapsed_ns} and + {!now_ns} raise [Sys_error] whenever they can't determine the + current time or that it doesn't fit in [Mtime]'s range. Usually + 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_MONOTONIC.} + {- Darwin uses + {{:https://developer.apple.com/library/mac/qa/qa1398/_index.html}[mach_absolute_time]}.} + {- Windows uses + {{:https://msdn.microsoft.com/en-us/library/windows/desktop/aa373083%28v=vs.85%29.aspx}Performance counters}. } + {- JavaScript uses + {{:http://www.w3.org/TR/hr-time/}[performance.now]} (consult + {{:http://caniuse.com/#feat=high-resolution-time}availability}) + which returns a + {{:http://www.w3.org/TR/hr-time/#sec-DOMHighResTimeStamp}double + floating point value} in milliseconds with + resolution up to the microsecond.} + {- JavaScript running on Node.js uses the built-in + {{:https://nodejs.org/api/perf_hooks.html#perf_hooks_performance_now}[perf_hooks]} + module, which provides an interface compatible to the [performance] + module in browsers.}} +*) + + +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/src-os/mtime_clock.mllib b/src-os/mtime_clock.mllib new file mode 100644 index 0000000..b969023 --- /dev/null +++ b/src-os/mtime_clock.mllib @@ -0,0 +1 @@ +Mtime_clock diff --git a/src-os/mtime_clock_stubs.c b/src-os/mtime_clock_stubs.c new file mode 100644 index 0000000..918837a --- /dev/null +++ b/src-os/mtime_clock_stubs.c @@ -0,0 +1,227 @@ +/*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime programmers. All rights reserved. + Distributed under the ISC license, see license at the end of the file. + mtime release v1.3.0 + --------------------------------------------------------------------------*/ + +#include <caml/mlvalues.h> +#include <caml/alloc.h> +#include <caml/memory.h> +#include <caml/fail.h> + +#include <stdint.h> + +#define Val_none Val_int(0) +#define OCAML_MTIME_RAISE_SYS_ERROR(ERR) \ + do { caml_raise_sys_error (caml_copy_string("Mtime_clock: " ERR)); } \ + while (0) + +/* Detect platform */ + +#if defined(__APPLE__) && defined(__MACH__) + #define OCAML_MTIME_DARWIN + +#elif defined(__unix__) || defined(__unix) + #include <unistd.h> + #if defined(_POSIX_VERSION) + #define OCAML_MTIME_POSIX + #endif +#elif defined(_WIN32) +#define OCAML_MTIME_WINDOWS +#endif + +/* Darwin */ + +#if defined(OCAML_MTIME_DARWIN) + +#include <mach/mach_time.h> + +static mach_timebase_info_data_t scale = {0}; + +void ocaml_mtime_clock_init_scale (void) +{ + if (mach_timebase_info (&scale) != KERN_SUCCESS) + OCAML_MTIME_RAISE_SYS_ERROR ("mach_timebase_info () failed"); + + if (scale.denom == 0) + OCAML_MTIME_RAISE_SYS_ERROR ("mach_timebase_info_data.denom is 0"); +} + +CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit) +{ + static uint64_t start = 0L; + if (start == 0L) { start = mach_absolute_time (); } + if (scale.denom == 0) { ocaml_mtime_clock_init_scale (); } + uint64_t now = mach_absolute_time (); + return caml_copy_int64 (((now - start) * scale.numer) / scale.denom); +} + +CAMLprim value ocaml_mtime_clock_now_ns (value unit) +{ + if (scale.denom == 0) { ocaml_mtime_clock_init_scale (); } + uint64_t now = mach_absolute_time (); + return caml_copy_int64 ((now * scale.numer) / scale.denom); +} + +CAMLprim value ocaml_mtime_clock_period_ns (value unit) +{ return Val_none; } + +/* POSIX */ + +#elif defined(OCAML_MTIME_POSIX) + +#include <time.h> + +CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit) +{ + static struct timespec start = {0}; + struct timespec now; + + if (start.tv_sec == 0) + { + if (clock_gettime (CLOCK_MONOTONIC, &start)) + OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed"); + } + + if (clock_gettime (CLOCK_MONOTONIC, &now)) + OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed"); + + return caml_copy_int64 ((uint64_t)(now.tv_sec - start.tv_sec) * + (uint64_t)1000000000 + + (uint64_t)(now.tv_nsec - start.tv_nsec)); +} + +CAMLprim value ocaml_mtime_clock_now_ns (value unit) +{ + struct timespec now; + + if (clock_gettime (CLOCK_MONOTONIC, &now)) + OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed"); + + return caml_copy_int64 ((uint64_t)(now.tv_sec) * + (uint64_t)1000000000 + + (uint64_t)(now.tv_nsec)); +} + +CAMLprim value ocaml_mtime_clock_period_ns (value unit) +{ + CAMLparam1 (unit); + CAMLlocal1 (some); + struct timespec res; + + if (clock_getres (CLOCK_MONOTONIC, &res)) { CAMLreturn (Val_none); } + + /* 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); + Store_field (some, 0, + caml_copy_int64 ((uint64_t)(res.tv_sec) * + (uint64_t)1000000000 + + (uint64_t)(res.tv_nsec))); + CAMLreturn (some); +} + +#elif defined(OCAML_MTIME_WINDOWS) +#define WIN32_LEAN_AND_MEAN +#include <windows.h> + +static double performance_frequency; +static void set_performance_frequency(void) +{ + LARGE_INTEGER t_freq; + if (!QueryPerformanceFrequency(&t_freq)) { + OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed"); + } + performance_frequency = (1000000000.0 / t_freq.QuadPart); +} + +CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit) +{ + (void) unit; + static LARGE_INTEGER start; + if (performance_frequency == 0.0) { + set_performance_frequency(); + } + if ( start.QuadPart == 0 ) + { + if (!QueryPerformanceCounter(&start)) { + OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed"); + } + } + static LARGE_INTEGER now; + if ( !QueryPerformanceCounter(&now)) { + OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed"); + } + uint64_t ret = (now.QuadPart - start.QuadPart) * performance_frequency; + return caml_copy_int64(ret); +} + +CAMLprim value ocaml_mtime_clock_now_ns (value unit) +{ + (void) unit; + if (performance_frequency == 0.0) { + set_performance_frequency(); + } + static LARGE_INTEGER now; + if ( !QueryPerformanceCounter(&now)) { + OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed"); + } + uint64_t ret = now.QuadPart * performance_frequency; + return caml_copy_int64(ret); +} + +CAMLprim value ocaml_mtime_clock_period_ns (value unit) +{ + (void) unit; + if (performance_frequency == 0.0) { + set_performance_frequency(); + } + if ( performance_frequency <= 0.0 ) { + return Val_none; + } + value ret; + value p = caml_copy_int64(performance_frequency); + Begin_roots1(p); + ret = caml_alloc_small(1,0); + Field(ret,0) = p; + End_roots(); + return ret; +} + + +/* Unsupported */ + +#else + +#warning OCaml Mtime_clock module: unsupported platform + +CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit) +{ OCAML_MTIME_RAISE_SYS_ERROR ("unsupported platform"); } + +CAMLprim value ocaml_mtime_clock_now_ns (value unit) +{ OCAML_MTIME_RAISE_SYS_ERROR ("unsupported platform"); } + +CAMLprim value ocaml_mtime_clock_period_ns (value unit) +{ OCAML_MTIME_RAISE_SYS_ERROR ("unsupported platform"); } + +#endif + +/*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime 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. + ---------------------------------------------------------------------------*/ diff --git a/src/mtime.ml b/src/mtime.ml new file mode 100644 index 0000000..dd34b53 --- /dev/null +++ b/src/mtime.ml @@ -0,0 +1,184 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Time scale conversion *) + +let ns_to_s = 1e-9 +let us_to_s = 1e-6 +let ms_to_s = 1e-3 +let min_to_s = 60. +let hour_to_s = 3600. +let day_to_s = 86_400. +let year_to_s = 31_557_600. + +let s_to_ns = 1e9 +let s_to_us = 1e6 +let s_to_ms = 1e3 +let s_to_min = 1. /. min_to_s +let s_to_hour = 1. /. hour_to_s +let s_to_day = 1. /. day_to_s +let s_to_year = 1. /. year_to_s + +(* Unsigned comparison *) + +let uint64_compare a b = Int64.(compare (sub a min_int) (sub b min_int)) + +(* Time spans + + Time spans are in nanoseconds and we represent them by an unsigned + 64-bit integer. This allows to represent spans for: + (2^64-1) / 1_000_000_000 / (24 * 3600 * 365.25) ≅ 584.5 Julian years *) + +type span = int64 (* unsigned nanoseconds *) + +module Span = struct + type t = span + + let to_uint64_ns s = s + let of_uint64_ns ns = ns + + let unsafe_of_uint64_ns_option nsopt = nsopt + + (* Predicates *) + + let equal = Int64.equal + let compare = uint64_compare + + (* Constants *) + + let zero = 0L + let one = 1L + let min_span = zero + let max_span = -1L + + (* Arithmetic *) + + let add = Int64.add + let abs_diff s0 s1 = + if compare s0 s1 < 0 then Int64.sub s1 s0 else Int64.sub s0 s1 + + (* Converting time spans *) + + let to_ns s = (Int64.to_float s) + let to_us s = (Int64.to_float s) *. 1e-3 + let to_ms s = (Int64.to_float s) *. 1e-6 + let to_s s = (Int64.to_float s) *. 1e-9 + + let ns_to_min = ns_to_s *. s_to_min + let to_min s = (Int64.to_float s) *. ns_to_min + + let ns_to_hour = ns_to_s *. s_to_hour + let to_hour s = (Int64.to_float s) *. ns_to_hour + + let ns_to_day = ns_to_s *. s_to_day + let to_day s = (Int64.to_float s) *. ns_to_day + + let ns_to_year = ns_to_s *. s_to_year + let to_year s = (Int64.to_float s) *. ns_to_year + + (* Pretty printing *) + + let round x = floor (x +. 0.5) + let round_dfrac d x = (* rounds [x] to the [d]th decimal digit *) + if x -. (round x) = 0. then x else (* x is an integer. *) + let m = 10. ** (float d) in (* m moves 10^-d to 1. *) + (floor ((x *. m) +. 0.5)) /. m + + let pp_float_s ppf span = + let m = abs_float span in + if m < ms_to_s then + (* m < 1ms, if < 100us, print us with 3 frac digit w.o. trailing zeros + if >= 100us, print us without frac digit *) + let us = span /. us_to_s in + let us = if abs_float us < 100. then round_dfrac 3 us else round us in + if abs_float us >= 1000. then Format.fprintf ppf "%gms" (copysign 1. us) + else Format.fprintf ppf "%gus" us + else if m < 1. then + (* m < 1s, if < 100ms, print ms with 3 frac digit w.o. trailing zeros + if >= 100ms, print ms without frac digit *) + let ms = span /. ms_to_s in + let ms = if abs_float ms < 100. then round_dfrac 3 ms else round ms in + if abs_float ms >= 1000. then Format.fprintf ppf "%gs" (copysign 1. ms) + else Format.fprintf ppf "%gms" ms + else if m < min_to_s then + (* m < 1min, print [s] with 3 frac digit w.o. trailing zeros *) + let s = round_dfrac 3 span in + if abs_float s >= 60. then Format.fprintf ppf "%gmin" (copysign 1. s) + else Format.fprintf ppf "%gs" s + else + (* m >= 1min + From here on we show the two (or one if the second is zero) largest + significant units and no longer care about rounding the lowest unit, + we just truncate. *) + if m < hour_to_s then + let m, rem = truncate (span /. min_to_s), mod_float span min_to_s in + let s = truncate rem in + if s = 0 then Format.fprintf ppf "%dmin" m else + Format.fprintf ppf "%dmin%ds" m (abs s) + else if m < day_to_s then + let h, rem = truncate (span /. hour_to_s), mod_float span hour_to_s in + let m = truncate (rem /. min_to_s) in + if m = 0 then Format.fprintf ppf "%dh" h else + Format.fprintf ppf "%dh%dmin" h (abs m) + else if m < year_to_s then + let d, rem = truncate (span /. day_to_s), mod_float span day_to_s in + let h = truncate (rem /. hour_to_s) in + if h = 0 then Format.fprintf ppf "%dd" d else + Format.fprintf ppf "%dd%dh" d (abs h) + else + let y, rem = truncate (span /. year_to_s), mod_float span year_to_s in + let d = truncate (rem /. day_to_s) in + if d = 0 then Format.fprintf ppf "%da" y else + Format.fprintf ppf "%da%dd" y (abs d) + + let pp ppf s = pp_float_s ppf (to_s s) + let dump ppf s = Format.fprintf ppf "%Lu" s +end + +(* Monotonic timestamps *) + +type t = int64 + +let to_uint64_ns s = s +let of_uint64_ns ns = ns + +(* Predicates *) + +let equal = Int64.equal +let compare = uint64_compare +let is_earlier t ~than = compare t than < 0 +let is_later t ~than = compare t than > 0 + +(* Arithmetic *) + +let span t0 t1 = if compare t0 t1 < 0 then Int64.sub t1 t0 else Int64.sub t0 t1 + +let add_span t s = + let sum = Int64.add t s in + if compare t sum <= 0 then Some sum else None + +let sub_span t s = + if compare t s < 0 then None else Some (Int64.sub t s) + +(* Pretty printing *) + +let pp ppf ns = Format.fprintf ppf "%Luns" ns +let dump ppf ns = Format.fprintf ppf "%Lu" ns + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/src/mtime.mli b/src/mtime.mli new file mode 100644 index 0000000..9398065 --- /dev/null +++ b/src/mtime.mli @@ -0,0 +1,262 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Monotonic time values. + + [Mtime] has platform independent support for monotonic wall-clock + time. This time increases monotonically and is not subject to + operating system calendar time adjustments. + + {{!spans}Time spans} represent non-negative monotonic time spans + between two monotonic clock readings. {{!timestamps}Timestamps} + represent system-relative monotonic {e timestamps}, their absolute + value is meaningless but they can be compared across the processes + of an operating system run. + + {!Mtime_clock} provides access to a system monotonic clock. *) + +(** {1:spans Monotonic time spans} *) + +type span +(** The type for non-negative monotonic time spans. They represent the + difference between two monotonic clock readings. If the platform's + clock has nanosecond resolution the representation guarantees that + the function {!Mtime_clock.elapsed} can measure up to + approximatively 584 Julian year spans before silently rolling over + (unlikely since this is in a single program run). *) + +(** Monotonic time spans. *) +module Span : sig + + (** {1:spans Monotonic time spans} *) + + type t = span + (** See {!type:span}. *) + + val to_uint64_ns : span -> int64 + (** [to_uint64_ns span] is [span] as an {e unsigned} 64-bit integer + nanosecond span. *) + + val of_uint64_ns : int64 -> span + (** [of_uint64_ns d] is the {e unsigned} 64-bit integer nanosecond + span as a span. *) + + (** {1 Constants} *) + + val zero : span + (** [zero] is a span of 0ns. *) + + val one : span + (** [one] is a span of 1ns. *) + + val min_span : span + (** [min_span] is {!zero}. *) + + val max_span : span + (** [max_span] is 2^64-1ns. *) + + (** {1 Predicates} *) + + val equal : span -> span -> bool + (** [equal span span'] is [true] iff [span] and [span'] are equal. *) + + val compare : span -> span -> int + (** [compare span span'] orders spans by increasing duration. *) + + (** {1:arith Arithmetic} *) + + val add : span -> span -> span + (** [add span span'] is [span + span']. + + {b Warning.} Rolls over on overflow. *) + + val abs_diff : span -> span -> span + (** [abs_diff span span'] is the absolute difference between + [span] and [span']. *) + + (** {1 Converting time spans} + + See {{!convert}this section} for time scale definitions. *) + + val to_ns : span -> float + (** [to_ns span] is [span] in nanoseconds (1e-9s). *) + + val to_us : span -> float + (** [to_us span] is [span] in microseconds (1e-6s). *) + + val to_ms : span -> float + (** [to_ms span] is [span] in milliseconds (1e-3s). *) + + val to_s : span -> float + (** [to_s span] is [span] in seconds. *) + + val to_min : span -> float + (** [to_min span] is [span] in SI-accepted minutes (60s). *) + + val to_hour : span -> float + (** [to_hour span] is [span] in SI-accepted hours (3600s). *) + + val to_day : span -> float + (** [to_day span] is [span] in SI-accepted days (24 hours, 86400s). *) + + val to_year : span -> float + (** [to_year span] is [span] in Julian years (365.25 days, 31'557'600s). *) + + (** {1 Pretty printing} *) + + val pp : Format.formatter -> span -> unit + (** [pp_span ppf span] prints an unspecified representation of + [span] on [ppf]. The representation is not fixed-width, + depends on the magnitude of [span] and uses locale + independent {{!convert}standard time scale} abbreviations. *) + + val pp_float_s : Format.formatter -> float -> unit + (** [pp_float_s] prints like {!pp} does but on a floating + point seconds time span value (which can be negative). *) + + val dump : Format.formatter -> t -> unit + (** [dump ppf span] prints an unspecified raw representation of [span] + on [ppf]. *) + + (**/**) + + val unsafe_of_uint64_ns_option : int64 option -> t option +end + +(** {1:timestamps Monotonic timestamps} + + {b Note.} Only use timestamps if you need inter-process time + correlation, otherwise prefer {!Mtime_clock.elapsed} and + {{!Mtime_clock.counters}counters}. *) + +type t +(** The type for monotonic timestamps relative to an indeterminate + system-wide event (e.g. last startup). Their absolute value has no + meaning but can be used for inter-process time correlation. *) + +val to_uint64_ns : t -> int64 +(** [to_uint64_ns t] is [t] as an {e unsigned} 64-bit integer + nanosecond timestamp. The absolute value is meaningless. *) + +val of_uint64_ns : int64 -> t +(** [to_uint64_ns t] is [t] is an {e unsigned} 64-bit integer + nanosecond timestamp as a timestamp. + + {b Warning.} Timestamps returned by this function should only be + used with other timestamp values that are know to come from the + same operating system run. *) + +(** {1:preds Predicates} *) + +val equal : t -> t -> bool +(** [equal t t'] is [true] iff [t] and [t'] are equal. *) + +val compare : t -> t -> int +(** [compare t t'] orders timestamps by increasing time. *) + +val is_earlier : t -> than:t -> bool +(** [is_earlier t ~than] is [true] iff [t] occurred before [than]. *) + +val is_later : t -> than:t -> bool +(** [is_later t ~than] is [true] iff [t] occurred after [than]. *) + +(** {1:arith Arithmetic} *) + +val span : t -> t -> span +(** [span t t'] is the span between [t] and [t'] regardless of the + order between [t] and [t']. *) + +val add_span : t -> span -> t option +(** [add_span t s] is the timestamp [s] units later than [t] or [None] if + the result overflows. *) + +val sub_span : t -> span -> t option +(** [sub_span t s] is the timestamp [s] units earlier than [t] or + [None] if overflows. *) + +(** {1:pretty Pretty printing} *) + +val pp : Format.formatter -> t -> unit +(** [pp ppf t] prints [t] as an {e unsigned} 64-bit integer nanosecond + timestamp. Note that the absolute value is meaningless. *) + +val dump : Format.formatter -> t -> unit +(** [dump ppf t] prints an unspecified raw representation of [t] on [ppf]. *) + +(** {1:convert Time scale conversion} + + The following convenience constants relate time scales to seconds. + Used as multiplicands they can be used to convert these units + to and from seconds. + + The constants are defined according to + {{: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 (IAU). *) + +val ns_to_s : float +(** [ns_to_s] is [1e-9] the number of seconds in one nanosecond. *) + +val us_to_s : float +(** [us_to_s] is [1e-6], the number of seconds in one microsecond. *) + +val ms_to_s : float +(** [ms_to_s] is [1e-3], the number of seconds in one millisecond. *) + +val min_to_s : float +(** [min_to_s] is [60.], the number of seconds in one SI-accepted minute. *) + +val hour_to_s : float +(** [hour_to_s] is [3600.], the number of seconds in one SI-accepted hour. *) + +val day_to_s : float +(** [day_to_s] is [86_400.], the number of seconds in one SI-accepted day. *) + +val year_to_s : float +(** [year_to_s] is [31_557_600.], the number of seconds in a Julian year. *) + +val s_to_ns : float +(** [s_to_ns] is [1e9] the number of nanoseconds in one second. *) + +val s_to_us : float +(** [s_to_us] is [1e6], the number of microseconds in one second. *) + +val s_to_ms : float +(** [s_to_ms] is [1e3], the number of milliseconds in one second. *) + +val s_to_min : float +(** [s_to_min] is [1. /. 60.], the number of SI-accepted minutes in + one second. *) + +val s_to_hour : float +(** [s_to_hour] is [1. /. 3600.], the number of SI-accepted hours in + one second. *) + +val s_to_day : float +(** [s_to_day] is [1. /. 86400.], the number of SI-accepted days in + one second. *) + +val s_to_year : float +(** [s_to_year] is [1. /. 31_557_600.], the number of Julian years + in one second. *) + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/src/mtime.mllib b/src/mtime.mllib new file mode 100644 index 0000000..becfe81 --- /dev/null +++ b/src/mtime.mllib @@ -0,0 +1 @@ +Mtime diff --git a/src/mtime_clock.mli b/src/mtime_clock.mli new file mode 100644 index 0000000..72c78f2 --- /dev/null +++ b/src/mtime_clock.mli @@ -0,0 +1,125 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Monotonic time clock. + + [Mtime_clock] provides access to a system monotonic clock. This + time increases monotonically and is not subject to operating + system calendar time adjustments. + + Only use {!Mtime_clock.now} if you need inter-process time + correlation, otherwise prefer {!Mtime_clock.elapsed} and + {{!Mtime_clock.counters}counters}. + + Consult important information about {{!err}error handling} + and {{!platform_support}platform support}. + + Concrete implementation of this interfaces are provided by the + [mtime.clock.os] and [mtime.clock.jsoo] packages against which you + should compile depending on your target. *) + +(** {1:clock Monotonic clock} *) + +val elapsed : unit -> Mtime.span +(** [elapsed ()] is the monotonic time span elapsed since the + beginning of the program. + + @raise Sys_error see {{!err}error handling} *) + +val now : unit -> Mtime.t +(** [now ()] is the current system-relative monotonic timestamp. Its + absolute value is meaningless. + + @raise Sys_error see {{!err}error handling} *) + +val period : unit -> Mtime.span option +(** [period ()] is the clock's period as a monotonic time span (if + available). *) + +(** {1:counters Time counters} *) + +type counter +(** The type for monotonic wall-clock time counters. *) + +val counter : unit -> counter +(** [counter ()] is a counter counting from now on. + + @raise Sys_error see {{!err}error handling} *) + +val count : counter -> Mtime.span +(** [count c] is the monotonic time span elapsed since [c] was created. *) + +(** {1:raw Monotonic clock raw interface} *) + +val elapsed_ns : unit -> int64 +(** [elapsed_ns ()] is the {e unsigned} 64-bit integer nanosecond monotonic + time span elapsed since the beginning of the program. + + @raise Sys_error see {{!err}error handling} *) + +val now_ns : unit -> int64 +(** [now_ns ()] is an {e unsigned} 64-bit integer nanosecond + system-relative monotonic timestamp. The absolute value is + meaningless. + + @raise Sys_error see {{!err}error handling} *) + +val period_ns : unit -> int64 option +(** [period_ns ()] is the clock's period as an {e unsigned} 64-bit + integer nanosecond monotonic time span (if available). *) + +(** {1:err Error handling} + + The functions {!elapsed}, {!now}, {!val-counter}, {!elapsed_ns} and + {!now_ns} raise [Sys_error] whenever they can't determine the + current time or that it doesn't fit in [Mtime]'s range. Usually + 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_MONOTONIC.} + {- Darwin uses + {{:https://developer.apple.com/library/mac/qa/qa1398/_index.html}[mach_absolute_time]}.} + {- Windows uses + {{:https://msdn.microsoft.com/en-us/library/windows/desktop/aa373083%28v=vs.85%29.aspx}Performance counters}. } + {- JavaScript uses + {{:http://www.w3.org/TR/hr-time/}[performance.now]} (consult + {{:http://caniuse.com/#feat=high-resolution-time}availability}) + which returns a + {{:http://www.w3.org/TR/hr-time/#sec-DOMHighResTimeStamp}double + floating point value} in milliseconds with + resolution up to the microsecond.} + {- JavaScript running on Node.js uses the built-in + {{:https://nodejs.org/api/perf_hooks.html#perf_hooks_performance_now}[perf_hooks]} + module, which provides an interface compatible to the [performance] + module in browsers.}} +*) + + +(*--------------------------------------------------------------------------- + Copyright (c) 2017 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/src/mtime_top.ml b/src/mtime_top.ml new file mode 100644 index 0000000..4a0c150 --- /dev/null +++ b/src/mtime_top.ml @@ -0,0 +1,22 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let () = ignore (Toploop.use_file Format.err_formatter "mtime_top_init.ml") + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/src/mtime_top.mllib b/src/mtime_top.mllib new file mode 100644 index 0000000..f288f8c --- /dev/null +++ b/src/mtime_top.mllib @@ -0,0 +1 @@ +Mtime_top
\ No newline at end of file diff --git a/src/mtime_top_init.ml b/src/mtime_top_init.ml new file mode 100644 index 0000000..c9a3aed --- /dev/null +++ b/src/mtime_top_init.ml @@ -0,0 +1,23 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +#install_printer Mtime.pp +#install_printer Mtime.Span.pp + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/test-jsoo/test_jsoo.html b/test-jsoo/test_jsoo.html new file mode 100644 index 0000000..e60a777 --- /dev/null +++ b/test-jsoo/test_jsoo.html @@ -0,0 +1,48 @@ +<!DOCTYPE html> +<!-- + Copyright (c) 2014 The mtime programmers. All rights reserved. + Distributed under the ISC license, see license at the end of the file. + mtime release v1.3.0 +--> +<html lang="en"> +<head> + <meta charset="utf-8"> + <meta name="viewport" content="width=device-width, + initial-scale=1.0"> + <script type="text/javascript" defer="defer" src="test_jsoo.js"></script> + <style type="text/css"> + h1 { font-size: 2.5rem; font-weight: 300; text-transform: uppercase; } + body { background-color: black; + color: #A0A0A0; + font-size: 1rem; + line-height: 1.3125rem; + font-family: monospace; + font-weight: 300; + margin: 4em; } + + div { font-size: 0.8rem; margin-top:1.3125rem; } + p { margin:0rem; padding:0rem; white-space: pre; } + </style> + <title>Mtime tests</title> +</head> +<body> + <noscript>Sorry, you need to enable JavaScript to see this page.</noscript> + <h1>Mtime tests</h1> +</body> +</html> + +<!-- + Copyright (c) 2015 The mtime 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. + --> diff --git a/test-jsoo/test_jsoo.ml b/test-jsoo/test_jsoo.ml new file mode 100644 index 0000000..970d7b2 --- /dev/null +++ b/test-jsoo/test_jsoo.ml @@ -0,0 +1,42 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2014 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +open Js_of_ocaml + +let setup_log () = + let log = Dom_html.(createDiv document) in + let add_entry s = + let e = Dom_html.(createP document) in + Js.Unsafe.set e "innerHTML" (Js.string s); + Dom.appendChild log e; + in + Dom.appendChild (Js.Unsafe.get Dom_html.document "body") log; + Sys_js.set_channel_flusher stdout add_entry; + Sys_js.set_channel_flusher stderr add_entry; + () + +let main _ = + setup_log (); + ignore (Tests.run ()); + Js._false + +let () = Js.Unsafe.set Dom_html.window "onload" (Dom_html.handler main) + + +(*--------------------------------------------------------------------------- + Copyright (c) 2014 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/test-jsoo/test_node.ml b/test-jsoo/test_node.ml new file mode 100644 index 0000000..731bc35 --- /dev/null +++ b/test-jsoo/test_node.ml @@ -0,0 +1,22 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let () = Tests.run () + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/test-jsoo/tests.ml b/test-jsoo/tests.ml new file mode 100644 index 0000000..79e2e18 --- /dev/null +++ b/test-jsoo/tests.ml @@ -0,0 +1,275 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let log f = Format.printf (f ^^ "@.") + +let test_available () = + try ignore (Mtime_clock.elapsed ()) with + | Sys_error e -> log "[ERROR] no monotonic time available: %s" e; exit 1 + +let count = ref 0 +let fail = ref 0 +let test f v = + incr count; + try f v with + | Failure _ | Assert_failure _ as exn -> + let bt = Printexc.get_backtrace () in + incr fail; log "[ERROR] %s@.%s" (Printexc.to_string exn) bt + +let log_result () = + if !fail = 0 then log "[OK] All %d tests passed !" !count else + log "[FAIL] %d failure(s) out of %d" !fail !count; + () + +let test_secs_in () = + log "Testing Mtime.{s_to_*,*_to_s}"; + let equalf f f' = abs_float (f -. f') < 1e-9 in + assert (Mtime.ns_to_s = 1e-9); + assert (Mtime.us_to_s = 1e-6); + assert (Mtime.ms_to_s = 1e-3); + assert (Mtime.min_to_s = 60.); + assert (Mtime.hour_to_s = (60. *. 60.)); + assert (Mtime.day_to_s = (24. *. 60. *. 60.)); + assert (Mtime.year_to_s = (365.25 *. 24. *. 60. *. 60.)); + assert (equalf (Mtime.s_to_ns *. 1e-9) 1.); + assert (equalf (Mtime.s_to_us *. 1e-6) 1.); + assert (equalf (Mtime.s_to_ms *. 1e-3) 1.); + assert (equalf (Mtime.s_to_min *. 60.) 1.); + assert (equalf (Mtime.s_to_hour *. (60. *. 60.)) 1.); + assert (equalf (Mtime.s_to_day *. (24. *. 60. *. 60.)) 1.); + assert (equalf (Mtime.s_to_year *. (365.25 *. 24. *. 60. *. 60.)) 1.); + () + +let test_pp_span_s () = + (* N.B. this test may fail as it may be sensitive to black art of + floating point formatting. Also note that ties on negative + numbers round towards positive infinity, i.e. -0.5 rounds to 0. *) + log "Testing Mtime.pp_span_s"; + let pp s = Format.asprintf "%a" Mtime.Span.pp_float_s s in + let eq_str s s' = if s <> s' then failwith (Printf.sprintf "%S <> %S" s s') in + (* sub ns scale *) + eq_str (pp 1.0e-10) "0us"; + eq_str (pp ~-.1.0e-10) "0us"; + eq_str (pp 4.0e-10) "0us"; + eq_str (pp ~-.4.0e-10) "0us"; + eq_str (pp 6.0e-10) "0.001us"; + eq_str (pp ~-.6.0e-10) "-0.001us"; + eq_str (pp 9.0e-10) "0.001us"; + eq_str (pp ~-.9.0e-10) "-0.001us"; + (* ns scale *) + eq_str (pp 2.0e-9) "0.002us"; + eq_str (pp ~-.2.0e-9) "-0.002us"; + eq_str (pp 2.136767676e-9) "0.002us"; + eq_str (pp ~-.2.136767676e-9) "-0.002us"; + eq_str (pp 2.6e-9) "0.003us"; + eq_str (pp ~-.2.6e-9) "-0.003us"; + eq_str (pp 2.836767676e-9) "0.003us"; + eq_str (pp ~-.2.836767676e-9) "-0.003us"; + (* us scale *) + eq_str (pp 2.0e-6) "2us"; + eq_str (pp ~-.2.0e-6) "-2us"; + eq_str (pp 2.555e-6) "2.555us"; + eq_str (pp ~-.2.555e-6) "-2.555us"; + eq_str (pp 2.5556e-6) "2.556us"; + eq_str (pp ~-.2.5556e-6) "-2.556us"; + eq_str (pp 99.9994e-6) "99.999us"; + eq_str (pp ~-.99.9994e-6) "-99.999us"; + eq_str (pp 99.9996e-6) "100us"; + eq_str (pp ~-.99.9996e-6) "-100us"; + eq_str (pp 100.1555e-6) "100us"; + eq_str (pp ~-.100.1555e-6) "-100us"; + eq_str (pp 100.5555e-6) "101us"; + eq_str (pp ~-.100.5555e-6) "-101us"; + eq_str (pp 100.6555e-6) "101us"; + eq_str (pp ~-.100.6555e-6) "-101us"; + eq_str (pp 999.4e-6) "999us"; + eq_str (pp ~-.999.4e-6) "-999us"; + eq_str (pp 999.6e-6) "1ms"; + eq_str (pp ~-.999.6e-6) "-1ms"; + (* ms scale *) + eq_str (pp 1e-3) "1ms"; + eq_str (pp ~-.1e-3) "-1ms"; + eq_str (pp 1.555e-3) "1.555ms"; + eq_str (pp ~-.1.555e-3) "-1.555ms"; + eq_str (pp 1.5556e-3) "1.556ms"; + eq_str (pp ~-.1.5556e-3) "-1.556ms"; + eq_str (pp 99.9994e-3) "99.999ms"; + eq_str (pp ~-.99.9994e-3) "-99.999ms"; + eq_str (pp 99.9996e-3) "100ms"; + eq_str (pp ~-.99.9996e-3) "-100ms"; + eq_str (pp 100.1555e-3) "100ms"; + eq_str (pp ~-.100.1555e-3) "-100ms"; + eq_str (pp 100.5555e-3) "101ms"; + eq_str (pp ~-.100.5555e-3) "-101ms"; + eq_str (pp 100.6555e-3) "101ms"; + eq_str (pp ~-.100.6555e-3) "-101ms"; + eq_str (pp 999.4e-3) "999ms"; + eq_str (pp ~-.999.4e-3) "-999ms"; + eq_str (pp 999.6e-3) "1s"; + eq_str (pp ~-.999.6e-3) "-1s"; + (* s scale *) + eq_str (pp 1.) "1s"; + eq_str (pp ~-.1.) "-1s"; + eq_str (pp 1.555) "1.555s"; + eq_str (pp ~-.1.555) "-1.555s"; + eq_str (pp 1.5554) "1.555s"; + eq_str (pp ~-.1.5554) "-1.555s"; + eq_str (pp 1.5556) "1.556s"; + eq_str (pp ~-.1.5556) "-1.556s"; + eq_str (pp 59.) "59s"; + eq_str (pp ~-.59.) "-59s"; + eq_str (pp 59.9994) "59.999s"; + eq_str (pp ~-.59.9994) "-59.999s"; + eq_str (pp 59.9996) "1min"; + eq_str (pp ~-.59.9996) "-1min"; + (* min scale *) + eq_str (pp 60.) "1min"; + eq_str (pp ~-.60.) "-1min"; + eq_str (pp 62.) "1min2s"; + eq_str (pp ~-.62.) "-1min2s"; + eq_str (pp 62.4) "1min2s"; + eq_str (pp ~-.62.4) "-1min2s"; + eq_str (pp 3599.) "59min59s"; + eq_str (pp ~-.3599.) "-59min59s"; + (* hour scale *) + eq_str (pp 3600.0) "1h"; + eq_str (pp ~-.3600.0) "-1h"; + eq_str (pp 3629.0) "1h"; + eq_str (pp ~-.3629.0) "-1h"; + eq_str (pp 3660.0) "1h1min"; + eq_str (pp ~-.3660.0) "-1h1min"; + eq_str (pp 7164.0) "1h59min"; + eq_str (pp ~-.7164.0) "-1h59min"; + eq_str (pp 7200.0) "2h"; + eq_str (pp ~-.7200.0) "-2h"; + eq_str (pp 86399.) "23h59min"; + eq_str (pp ~-.86399.) "-23h59min"; + (* day scale *) + eq_str (pp 86400.) "1d"; + eq_str (pp ~-.86400.) "-1d"; + eq_str (pp (86400. +. (23. *. 3600.))) "1d23h"; + eq_str (pp ~-.(86400. +. (23. *. 3600.))) "-1d23h"; + eq_str (pp (86400. +. (24. *. 3600.))) "2d"; + eq_str (pp ~-.(86400. +. (24. *. 3600.))) "-2d"; + eq_str (pp (365.25 *. 86_400. -. 1.)) "365d5h"; + eq_str (pp ~-.(365.25 *. 86_400. -. 1.)) "-365d5h"; + (* year scale *) + eq_str (pp (31557600.)) "1a"; + eq_str (pp ~-.(365.25 *. 86_400.)) "-1a"; + eq_str (pp (365.25 *. 86_400. +. 86400.)) "1a1d"; + eq_str (pp ~-.(365.25 *. 86_400. +. 86400.)) "-1a1d"; + eq_str (pp (365.25 *. 2. *. 86_400.)) "2a"; + eq_str (pp ~-.(365.25 *. 2. *. 86_400.)) "-2a"; + eq_str (pp (365.25 *. 2. *. 86_400. -. 1.)) "1a365d"; + eq_str (pp ~-.(365.25 *. 2. *. 86_400. -. 1.)) "-1a365d"; + () + +let test_counters () = + log "Test counters"; + let count max = + let c = Mtime_clock.counter () in + for i = 1 to max do () done; + Mtime_clock.count c + in + let do_count max = + let span = count max in + let span_ns = Mtime.Span.to_uint64_ns span in + let span_s = Mtime.Span.to_s span in + log " * Count to % 8d: % 10Luns %.10fs %a" + max span_ns span_s Mtime.Span.pp span + in + do_count 1000000; + do_count 100000; + do_count 10000; + do_count 1000; + do_count 100; + do_count 10; + do_count 1; + () + +let test_elapsed () = + log "Test Mtime_clock.elapsed ns - s - pp - dump"; + let span = Mtime_clock.elapsed () in + log " * Elapsed: %Luns - %gs - %a - %a" + (Mtime.Span.to_uint64_ns span) (Mtime.Span.to_s span) + Mtime.Span.pp span Mtime.Span.dump span; + () + +let test_now () = + log "Test Mtime_clock.now ns - s - pp - dump "; + let t = Mtime_clock.now () in + let span = Mtime.(span t (of_uint64_ns 0_L)) in + log " * System: %Luns - %gs - %a - %a" + (Mtime.to_uint64_ns t) (Mtime.Span.to_s span) Mtime.pp t Mtime.dump t; + () + +let test_span_compare () = + log "Test Mtime.Span.compare"; + let zero_mtime = Mtime.Span.of_uint64_ns 0_L in + let large_mtime = Mtime.Span.of_uint64_ns Int64.max_int in + let larger_mtime = Mtime.Span.of_uint64_ns Int64.min_int in + let max_mtime = Mtime.Span.of_uint64_ns (-1_L) in + let (<) x y = Mtime.Span.compare x y < 0 in + assert (zero_mtime < large_mtime); + assert (zero_mtime < larger_mtime); + assert (zero_mtime < max_mtime); + assert (large_mtime < larger_mtime); + assert (large_mtime < max_mtime); + assert (larger_mtime < max_mtime); + let (<) x y = Mtime.Span.compare y x > 0 in + assert (zero_mtime < large_mtime); + assert (zero_mtime < large_mtime); + assert (zero_mtime < larger_mtime); + assert (zero_mtime < max_mtime); + assert (large_mtime < larger_mtime); + assert (large_mtime < max_mtime); + assert (larger_mtime < max_mtime); + () + +let test_span_constants () = + log "Test Mtime.Span.{zero,one,max_span,min_span}"; + let (<) x y = Mtime.Span.compare x y < 0 in + assert (Mtime.Span.zero < Mtime.Span.one); + assert (Mtime.Span.zero < Mtime.Span.max_span); + assert (Mtime.Span.min_span < Mtime.Span.one); + assert (Mtime.Span.min_span < Mtime.Span.max_span); + assert (Mtime.Span.one < Mtime.Span.max_span); + () + +let test_span_arith () = + log "Test Mtime.Span.{abs_diff,add}"; + assert (Mtime.Span.(equal (add zero one) one)); + assert (Mtime.Span.(equal (add one zero) one)); + assert (Mtime.Span.(equal (add (abs_diff max_span one) one) max_span)); + () + +let run () = + test test_available (); + test test_secs_in (); + test test_pp_span_s (); + test test_counters (); + test test_elapsed (); + test test_now (); + test test_span_compare (); + test test_span_constants (); + test_span_arith (); + log_result (); + exit !fail + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/test-os/min_os.ml b/test-os/min_os.ml new file mode 100644 index 0000000..1857966 --- /dev/null +++ b/test-os/min_os.ml @@ -0,0 +1,15 @@ +(* + Compile with: + ocamlfind ocamlc \ + -package mtime,mtime.clock.os -linkpkg -o min_os.byte min_os.ml + ocamlfind ocamlopt \ + -package mtime,mtime.clock.os -linkpkg -o min_os.native min_os.ml *) + +let () = + Format.printf "Elapsed: %a@." Mtime.Span.pp (Mtime_clock.elapsed ()); + Format.printf "Timestamp: %a@." Mtime.pp (Mtime_clock.now ()); + Format.printf "Clock period: %s@." + begin match Mtime_clock.period () with + | None -> "unknown" | Some s -> Format.asprintf "%a" Mtime.Span.pp s + end; + () diff --git a/test-os/test.ml b/test-os/test.ml new file mode 100644 index 0000000..731bc35 --- /dev/null +++ b/test-os/test.ml @@ -0,0 +1,22 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let () = Tests.run () + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime 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. + ---------------------------------------------------------------------------*) diff --git a/test-os/tests.ml b/test-os/tests.ml new file mode 100644 index 0000000..79e2e18 --- /dev/null +++ b/test-os/tests.ml @@ -0,0 +1,275 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +let log f = Format.printf (f ^^ "@.") + +let test_available () = + try ignore (Mtime_clock.elapsed ()) with + | Sys_error e -> log "[ERROR] no monotonic time available: %s" e; exit 1 + +let count = ref 0 +let fail = ref 0 +let test f v = + incr count; + try f v with + | Failure _ | Assert_failure _ as exn -> + let bt = Printexc.get_backtrace () in + incr fail; log "[ERROR] %s@.%s" (Printexc.to_string exn) bt + +let log_result () = + if !fail = 0 then log "[OK] All %d tests passed !" !count else + log "[FAIL] %d failure(s) out of %d" !fail !count; + () + +let test_secs_in () = + log "Testing Mtime.{s_to_*,*_to_s}"; + let equalf f f' = abs_float (f -. f') < 1e-9 in + assert (Mtime.ns_to_s = 1e-9); + assert (Mtime.us_to_s = 1e-6); + assert (Mtime.ms_to_s = 1e-3); + assert (Mtime.min_to_s = 60.); + assert (Mtime.hour_to_s = (60. *. 60.)); + assert (Mtime.day_to_s = (24. *. 60. *. 60.)); + assert (Mtime.year_to_s = (365.25 *. 24. *. 60. *. 60.)); + assert (equalf (Mtime.s_to_ns *. 1e-9) 1.); + assert (equalf (Mtime.s_to_us *. 1e-6) 1.); + assert (equalf (Mtime.s_to_ms *. 1e-3) 1.); + assert (equalf (Mtime.s_to_min *. 60.) 1.); + assert (equalf (Mtime.s_to_hour *. (60. *. 60.)) 1.); + assert (equalf (Mtime.s_to_day *. (24. *. 60. *. 60.)) 1.); + assert (equalf (Mtime.s_to_year *. (365.25 *. 24. *. 60. *. 60.)) 1.); + () + +let test_pp_span_s () = + (* N.B. this test may fail as it may be sensitive to black art of + floating point formatting. Also note that ties on negative + numbers round towards positive infinity, i.e. -0.5 rounds to 0. *) + log "Testing Mtime.pp_span_s"; + let pp s = Format.asprintf "%a" Mtime.Span.pp_float_s s in + let eq_str s s' = if s <> s' then failwith (Printf.sprintf "%S <> %S" s s') in + (* sub ns scale *) + eq_str (pp 1.0e-10) "0us"; + eq_str (pp ~-.1.0e-10) "0us"; + eq_str (pp 4.0e-10) "0us"; + eq_str (pp ~-.4.0e-10) "0us"; + eq_str (pp 6.0e-10) "0.001us"; + eq_str (pp ~-.6.0e-10) "-0.001us"; + eq_str (pp 9.0e-10) "0.001us"; + eq_str (pp ~-.9.0e-10) "-0.001us"; + (* ns scale *) + eq_str (pp 2.0e-9) "0.002us"; + eq_str (pp ~-.2.0e-9) "-0.002us"; + eq_str (pp 2.136767676e-9) "0.002us"; + eq_str (pp ~-.2.136767676e-9) "-0.002us"; + eq_str (pp 2.6e-9) "0.003us"; + eq_str (pp ~-.2.6e-9) "-0.003us"; + eq_str (pp 2.836767676e-9) "0.003us"; + eq_str (pp ~-.2.836767676e-9) "-0.003us"; + (* us scale *) + eq_str (pp 2.0e-6) "2us"; + eq_str (pp ~-.2.0e-6) "-2us"; + eq_str (pp 2.555e-6) "2.555us"; + eq_str (pp ~-.2.555e-6) "-2.555us"; + eq_str (pp 2.5556e-6) "2.556us"; + eq_str (pp ~-.2.5556e-6) "-2.556us"; + eq_str (pp 99.9994e-6) "99.999us"; + eq_str (pp ~-.99.9994e-6) "-99.999us"; + eq_str (pp 99.9996e-6) "100us"; + eq_str (pp ~-.99.9996e-6) "-100us"; + eq_str (pp 100.1555e-6) "100us"; + eq_str (pp ~-.100.1555e-6) "-100us"; + eq_str (pp 100.5555e-6) "101us"; + eq_str (pp ~-.100.5555e-6) "-101us"; + eq_str (pp 100.6555e-6) "101us"; + eq_str (pp ~-.100.6555e-6) "-101us"; + eq_str (pp 999.4e-6) "999us"; + eq_str (pp ~-.999.4e-6) "-999us"; + eq_str (pp 999.6e-6) "1ms"; + eq_str (pp ~-.999.6e-6) "-1ms"; + (* ms scale *) + eq_str (pp 1e-3) "1ms"; + eq_str (pp ~-.1e-3) "-1ms"; + eq_str (pp 1.555e-3) "1.555ms"; + eq_str (pp ~-.1.555e-3) "-1.555ms"; + eq_str (pp 1.5556e-3) "1.556ms"; + eq_str (pp ~-.1.5556e-3) "-1.556ms"; + eq_str (pp 99.9994e-3) "99.999ms"; + eq_str (pp ~-.99.9994e-3) "-99.999ms"; + eq_str (pp 99.9996e-3) "100ms"; + eq_str (pp ~-.99.9996e-3) "-100ms"; + eq_str (pp 100.1555e-3) "100ms"; + eq_str (pp ~-.100.1555e-3) "-100ms"; + eq_str (pp 100.5555e-3) "101ms"; + eq_str (pp ~-.100.5555e-3) "-101ms"; + eq_str (pp 100.6555e-3) "101ms"; + eq_str (pp ~-.100.6555e-3) "-101ms"; + eq_str (pp 999.4e-3) "999ms"; + eq_str (pp ~-.999.4e-3) "-999ms"; + eq_str (pp 999.6e-3) "1s"; + eq_str (pp ~-.999.6e-3) "-1s"; + (* s scale *) + eq_str (pp 1.) "1s"; + eq_str (pp ~-.1.) "-1s"; + eq_str (pp 1.555) "1.555s"; + eq_str (pp ~-.1.555) "-1.555s"; + eq_str (pp 1.5554) "1.555s"; + eq_str (pp ~-.1.5554) "-1.555s"; + eq_str (pp 1.5556) "1.556s"; + eq_str (pp ~-.1.5556) "-1.556s"; + eq_str (pp 59.) "59s"; + eq_str (pp ~-.59.) "-59s"; + eq_str (pp 59.9994) "59.999s"; + eq_str (pp ~-.59.9994) "-59.999s"; + eq_str (pp 59.9996) "1min"; + eq_str (pp ~-.59.9996) "-1min"; + (* min scale *) + eq_str (pp 60.) "1min"; + eq_str (pp ~-.60.) "-1min"; + eq_str (pp 62.) "1min2s"; + eq_str (pp ~-.62.) "-1min2s"; + eq_str (pp 62.4) "1min2s"; + eq_str (pp ~-.62.4) "-1min2s"; + eq_str (pp 3599.) "59min59s"; + eq_str (pp ~-.3599.) "-59min59s"; + (* hour scale *) + eq_str (pp 3600.0) "1h"; + eq_str (pp ~-.3600.0) "-1h"; + eq_str (pp 3629.0) "1h"; + eq_str (pp ~-.3629.0) "-1h"; + eq_str (pp 3660.0) "1h1min"; + eq_str (pp ~-.3660.0) "-1h1min"; + eq_str (pp 7164.0) "1h59min"; + eq_str (pp ~-.7164.0) "-1h59min"; + eq_str (pp 7200.0) "2h"; + eq_str (pp ~-.7200.0) "-2h"; + eq_str (pp 86399.) "23h59min"; + eq_str (pp ~-.86399.) "-23h59min"; + (* day scale *) + eq_str (pp 86400.) "1d"; + eq_str (pp ~-.86400.) "-1d"; + eq_str (pp (86400. +. (23. *. 3600.))) "1d23h"; + eq_str (pp ~-.(86400. +. (23. *. 3600.))) "-1d23h"; + eq_str (pp (86400. +. (24. *. 3600.))) "2d"; + eq_str (pp ~-.(86400. +. (24. *. 3600.))) "-2d"; + eq_str (pp (365.25 *. 86_400. -. 1.)) "365d5h"; + eq_str (pp ~-.(365.25 *. 86_400. -. 1.)) "-365d5h"; + (* year scale *) + eq_str (pp (31557600.)) "1a"; + eq_str (pp ~-.(365.25 *. 86_400.)) "-1a"; + eq_str (pp (365.25 *. 86_400. +. 86400.)) "1a1d"; + eq_str (pp ~-.(365.25 *. 86_400. +. 86400.)) "-1a1d"; + eq_str (pp (365.25 *. 2. *. 86_400.)) "2a"; + eq_str (pp ~-.(365.25 *. 2. *. 86_400.)) "-2a"; + eq_str (pp (365.25 *. 2. *. 86_400. -. 1.)) "1a365d"; + eq_str (pp ~-.(365.25 *. 2. *. 86_400. -. 1.)) "-1a365d"; + () + +let test_counters () = + log "Test counters"; + let count max = + let c = Mtime_clock.counter () in + for i = 1 to max do () done; + Mtime_clock.count c + in + let do_count max = + let span = count max in + let span_ns = Mtime.Span.to_uint64_ns span in + let span_s = Mtime.Span.to_s span in + log " * Count to % 8d: % 10Luns %.10fs %a" + max span_ns span_s Mtime.Span.pp span + in + do_count 1000000; + do_count 100000; + do_count 10000; + do_count 1000; + do_count 100; + do_count 10; + do_count 1; + () + +let test_elapsed () = + log "Test Mtime_clock.elapsed ns - s - pp - dump"; + let span = Mtime_clock.elapsed () in + log " * Elapsed: %Luns - %gs - %a - %a" + (Mtime.Span.to_uint64_ns span) (Mtime.Span.to_s span) + Mtime.Span.pp span Mtime.Span.dump span; + () + +let test_now () = + log "Test Mtime_clock.now ns - s - pp - dump "; + let t = Mtime_clock.now () in + let span = Mtime.(span t (of_uint64_ns 0_L)) in + log " * System: %Luns - %gs - %a - %a" + (Mtime.to_uint64_ns t) (Mtime.Span.to_s span) Mtime.pp t Mtime.dump t; + () + +let test_span_compare () = + log "Test Mtime.Span.compare"; + let zero_mtime = Mtime.Span.of_uint64_ns 0_L in + let large_mtime = Mtime.Span.of_uint64_ns Int64.max_int in + let larger_mtime = Mtime.Span.of_uint64_ns Int64.min_int in + let max_mtime = Mtime.Span.of_uint64_ns (-1_L) in + let (<) x y = Mtime.Span.compare x y < 0 in + assert (zero_mtime < large_mtime); + assert (zero_mtime < larger_mtime); + assert (zero_mtime < max_mtime); + assert (large_mtime < larger_mtime); + assert (large_mtime < max_mtime); + assert (larger_mtime < max_mtime); + let (<) x y = Mtime.Span.compare y x > 0 in + assert (zero_mtime < large_mtime); + assert (zero_mtime < large_mtime); + assert (zero_mtime < larger_mtime); + assert (zero_mtime < max_mtime); + assert (large_mtime < larger_mtime); + assert (large_mtime < max_mtime); + assert (larger_mtime < max_mtime); + () + +let test_span_constants () = + log "Test Mtime.Span.{zero,one,max_span,min_span}"; + let (<) x y = Mtime.Span.compare x y < 0 in + assert (Mtime.Span.zero < Mtime.Span.one); + assert (Mtime.Span.zero < Mtime.Span.max_span); + assert (Mtime.Span.min_span < Mtime.Span.one); + assert (Mtime.Span.min_span < Mtime.Span.max_span); + assert (Mtime.Span.one < Mtime.Span.max_span); + () + +let test_span_arith () = + log "Test Mtime.Span.{abs_diff,add}"; + assert (Mtime.Span.(equal (add zero one) one)); + assert (Mtime.Span.(equal (add one zero) one)); + assert (Mtime.Span.(equal (add (abs_diff max_span one) one) max_span)); + () + +let run () = + test test_available (); + test test_secs_in (); + test test_pp_span_s (); + test test_counters (); + test test_elapsed (); + test test_now (); + test test_span_compare (); + test test_span_constants (); + test_span_arith (); + log_result (); + exit !fail + +(*--------------------------------------------------------------------------- + Copyright (c) 2015 The mtime 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. + ---------------------------------------------------------------------------*) |