Skip to content

Commit d0245ae

Browse files
author
Ben Anson
authored
Merge pull request #60 from lippirk/xsi894-stockholm
Backport! XSI-894
2 parents dc316fe + 35e978c commit d0245ae

File tree

11 files changed

+162
-127
lines changed

11 files changed

+162
-127
lines changed

‎.travis.yml‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,13 @@ sudo: required
33
service: docker
44
install:
55
- wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh
6-
- wget https://raw.githubusercontent.com/xapi-project/xs-opam/master/tools/xs-opam-ci.env
6+
- wget https://raw.githubusercontent.com/xapi-project/xs-opam/release/stockholm/lcm/tools/xs-opam-ci.env
77
- source xs-opam-ci.env
88
script: bash -ex .travis-docker.sh
99
env:
1010
global:
11-
- PACKAGE="xapi-stdext"
1211
- PINS="stdext:. xapi-stdext:. xapi-stdext-bigbuffer:. xapi-stdext-date:. xapi-stdext-deprecated:. xapi-stdext-encodings:. xapi-stdext-monadic:. xapi-stdext-pervasives:. xapi-stdext-range:. xapi-stdext-std:. xapi-stdext-threads:. xapi-stdext-unix:. xapi-stdext-zerocheck:."
12+
jobs:
13+
- PACKAGE="stdext"
14+
- PACKAGE="xapi-stdext-date"
15+
- PACKAGE="xapi-stdext-encodings"

‎lib/xapi-stdext-date/date.ml‎

Lines changed: 37 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
(* ==== RFC822 ==== *)
1616
type rfc822 = string
1717

