1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
(*---------------------------------------------------------------------------
Copyright (c) 2015 The ptime programmers. All rights reserved.
SPDX-License-Identifier: ISC
---------------------------------------------------------------------------*)
(* Ptime test unit comonalities *)
open B0_std
open B0_testing
module T = struct
(* Time spans *)
let eq_raw_span =
let raw_span ppf (d, ps) = Fmt.pf ppf "@[<1>(%d,@ %Ld)@]" d ps in
Test.Eq.make ~pp:raw_span ()
let raw_span ?__POS__ = Test.eq ?__POS__ eq_raw_span
let eq_span = Test.Eq.make ~equal:Ptime.Span.equal ~pp:Ptime.Span.dump ()
let span ?__POS__ = Test.eq ?__POS__ eq_span
let span_option ?__POS__ = Test.option ?__POS__ ~some:eq_span
(* Timestamps *)
let eq_stamp = Test.Eq.make ~equal:Ptime.equal ~pp:Ptime.dump ()
let stamp ?__POS__ = Test.eq ?__POS__ eq_stamp
let stamp_option ?__POS__ = Test.option ?__POS__ ~some:eq_stamp
(* Dates *)
module Date = struct
type t = Ptime.date
let equal = ( = )
let pp ppf (y,m,d) = Fmt.pf ppf "(%d, %d, %d)" y m d
end
let date ?__POS__ = Test.eq ?__POS__ (module Date)
(* Date time *)
module Date_time = struct
type t = Ptime.date * Ptime.time
let equal = ( = )
let pp ppf ((y, m, d), ((hh, mm, ss), tz)) =
Fmt.pf ppf "(%d, %d, %d), ((%d, %d, %d), %d)" y m d hh mm ss tz
end
let date_time ?__POS__ = Test.eq ?__POS__ (module Date_time)
let gmtime_to_date_time t =
let t = Ptime.to_float_s t in
let t = floor t (* see https://github.com/ocaml/ocaml/issues/6921 *) in
let tm = Unix.gmtime t in
let d = (tm.Unix.tm_year + 1900), (tm.Unix.tm_mon + 1), (tm.Unix.tm_mday) in
let t = tm.Unix.tm_hour, tm.Unix.tm_min, tm.Unix.tm_sec in
(d, (t, 0)), tm.Unix.tm_wday
let date_time_gmtime_witness ?__POS__:pos t =
let fail ?__POS__ n ~checks:_ =
Test.log_fail ?__POS__ "On stamp %g" (Ptime.to_float_s t)
in
Test.block ?__POS__:pos ~fail @@ fun () ->
let dt, wday = gmtime_to_date_time t in
let ut = Ptime.to_date_time t in
Test.eq ~__POS__ (module Date_time) dt ut;
Test.int ~__POS__ (Ptime.weekday_num t) wday
end
module Rand = struct
(* Random loop length *)
let loop_len = ref 100_000
let loop_len () = !loop_len
(* Random Ptime-valid stamps from floats *)
let float_stamp_range min max =
let bound = max -. min in
fun () ->
let r = Random.State.float (Test.Rand.state ()) bound (* inclusive *) in
let stamp = min +. r in
match Ptime.(of_float_s stamp) with
| None -> Fmt.failwith "cannot convert valid random stamp %f" stamp
| Some t -> t
let float_stamp_32bits =
let min_stamp = Int32.(to_float min_int) in
let max_stamp = Int32.(to_float max_int) in
float_stamp_range min_stamp max_stamp
let float_stamp : unit -> Ptime.t =
let min_stamp = Ptime.(to_float_s min) in
let max_stamp = Ptime.(to_float_s max) in
float_stamp_range min_stamp max_stamp
let stamp =
if Sys.word_size = 32 then float_stamp_32bits else float_stamp
(* Random Ptime-valid dates *)
let date : unit -> (int * int * int) =
let month_len = [|31; 28; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31 |] in
let is_leap y = (y mod 4 = 0) && (y mod 100 <> 0 || y mod 400 = 0) in
fun () ->
let rstate = Test.Rand.state () in
let rint bound = Random.State.int rstate bound in
let y = rint 10_000 in
let m = 1 + rint 11 in
let m_len = if (m = 2 && is_leap y) then 29 else month_len.(m - 1) in
let d = 1 + rint m_len in
(y, m, d)
(* Random times *)
let tz_interval_s = (1 lsl 30 - 1) (* max of Random.int *)
let tz_offset_s : unit -> int =
fun () ->
let rstate = Test.Rand.state () in
(* N.B. We don't cover the whole spectrum *)
(Random.State.int rstate tz_interval_s) - (tz_interval_s / 2)
let min_tz_interval_s = 2000
let min_tz_offset_s : unit -> int =
fun () ->
let rstate = Test.Rand.state () in
((Random.State.int rstate min_tz_interval_s) - (min_tz_interval_s / 2)) * 60
let time : unit -> (int * int * int) =
fun () ->
let rstate = Test.Rand.state () in
let rint bound = Random.State.int rstate bound in
let hh = rint 24 in
let mm = rint 60 in
let ss = rint 61 in
(hh, mm, ss)
end
|
