Tests and bug fixes

.gitignore

@@ -0,0 +1,5 @@
+*~
+_build
+_tests
+*.native
+*.byte

.merlin

@@ -0,0 +1,4 @@
+PKG alcotest
+
+S src
+B _build/**

Makefile

@@ -1,13 +1,21 @@
+.PHONY: build test install uninstall doc gh-pages clean
+
 LIB=ISO8601
 LIB_FILES=$(addprefix $(LIB)., a cmxa cma cmi)
 VERSION=0.2.4
 
+OCAMLBUILD=ocamlbuild -use-ocamlfind -classic-display
+
 .INTERMEDIATE: $(LIB).odocl
 
 build: $(LIB_FILES)
 
 $(LIB_FILES):
-	ocamlbuild -I src $@
+	$(OCAMLBUILD) $@
+
+test:
+	$(OCAMLBUILD) test.native
+	./test.native
 
 install: META $(LIB_FILES)
 	ocamlfind install $(LIB) META $(addprefix _build/src/, $(LIB_FILES))
@@ -19,7 +27,7 @@ $(LIB).odocl:
 	echo 'ISO8601' > $@
 
 doc: $(LIB).odocl
-	ocamlbuild -I src $(LIB).docdir/index.html
+	$(OCAMLBUILD) $(LIB).docdir/index.html
 
 gh-pages: doc
 	commitmsg="Documentation for $(VERSION) version." \
@@ -28,7 +36,4 @@ gh-pages: doc
 	ghpup
 
 clean:
-	ocamlbuild -clean
-
-clean:
-	ocamlbuild -clean
+	$(OCAMLBUILD) -clean

_tags

@@ -0,0 +1,2 @@
+"src": include
+"test": include

opam

@@ -20,10 +20,17 @@ bug-reports: "https://github.com/sagotch/ISO8601.ml/issues"
 
 build-doc: [ make "doc" ]
 
+build-test: [ make "test" ]
+
 build: [ make "build" ]
 
 install: [ make "install" ]
 
 remove: [ "ocamlfind" "remove" "ISO8601" ]
 
-depends: [ "ocamlfind" ]
+depends: [
+  "ocamlfind" {build}
+  "ocamlbuild" {build}
+  "base-unix"
+  "alcotest" {test}
+]

src/ISO8601.ml

@@ -13,9 +13,17 @@ module Permissive = struct
     let datetime_tz_lex ?(reqtime=true) lexbuf =
       let d = date_lex lexbuf in
       match Lexer.delim lexbuf with
-      | None -> if reqtime then assert false else (d, None)
-      | Some _ -> let (t, tz) = time_tz_lex lexbuf in
-                  (d +. t, tz)
+      | None ->
+        (* TODO: this should be a real exception *)
+        if reqtime then assert false else (d, None)
+      | Some _ ->
+        let (t, tz) = time_tz_lex lexbuf in
+        match tz with
+        | None -> (d +. t, tz)
+        | Some tz ->
+          let t = d +. t in
+          let offt = fst (Unix.mktime (Unix.gmtime t)) in
+          (t -. (offt -. t), Some tz)
 
     let time_lex lexbuf =
       fst (time_tz_lex lexbuf)
@@ -35,15 +43,25 @@ module Permissive = struct
     let datetime ?(reqtime=true) s =
       datetime_lex ~reqtime:reqtime (Lexing.from_string s)
 
-    (* FIXME: possible loss of precision. *)
     let pp_format fmt format x tz =
 
       let open Unix in
       let open Format in
 
       (* Be careful, do not forget to print timezone if there is one,
        * or information printed will be wrong. *)
-      let x = gmtime (x -. tz) in
+      let x = match tz with
+        | None    -> localtime x
+        | Some tz -> gmtime (x +. tz)
+      in
+
+      let print_tz_hours fmt tz =
+        fprintf fmt "%0+3d" (Pervasives.truncate (tz /. 3600.))
+      in
+
+      let print_tz_minutes fmt tz =
+        fprintf fmt "%02.0f" (mod_float (abs_float (tz /. 60.)) 60.0)
+      in
 
       let conversion =
         let pad2 = fprintf fmt "%02d" in
@@ -61,8 +79,21 @@ module Permissive = struct
         | 's' -> pad2 x.tm_sec
 
         (* Timezone *)
-        | 'Z' -> fprintf fmt "%0+3.0f" (tz /. 3600.) (* Hours *)
-        | 'z' -> fprintf fmt "%02.0f" (mod_float (abs_float (tz /. 60.)) 60.0) (* Minutes *)
+        | 'Z' -> begin match tz with (* with colon *)
+          | None    -> ()
+          | Some 0. -> fprintf fmt "Z"
+          | Some tz ->
+            print_tz_hours fmt tz;
+            fprintf fmt ":";
+            print_tz_minutes fmt tz
+        end
+        | 'z' -> begin match tz with (* without colon *)
+          | None    -> ()
+          | Some 0. -> fprintf fmt "Z"
+          | Some tz ->
+            print_tz_hours fmt tz;
+            print_tz_minutes fmt tz
+        end
 
         | '%' -> pp_print_char fmt '%'
         |  c  -> failwith ("Bad format: %" ^ String.make 1 c)
@@ -80,42 +111,54 @@ module Permissive = struct
 
       parse_format 0
 
-    let pp_date fmt x = pp_format fmt "%Y-%M-%D" x 0.
+    let pp_date_utc fmt x = pp_format fmt "%Y-%M-%D" x (Some 0.)
+    let pp_date     fmt x = pp_format fmt "%Y-%M-%D" x None
 
-    let pp_time fmt x = pp_format fmt "%h:%m:%s" x 0.
+    let pp_time_utc fmt x = pp_format fmt "%h:%m:%s" x (Some 0.)
+    let pp_time     fmt x = pp_format fmt "%h:%m:%s" x None
 
-    let pp_datetime fmt x = pp_format fmt "%Y-%M-%DT%h:%m:%s" x 0.
+    let pp_datetime_utc fmt x = pp_format fmt "%Y-%M-%DT%h:%m:%s" x (Some 0.)
+    let pp_datetime     fmt x = pp_format fmt "%Y-%M-%DT%h:%m:%s" x None
 
     let pp_datetimezone fmt (x, tz) =
-      pp_format fmt "%Y-%M-%DT%h:%m:%s%Z:%z" x tz
+      pp_format fmt "%Y-%M-%DT%h:%m:%s%Z" x (Some tz)
 
-    let pp_date_basic fmt x = pp_format fmt "%Y%M%D" x 0.
+    let pp_date_basic_utc fmt x = pp_format fmt "%Y%M%D" x (Some 0.)
+    let pp_date_basic     fmt x = pp_format fmt "%Y%M%D" x None
 
-    let pp_time_basic fmt x = pp_format fmt "%h%m%s" x 0.
+    let pp_time_basic_utc fmt x = pp_format fmt "%h%m%s" x (Some 0.)
+    let pp_time_basic     fmt x = pp_format fmt "%h%m%s" x None
 
-    let pp_datetime_basic fmt x = pp_format fmt "%Y%M%DT%h%m%s" x 0.
+    let pp_datetime_basic_utc fmt x = pp_format fmt "%Y%M%DT%h%m%s" x (Some 0.)
+    let pp_datetime_basic     fmt x = pp_format fmt "%Y%M%DT%h%m%s" x None
 
     let pp_datetimezone_basic fmt (x, tz) =
-      pp_format fmt "%Y%M%DT%h%m%s%Z%z" x tz
+      pp_format fmt "%Y%M%DT%h%m%s%z" x (Some tz)
 
     let string_of_aux printer x =
       ignore (Format.flush_str_formatter ()) ;
       printer Format.str_formatter x ;
       Format.flush_str_formatter ()
 
-    let string_of_date = string_of_aux pp_date
+    let string_of_date_utc = string_of_aux pp_date_utc
+    let string_of_date     = string_of_aux pp_date
 
-    let string_of_time = string_of_aux pp_time
+    let string_of_time_utc = string_of_aux pp_time_utc
+    let string_of_time     = string_of_aux pp_time
 
-    let string_of_datetime = string_of_aux pp_datetime
+    let string_of_datetime_utc = string_of_aux pp_datetime_utc
+    let string_of_datetime     = string_of_aux pp_datetime
 
     let string_of_datetimezone = string_of_aux pp_datetimezone
 
-    let string_of_date_basic = string_of_aux pp_date_basic
+    let string_of_date_basic_utc = string_of_aux pp_date_basic_utc
+    let string_of_date_basic     = string_of_aux pp_date_basic
 
-    let string_of_time_basic = string_of_aux pp_time_basic
+    let string_of_time_basic_utc = string_of_aux pp_time_basic_utc
+    let string_of_time_basic     = string_of_aux pp_time_basic
 
-    let string_of_datetime_basic = string_of_aux pp_datetime_basic
+    let string_of_datetime_basic_utc = string_of_aux pp_datetime_basic_utc
+    let string_of_datetime_basic     = string_of_aux pp_datetime_basic
 
     let string_of_datetimezone_basic = string_of_aux pp_datetimezone_basic
 

src/ISO8601.mli

@@ -53,8 +53,6 @@ module Permissive : sig
         to [fmt], and conversion specifications, each of which causes
         conversion and printing of (a part of) [x] or [tz].
 
-        {b If you do not want to use a timezone, set it to 0.}
-
         Conversion specifications have the form [%X], where X can be:
 
         - [Y]: Year
@@ -63,42 +61,56 @@ module Permissive : sig
         - [h]: Hours
         - [m]: Minutes
         - [s]: Seconds
-        - [Z]: Hours of [tz] offset (with its sign)
-        - [z]: Minutes of [tz] offset (without sign)
+        - [Z]: Hours and minutes of [tz] offset (with sign), colon separated,
+               'Z' if [tz] offset is 0; if [tz] is None, print nothing
+        - [z]: Hours and minutes of [tz] offset (with sign), without colon,
+               'Z' if [tz] offset is 0; if [tz] is None, print nothing
         - [%]: The '%' character
 
      *)
-    val pp_format : Format.formatter -> string -> float -> float -> unit
+    val pp_format : Format.formatter -> string -> float -> float option -> unit
 
     (** "%Y-%M-%D" format. *)
+    val pp_date_utc : Format.formatter -> float -> unit
     val pp_date : Format.formatter -> float -> unit
+    val string_of_date_utc : float -> string
     val string_of_date : float -> string
 
     (** "%Y%M%D" format. *)
+    val pp_date_basic_utc : Format.formatter -> float -> unit
     val pp_date_basic : Format.formatter -> float -> unit
+    val string_of_date_basic_utc : float -> string
     val string_of_date_basic : float -> string
 
     (** "%h:%m:%s" format. *)
+    val pp_time_utc : Format.formatter -> float -> unit
     val pp_time : Format.formatter -> float -> unit
+    val string_of_time_utc : float -> string
     val string_of_time : float -> string
 
     (** "%h%m%s" format. *)
+    val pp_time_basic_utc : Format.formatter -> float -> unit
     val pp_time_basic : Format.formatter -> float -> unit
+    val string_of_time_basic_utc : float -> string
     val string_of_time_basic : float -> string
 
     (** "%Y-%M-%DT%h:%m:%s" format. *)
+    val pp_datetime_utc : Format.formatter -> float -> unit
     val pp_datetime : Format.formatter -> float -> unit
+    val string_of_datetime_utc : float -> string
     val string_of_datetime : float -> string
 
     (** "%Y%M%DT%h%m%s" format. *)
+    val pp_datetime_basic_utc : Format.formatter -> float -> unit
     val pp_datetime_basic : Format.formatter -> float -> unit
+    val string_of_datetime_basic_utc : float -> string
     val string_of_datetime_basic : float -> string
 
-    (** "%Y-%M-%DT%h:%m:%s%Z:%z" format. *)
+    (** "%Y-%M-%DT%h:%m:%s%Z" format. *)
     val pp_datetimezone : Format.formatter -> (float * float) -> unit
     val string_of_datetimezone : (float * float) -> string
 
-    (** "%Y%M%DT%h%m%s%Z%z" format. *)
+    (** "%Y%M%DT%h%m%s%z" format. *)
     val pp_datetimezone_basic : Format.formatter -> (float * float) -> unit
     val string_of_datetimezone_basic : (float * float) -> string
 

src/ISO8601_lexer.mll

@@ -3,19 +3,17 @@
 
   (* Date helpers *)
   let mkdate y m d =
-    let (t, tm) = Unix.mktime {
-                      Unix.tm_sec = 0 ;
-                      tm_min = 0 ;
-                      tm_hour = 0 ;
-                      tm_mday = d ;
-                      tm_mon = m - 1 ;
-                      tm_year = y - 1900 ;
-                      tm_wday = -1 ;
-                      tm_yday = -1 ;
-                      tm_isdst = false ; } in
-    let offset = fst (Unix.mktime (Unix.gmtime 0. )) in
-    (** FIXME: Ensure the daylight saving time correction is right. *)
-    t -. offset +. (if tm.Unix.tm_isdst then 3600. else 0.)
+    fst (Unix.mktime {
+      Unix.tm_sec = 0 ;
+      tm_min = 0 ;
+      tm_hour = 0 ;
+      tm_mday = d ;
+      tm_mon = m - 1 ;
+      tm_year = y - 1900 ;
+      tm_wday = -1 ;
+      tm_yday = -1 ;
+      tm_isdst = false ;
+    })
 
   let ymd y m d = mkdate (int y) (int m) (int d)
   let ym y m = mkdate (int y) (int m) 1

test/_tags

@@ -0,0 +1 @@
+<*.*>: package(alcotest)