18-
let months = [| "Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun";
18+
let months = [| "Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun";
1919
"Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec" |]
2020
let days = [| "Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat" |]
2121

@@ -30,32 +30,51 @@ let rfc822_to_string x = x
3030

3131
(* ==== ISO8601/RFC3339 ==== *)
3232

33-
type print_type = PrintLocal | PrintUTC
33+
type print_timezone = Empty | TZ of string
3434
(* we must store the print_type with iso8601 to handle the case where the local time zone is UTC *)
35-
type iso8601 = Ptime.date * Ptime.time * print_type
35+
type iso8601 = Ptime.date * Ptime.time * print_timezone
36+
37+
let utc = TZ "Z"
3638

3739
let of_dt print_type dt = let (date, time) = dt in (date, time, print_type)
3840
let to_dt (date, time, _) = (date, time)
3941

40-
let of_string x =
42+
let best_effort_iso8601_to_rfc3339 x =
43+
(* (a) add dashes
44+
* (b) add UTC tz if no tz provided *)
4145
let x =
4246
try
43-
(* if x doesn't contain dashes, insert them, so that ptime can parse x *)
44-
Scanf.sscanf x "%04d%02d%02dT%s" (fun y mon d rest ->
45-
Printf.sprintf "%04d-%02d-%02dT%s" y mon d rest
46-
)
47-
with _ -> x
47+
Scanf.sscanf x "%04d%02d%02dT%s"
48+
(fun y mon d rest ->
49+
Printf.sprintf "%04d-%02d-%02dT%s" y mon d rest)
50+
with _ ->
51+
x
52+
in
53+
let tz =
54+
try
55+
Scanf.sscanf x "%04d-%02d-%02dT%02d:%02d:%02d%s"
56+
(fun _ _ _ _ _ _ tz -> Some tz)
57+
with _ -> None
4858
in
49-
match x |> Ptime.of_rfc3339 |> Ptime.rfc3339_error_to_msg with
50-
| Error (`Msg e) -> invalid_arg (Printf.sprintf "date.ml:of_string: %s" e)
59+
match tz with
60+
| None | Some "" ->
61+
(* the caller didn't specify a tz. we must try to add one so that ptime can at least attempt to parse *)
62+
(Printf.sprintf "%sZ" x, Empty)
63+
| Some tz ->
64+
(x, TZ tz)
65+
66+
let of_string x =
67+
let (rfc3339, print_timezone) = best_effort_iso8601_to_rfc3339 x in
68+
match Ptime.of_rfc3339 rfc3339 |> Ptime.rfc3339_error_to_msg with
69+
| Error (`Msg e) -> invalid_arg (Printf.sprintf "date.ml:of_string: %s" x)
5170
| Ok (t, tz, _) -> match tz with
52-
| None | Some 0 -> Ptime.to_date_time t |> of_dt PrintUTC
71+
| None | Some 0 -> Ptime.to_date_time t |> of_dt print_timezone
5372
| Some _ -> invalid_arg (Printf.sprintf "date.ml:of_string: %s" x)
5473

5574
let to_string ((y,mon,d), ((h,min,s), _), print_type) =
5675
match print_type with
57-
| PrintUTC -> Printf.sprintf "%04i%02i%02iT%02i:%02i:%02iZ" y mon d h min s
58-
| PrintLocal -> Printf.sprintf "%04i%02i%02iT%02i:%02i:%02i" y mon d h min s
76+
| TZ tz -> Printf.sprintf "%04i%02i%02iT%02i:%02i:%02i%s" y mon d h min s tz
77+
| Empty -> Printf.sprintf "%04i%02i%02iT%02i:%02i:%02i" y mon d h min s
5978

6079
let to_ptime_t t =
6180
match to_dt t |> Ptime.of_date_time with
@@ -67,21 +86,13 @@ let to_ptime_t t =
6786
let of_float s =
6887
match Ptime.of_float_s s with
6988
| None -> invalid_arg (Printf.sprintf "date.ml:of_float: %f" s)
70-
| Some t -> Ptime.to_date_time t |> of_dt PrintUTC
71-
72-
(* Convert tm in UTC back into calendar time x (using offset between above
73-
UTC and localtime fns to determine offset between UTC and localtime, then
74-
correcting for this)
75-
*)
76-
let to_float t =
77-
let (_, _, print_type) = t in
78-
match print_type with
79-
| PrintLocal -> invalid_arg "date.ml:to_float: expected utc"
80-
| PrintUTC -> to_ptime_t t |> Ptime.to_float_s
89+
| Some t -> Ptime.to_date_time t |> of_dt utc
90+
91+
let to_float t = to_ptime_t t |> Ptime.to_float_s
8192

8293
let _localtime current_tz_offset t =
8394
let tz_offset_s = current_tz_offset |> Option.value ~default:0 in
84-
let localtime = t |> Ptime.to_date_time ~tz_offset_s |> of_dt PrintLocal in
95+
let localtime = t |> Ptime.to_date_time ~tz_offset_s |> of_dt Empty in
8596
let (_, (_, localtime_offset), _) = localtime in
8697
if localtime_offset <> tz_offset_s then
8798
invalid_arg (

‎lib/xapi-stdext-date/date.mli‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,8 @@ type iso8601
2121
(** Convert calendar time [x] (as returned by e.g. Unix.time), to time in UTC. *)
2222
val of_float : float -> iso8601
2323

24-
(** Convert date/time to a float value: the number of seconds since 00:00:00 UTC, 1 Jan 1970. *)
24+
(** Convert date/time to a float value: the number of seconds since 00:00:00 UTC, 1 Jan 1970.
25+
* Assumes the underlying iso8601 is in UTC *)
2526
val to_float : iso8601 -> float
2627

2728
(** Convert date/time to an ISO 8601 formatted string. *)

‎lib/xapi-stdext-date/dune‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,16 @@
11
(library
22
(name xapi_stdext_date)
33
(public_name xapi-stdext-date)
4+
(modules date)
45
(libraries astring
56
ptime
67
ptime.clock.os
78
unix)
89
)
10+
11+
(test
12+
(name test)
13+
(package xapi-stdext-date)
14+
(modules test)
15+
(libraries alcotest xapi-stdext-date)
16+
)

‎lib/xapi-stdext-date/test.ml‎

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
open Xapi_stdext_date.Date
2+
let check_float = Alcotest.(check @@ float 1e-2 )
3+
let check_float_neq = Alcotest.(check @@ neg @@ float 1e-2)
4+
let check_string = Alcotest.(check string)
5+
let check_true str = Alcotest.(check bool) str true
6+
let dash_time_str = "2020-04-07T08:28:32Z"
7+
let no_dash_utc_time_str = "20200407T08:28:32Z"
8+
9+
let iso8601_tests =
10+
let test_of_float_invertible () =
11+
let non_int_time = 1586245987.70200706 in
12+
let time = non_int_time |> Float.floor in
13+
check_float "to_float inverts of_float" time (time |> of_float |> to_float);
14+
check_true "of_float inverts to_float" @@ eq (time |> of_float) (time |> of_float |> to_float |> of_float);
15+
in
16+
17+
let test_only_utc () =
18+
let utc = "2020-12-20T18:10:19Z" in
19+
let _ = of_string utc in (* UTC is valid *)
20+
let non_utc = "2020-12-20T18:10:19+02:00" in
21+
let exn = Invalid_argument "date.ml:of_string: 2020-12-20T18:10:19+02:00" in
22+
Alcotest.check_raises "only UTC is accepted" exn (fun () -> of_string non_utc |> ignore)
23+
in
24+
25+
let test_ca333908 () =
26+
check_float "dash time and no dash time have same float repr"
27+
(dash_time_str |> of_string |> to_float)
28+
(no_dash_utc_time_str |> of_string |> to_float)
29+
in
30+
31+
let test_of_string_invertible_when_no_dashes () =
32+
check_string "to_string inverts of_string" no_dash_utc_time_str (no_dash_utc_time_str |> of_string |> to_string);
33+
check_true "of_string inverts to_string" (eq (no_dash_utc_time_str |> of_string) (no_dash_utc_time_str |> of_string |> to_string |> of_string));
34+
in
35+
36+
(* CA-338243 - breaking backwards compatibility will break XC and XRT *)
37+
let test_to_string_backwards_compatibility () =
38+
check_string "to_string is backwards compatible" no_dash_utc_time_str
39+
(dash_time_str |> of_string |> to_string)
40+
in
41+
42+
let test_localtime_string () =
43+
let[@warning "-8"] (Ok (t, _, _)) =
44+
Ptime.of_rfc3339 "2020-04-07T09:01:28Z"
45+
in
46+
let minus_2_hrs = -7200 in
47+
let plus_3_hrs = 10800 in
48+
let zero_hrs = 0 in
49+
check_string "can subtract 2 hours" (_localtime_string (Some minus_2_hrs) t) "20200407T07:01:28";
50+
check_string "can add 3 hours" (_localtime_string (Some plus_3_hrs) t) "20200407T12:01:28";
51+
check_string "can add None" (_localtime_string None t) "20200407T09:01:28";
52+
check_string "can add zero" (_localtime_string (Some zero_hrs) t) "20200407T09:01:28"
53+
in
54+
55+
(* sanity check (on top of test_localtime_string) that localtime produces valid looking output *)
56+
let test_ca342171 () =
57+
(* no exception is thrown + backward compatible formatting *)
58+
let localtime_string = localtime () |> to_string in
59+
Alcotest.(check int) "localtime string has correct number of chars"
60+
(String.length localtime_string) (String.length no_dash_utc_time_str - 1);
61+
Alcotest.(check bool) "localtime string does not contain a Z" false (String.contains localtime_string 'Z')
62+
in
63+
64+
let test_xsi894 () =
65+
let missing_tz_no_dash = "20201210T17:19:20" in
66+
let missing_tz_dash = "2020-12-10T17:19:20" in
67+
check_string "can process missing tz no dash" missing_tz_no_dash (missing_tz_no_dash |> of_string |> to_string) ;
68+
check_string "can process missing tz with dashes, but return without dashes" missing_tz_no_dash (missing_tz_dash |> of_string |> to_string) ;
69+
70+
check_float "to_float assumes UTC" 1607620760. (missing_tz_no_dash |> of_string |> to_float) ;
71+
72+
let localtime' = localtime () in
73+
check_string "to_string inverts of_string for localtime" (localtime' |> to_string) (localtime' |> to_string |> of_string |> to_string) ;
74+
in
75+
76+
[ "test_of_float_invertible", `Quick, test_of_float_invertible
77+
; "test_only_utc", `Quick, test_only_utc
78+
; "test_ca333908", `Quick, test_ca333908
79+
; "test_of_string_invertible_when_no_dashes", `Quick, test_of_string_invertible_when_no_dashes
80+
; "test_to_string_backwards_compatibility", `Quick, test_to_string_backwards_compatibility
81+
; "test_localtime_string", `Quick, test_localtime_string
82+
; "test_ca342171", `Quick, test_ca342171
83+
; "test_xsi894", `Quick, test_xsi894
84+
]
85+
86+
let () = Alcotest.run "Date" [ "ISO 8601", iso8601_tests ]

‎lib/xapi-stdext-encodings/dune‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,14 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {|
99
(library
1010
(name xapi_stdext_encodings)
1111
(public_name xapi-stdext-encodings)
12+
(modules encodings)
1213
%s
1314
)
15+
16+
(test
17+
(name test)
18+
(package xapi-stdext-encodings)
19+
(modules test)
20+
(libraries alcotest xapi-stdext-encodings)
21+
)
1422
|} coverage_rewriter

‎lib_test/test_encodings.ml‎ renamed to ‎lib/xapi-stdext-encodings/test.ml‎

Lines changed: 6 additions & 78 deletions
Original file line numberDiff line numberDiff line change
@@ -516,87 +516,15 @@ module UTF8_codec = struct include E.UTF8_codec
516516

517517
end
518518

519-
module Date = struct
520-
open Xapi_stdext_date.Date
521-
let check_float = Alcotest.(check @@ float 1e-2 )
522-
let check_float_neq = Alcotest.(check @@ neg @@ float 1e-2)
523-
let check_string = Alcotest.(check string)
524-
let check_true str = Alcotest.(check bool) str true
525-
let dash_time_str = "2020-04-07T08:28:32Z"
526-
let no_dash_utc_time_str = "20200407T08:28:32Z"
527-
528-
let iso8601_tests =
529-
let test_of_float_invertible () =
530-
let non_int_time = 1586245987.70200706 in
531-
let time = non_int_time |> Float.floor in
532-
check_float "to_float inverts of_float" time (time |> of_float |> to_float);
533-
check_true "of_float inverts to_float" @@ eq (time |> of_float) (time |> of_float |> to_float |> of_float);
534-
in
535-
536-
let test_only_utc () =
537-
let utc = "2020-12-20T18:10:19Z" in
538-
let _ = of_string utc in (* UTC is valid *)
539-
let non_utc = "2020-12-20T18:10:19+02:00" in
540-
let exn = Invalid_argument "date.ml:of_string: 2020-12-20T18:10:19+02:00" in
541-
Alcotest.check_raises "only UTC is accepted" exn (fun () -> of_string non_utc |> ignore)
542-
in
543-
544-
let test_ca333908 () =
545-
check_float "dash time and no dash time have same float repr"
546-
(dash_time_str |> of_string |> to_float)
547-
(no_dash_utc_time_str |> of_string |> to_float)
548-
in
549-
550-
let test_of_string_invertible_when_no_dashes () =
551-
check_string "to_string inverts of_string" no_dash_utc_time_str (no_dash_utc_time_str |> of_string |> to_string);
552-
check_true "of_string inverts to_string" (eq (no_dash_utc_time_str |> of_string) (no_dash_utc_time_str |> of_string |> to_string |> of_string));
553-
in
554-
555-
(* CA-338243 - breaking backwards compatibility will break XC and XRT *)
556-
let test_to_string_backwards_compatibility () =
557-
check_string "to_string is backwards compatible" no_dash_utc_time_str
558-
(dash_time_str |> of_string |> to_string)
559-
in
560-
561-
let test_localtime_string () =
562-
let[@warning "-8"] (Ok (t, _, _)) =
563-
Ptime.of_rfc3339 "2020-04-07T09:01:28Z"
564-
in
565-
let minus_2_hrs = -7200 in
566-
let plus_3_hrs = 10800 in
567-
let zero_hrs = 0 in
568-
check_string "can subtract 2 hours" (_localtime_string (Some minus_2_hrs) t) "20200407T07:01:28";
569-
check_string "can add 3 hours" (_localtime_string (Some plus_3_hrs) t) "20200407T12:01:28";
570-
check_string "can add None" (_localtime_string None t) "20200407T09:01:28";
571-
check_string "can add zero" (_localtime_string (Some zero_hrs) t) "20200407T09:01:28"
572-
in
573-
574-
(* sanity check (on top of test_localtime_string) that localtime produces valid looking output *)
575-
let test_ca342171 () =
576-
(* no exception is thrown + backward compatible formatting *)
577-
let localtime_string = localtime () |> to_string in
578-
Alcotest.(check int) "localtime string has correct number of chars"
579-
(String.length localtime_string) (String.length no_dash_utc_time_str - 1);
580-
Alcotest.(check bool) "localtime string does not contain a Z" false (String.contains localtime_string 'Z')
581-
in
582-
583-
[ "test_of_float_invertible", `Quick, test_of_float_invertible
584-
; "test_only_utc", `Quick, test_only_utc
585-
; "test_ca333908", `Quick, test_ca333908
586-
; "test_of_string_invertible_when_no_dashes", `Quick, test_of_string_invertible_when_no_dashes
587-
; "test_to_string_backwards_compatibility", `Quick, test_to_string_backwards_compatibility
588-
; "test_localtime_string", `Quick, test_localtime_string
589-
; "test_ca342171", `Quick, test_ca342171
590-
]
591-
592-
let tests = iso8601_tests
593-
end
594-
595519
let tests =
596520
UCS .tests @
597521
XML .tests @
598522
String_validator .tests @
599523
UTF8_UCS_validator .tests @
600524
XML_UTF8_UCS_validator.tests @
601-
UTF8_codec .tests @
602-
Date .tests
525+
UTF8_codec .tests
526+
527+
let () =
528+
Alcotest.run
529+
"encodings"
530+
[ "Test_encodings", tests ]

‎lib_test/dune‎

Lines changed: 0 additions & 13 deletions
This file was deleted.

‎lib_test/suite.ml‎

Lines changed: 0 additions & 5 deletions
This file was deleted.

‎xapi-stdext-date.opam‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,11 +6,15 @@ dev-repo: "git://github.com/xapi-project/stdext.git"
66
homepage: "https://xapi-project.github.io/"
77
tags: [ "org:xapi-project" ]
88

9-
build: [[ "dune" "build" "-p" name "-j" jobs ]]
9+
build: [
10+
[ "dune" "build" "-p" name "-j" jobs ]
11+
[ "dune" "runtest" "-p" name "-j" jobs ] {with-test}
12+
]
1013

1114
depends: [
1215
"ocaml"
1316
"dune" {build}
17+
"alcotest" {with-test}
1418
"astring"
1519
"base-unix"
1620
"ptime"

0 commit comments

Comments
 (0)