Work to add UTC tracking to wall-times
authorRuss Tyndall <russ@acceleration.net>
Sun, 4 Feb 2018 19:43:58 +0000 (14:43 -0500)
committerRuss Tyndall <russ@acceleration.net>
Tue, 6 Feb 2018 16:46:53 +0000 (11:46 -0500)
 * We handle timezones by converting to UTC time during parse
 * Ends up leaving wall-times that look like locatimes,
   but are UTC
 * Causes times to advance by zone-offset every read/write
   to a timezone aware database (postgresql-socket3)
 * To prevent this we will track whether a date will be in UTC
   or is a local time.  When writing out UTC timestamps we add a Z to
   the end
 * During comparison, we always convert to UTC to compare,
   we assume zoneless timestamps are localtimes

There was a lot of personal debate about how to do this. I think a
better answer would be to fully replace clsql-date/times with the
local-time library which has a more comprehensive handling of dates
and times.

re ADWolf:#1408

ChangeLog
clsql.asd
db-postgresql-socket3/sql.lisp
sql/time.lisp
tests/test-init.lisp
tests/test-time.lisp
tests/utc-time-compare.lisp [new file with mode: 0644]

index 8827550d1b05b85e99473370d5d846622da0367f..29ac560c8302fc0f5b8fdf1aeeeb9880f468de14 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,30 @@
+2018-02-03 Russ Tyndall <russ@acceleration.net>
+       * sql/time.lisp, tests/time.lisp:       
+       Better distinguishing between zoneless timestamps and UTC times,
+       particularly as relates to postgresql-socket(3) backends. Without
+       this change, timestamptzs are read as localtimes and saved as
+       localtimes, when they should be read and printed as UTC times,
+       this bug will lead to dates changing every save as they are being
+       reconverted to UTC again.
+
+       We followed a minimal approach (following postgresql' lead), we
+       simply add a is-utc? boolean.  Before this, zoned times were
+       converted to UTC, but since we never tracked that it was a UTC
+       time vs a zoneless time, there was conflation between the two.  In
+       order to preserver comparability between dates and times that are
+       local vs UTC. I wrote a `time-to-utc` utilizing decode-time's
+       implementation dependent timezone defaulting.
+       (I verified the math by comparing results to the local-time
+       library from quicklisp).
+
+       Ultimately, adoption of a third party datetime library is my
+       strong preference (eg: local-time).  While this project has, as a
+       whole refrained from outside requirements, I think that we should
+       consider moving to local-time as our date / time format, or
+       providing that as an option, both to support a semi standardized
+       eco system, and also to have a more robust timestamp implementation.
+
+
 2016-01-26 Kevin Rosenberg <kevin@rosenberg.net>
        * Version 6.7.0 release
        * sql/utils.lisp: Apply patch from Martin Simmons for
index 4f009505eed9ef3e3603214f2133f2ea5af69340..c1c46aaaebab2f03509cc9e8f16b8fe8ddd4e1ce 100644 (file)
--- a/clsql.asd
+++ b/clsql.asd
@@ -41,7 +41,7 @@
 the Xanalys CommonSQL interface for Lispworks. It provides low-level
 database interfaces as well as a functional and an object
 oriented interface."
-    :version "6.4"
+    :version "6.7.0"
     :components
     ((:module sql
              :components
index 3172e6dbd7b2881aaebc1f9c2008fe1aa6aa1eeb..8edacf12995ae4c2f14f88d427120b4917d47b53 100644 (file)
 (defpackage :clsql-postgresql-socket3
     (:use #:common-lisp #:clsql-sys #:postgresql-socket3)
     (:export #:postgresql-socket3-database)
-    (:documentation "This is the CLSQL socket interface (protocol version 3) to PostgreSQL."))
+    (:documentation
+     "This is the CLSQL socket interface (protocol version 3) to PostgreSQL."))
 
 (in-package #:clsql-postgresql-socket3)
 
 (defvar *sqlreader* (cl-postgres:copy-sql-readtable))
-(let ((dt-fn (lambda (useconds-since-2000)
-              (let ((sec (truncate
-                          (/ useconds-since-2000
-                             1000000)))
-                    (usec (mod useconds-since-2000
-                               1000000)))
-                (clsql:make-time :year 2000 :second sec :usec usec)))))
+
+
+(labels ((d-fn (days-since-2000)
+           (clsql:make-date :year 2000 :day (+ 1 days-since-2000)))
+         (dt-tz-fn (useconds-since-2000
+                    &aux (dt (dt-fn useconds-since-2000)))
+           (setf (clsql-sys::time-is-utc? dt) t)
+           dt)
+         (dt-fn (useconds-since-2000)
+           (let* ((sec (floor useconds-since-2000 1000000))
+                  (usec (mod useconds-since-2000 1000000))
+                  (time (clsql:make-time :year 2000 :second sec :usec usec)))
+             time)))
   (cl-postgres:set-sql-datetime-readers
    :table *sqlreader*
-   :date (lambda (days-since-2000)
-          (clsql:make-date :year 2000 :day (+ 1 days-since-2000)))
-   :timestamp dt-fn
-   :timestamp-with-timezone dt-fn))
+   :timestamp #'dt-fn
+   :timestamp-with-timezone #'dt-tz-fn
+   :date #'d-fn))
 
 
 
             (declare (type (signed-byte 32) cl-postgres::size))
             (if (eq cl-postgres::size -1)
                 nil
-                (funcall (cl-postgres::field-interpreter cl-postgres::field)
-                         stream cl-postgres::size)))))
+                 (funcall (cl-postgres::field-interpreter cl-postgres::field)
+                          stream cl-postgres::size)))))
     (let ((results (loop :while (cl-postgres:next-row)
                         :collect (loop :for field :across fields
                                        :collect (cl-postgres:next-field field))))
index 0bb18c340b45aad6aaaec43ab4cc3172739b397c..a7674a89277594218dc6c15b8f02b22701a253ea 100644 (file)
 ;; ------------------------------------------------------------
 ;; time classes: wall-time, duration
 
-(eval-when (:compile-toplevel :load-toplevel)
 
+(eval-when (:compile-toplevel :load-toplevel)
 (defstruct (wall-time (:conc-name time-)
                       (:constructor %make-wall-time)
                       (:print-function %print-wall-time))
   (mjd 0 :type fixnum)
   (second 0 :type fixnum)
-  (usec 0 :type fixnum))
+  (usec 0 :type fixnum)
+  (is-utc? nil :type boolean))
 
 (defun %print-wall-time (time stream depth)
   (declare (ignore depth))
 ;; ------------------------------------------------------------
 ;; Constructors
 
+(defvar *default-timezone*)
+(defvar *default-timezone-is-dst?*)
+
+;; allows non implementation specific timezone defaulting.
+;; Its mostly for testing, or setting directly to UTC
+;; as its assumed to be relying on operating system / lisp system
+;; defaults for what your local time is otherwise
+(defun %decode-utime (ut)
+  (multiple-value-bind
+        (sec min hour day month year day-of-week dst? tz)
+      (decode-universal-time ut)
+    (values sec min hour day month year day-of-week
+            (or (when (boundp '*default-timezone-is-dst?*)
+                  *default-timezone-is-dst?*)
+                dst?)
+            (or (when (boundp '*default-timezone*)
+                  *default-timezone*)
+                tz))))
+
+(defun %universal-ts-offset (time)
+  ;; I verified this using the local-time lib as example
+  ;; --- see tests/utc-time-compare.lisp
+  (multiple-value-bind (tusec tsec tmin thour tday tmonth tyear)
+      (decode-time time)
+    (declare (ignore tusec))
+    ;; find tz info and apply to wall-time
+    (multiple-value-bind
+          (_sec _min _hour _day _month _year _day-of-week dst? tz)
+        (%decode-utime
+         (encode-universal-time
+          tsec tmin thour tday tmonth tyear))
+      (declare (ignore _sec _min _hour _day _month _year _day-of-week))
+      (when dst?
+        (incf tz -1))
+      (values (- (* tz 60 60)) tz))))
+
+(defun time-to-utc (in)
+  "Ensures that if we have a time thats not in UTC, treat it as a localtime,
+   and convert to UTC"
+  (if (time-is-utc? in)
+      in
+      (let ((newt
+              (time+ in (make-duration :second (%universal-ts-offset in)))))
+        (setf (time-is-utc? newt) T)
+        newt)))
+
 (defun make-time (&key (year 0) (month 1) (day 1) (hour 0) (minute 0)
-                       (second 0) (usec 0) (offset 0))
-  (let ((mjd (gregorian-to-mjd month day year))
-        (sec (+ (* hour 60 60)
-                (* minute 60)
-                second (- offset))))
-    (multiple-value-bind (day-add raw-sec)
-        (floor sec (* 60 60 24))
-      (%make-wall-time :mjd (+ mjd day-add) :second raw-sec :usec usec))))
+                  (second 0) (usec 0) (offset nil))
+  (let* ((mjd (gregorian-to-mjd month day year))
+         (sec (+ (* hour 60 60)
+                 (* minute 60)
+                 second (or offset 0)))
+         (time (multiple-value-bind (day-add raw-sec)
+                   (floor sec (* 60 60 24))
+                 (%make-wall-time :mjd (+ mjd day-add)
+                                  :second raw-sec :usec (or usec 0)
+                                  :is-utc? (if offset t nil)))))
+    time))
 
 (defun make-date (&key (year 0) (month 1) (day 1) (hour 0) (minute 0)
-                       (second 0) (usec 0) (offset 0))
+                       (second 0) (usec 0) (offset nil))
   (time->date (make-time :year year :month month :day day :hour hour
-                         :minute minute :second second :usec usec :offset offset)))
+                         :minute minute :second second :usec usec
+                         :offset offset)))
 
 (defun copy-time (time)
   (%make-wall-time :mjd (time-mjd time)
-                   :second (time-second time)))
+                   :second (time-second time)
+                   :usec (time-usec time)
+                   :is-utc? (time-is-utc? time)))
 
 (defun utime->time (utime)
   "Return a pair: (GREGORIAN DAY . TIME-OF-DAY)"
       (time-ymd time)
     (multiple-value-bind (hour minute second)
         (time-hms time)
-      (values (time-usec time) second minute hour day month year (mod (+ (time-mjd time) 3) 7)))))
+      (values (time-usec time) second minute hour day month year
+              (mod (+ (time-mjd time) 3) 7)
+              (time-is-utc? time)))))
 
 (defun date-ymd (date)
   (time-ymd (date->time date)))
   (duration< y x))
 
 (defun %time< (x y)
+  (setf x (time-to-utc x)
+        y (time-to-utc y))
   (let ((mjd-x (time-mjd x))
         (mjd-y (time-mjd y)))
     (if (/= mjd-x mjd-y)
             (< (time-usec x) (time-usec y))))))
 
 (defun %time>= (x y)
+  (setf x (time-to-utc x)
+        y (time-to-utc y))
   (if (/= (time-mjd x) (time-mjd y))
       (>= (time-mjd x) (time-mjd y))
       (if (/= (time-second x) (time-second y))
           (>= (time-usec x) (time-usec y)))))
 
 (defun %time<= (x y)
+  (setf x (time-to-utc x)
+        y (time-to-utc y))
   (if (/= (time-mjd x) (time-mjd y))
       (<= (time-mjd x) (time-mjd y))
       (if (/= (time-second x) (time-second y))
           (<= (time-usec x) (time-usec y)))))
 
 (defun %time> (x y)
+  (setf x (time-to-utc x)
+        y (time-to-utc y))
   (if (/= (time-mjd x) (time-mjd y))
       (> (time-mjd x) (time-mjd y))
       (if (/= (time-second x) (time-second y))
           (> (time-usec x) (time-usec y)))))
 
 (defun %time= (x y)
+  (setf x (time-to-utc x)
+        y (time-to-utc y))
   (and (= (time-mjd x) (time-mjd y))
        (= (time-second x) (time-second y))
        (= (time-usec x) (time-usec y))))
 
 ;; ------------------------------------------------------------
 ;; Formatting and output
-(defun db-timestring (time &key stream)
+(defun db-timestring (time &key stream )
   "return the string to store the given time in the database"
   (if stream
       (progn (write-char #\' stream) (iso-timestring time :stream stream) (write-char #\' stream))
       (concatenate 'string "'" (iso-timestring time) "'")))
 
 (defun iso-timestring (time &key stream)
-  (multiple-value-bind (usec sec min hour day month year dow)
+  (multiple-value-bind (usec sec min hour day month year dow is-utc?)
       (decode-time time)
     (declare (ignore dow))
     (flet ((fmt (stream)
                          (setf usec (- usec (* quo x10)))
                          (princ quo stream)
                          (when (= rem 0) (return)))))
+             (when is-utc? (princ #\Z stream))
             nil))
       (if stream
          (fmt stream)
@@ -824,7 +890,7 @@ with the given options"
   "produces on stream the timestring corresponding to the wall-time
 with the given options"
   (let ((*print-circle* nil))
-    (multiple-value-bind (usec second minute hour day month year dow)
+    (multiple-value-bind (usec second minute hour day month year dow is-utc?)
         (decode-time time)
       (case format
         (:pretty
@@ -839,11 +905,12 @@ with the given options"
                   (pretty-time hour minute)
                   month day year))
         ((:iso :iso8601) (iso-timestring time :stream stream))
-        (t (format stream "~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D.~6,'0D"
+        (t (format stream "~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D~A~2,'0D.~6,'0D~A"
                   year date-separator month date-separator day
                   internal-separator hour time-separator minute time-separator
-                  second usec)
-          )))))
+                  second usec
+                   (if is-utc? "Z" ""))
+         )))))
 
 (defun pretty-time (hour minute)
   (cond
@@ -1178,11 +1245,13 @@ rules"
 ;; Parsing iso-8601 timestrings
 
 (define-condition iso-8601-syntax-error (sql-user-error)
-  ((bad-component;; year, month whatever
+  ((input :initarg :input :reader input)
+   (bad-component;; year, month whatever
     :initarg :bad-component
     :reader bad-component))
   (:report (lambda (c stream)
-             (format stream "Bad component: ~A " (bad-component c)))))
+             (format stream "Bad component: ~A of input: ~A "
+                     (bad-component c) (input c)))))
 
 (defun parse-timestring (timestring &key (start 0) end junk-allowed)
   "parse a timestring and return the corresponding wall-time.  If the
@@ -1290,6 +1359,40 @@ Will throw a hissy fit if the date string is a duration. Will ignore any precisi
                :usec usec
                :offset offset)))
 
+(defun %frac-string-to-usec (frac-str)
+  (when frac-str
+    (let* ((frac (parse-integer frac-str))
+           (frac-len (length frac-str))
+           (frac-exp (- 6 frac-len)))
+      (floor (* frac (expt 10 frac-exp))))))
+
+(defun %parse-offset-string (offset-str input &aux (len (length offset-str)))
+  (when (zerop len)
+    (return-from %parse-offset-string nil))
+  (when (and (= len 1) (char= #\Z (char offset-str 0)))
+    (return-from %parse-offset-string 0))
+  (let ((pos? (char= #\+ (char offset-str 0)))
+        (colon? (position #\: offset-str)))
+    (unless (or (member len '(3 5))     ;; +05 or -0530
+                (and colon? (= 6 len))) ;; +05:30
+      (error 'iso-8601-syntax-error
+             :input input
+             :bad-component `(timezone . ,offset-str)))
+    (handler-bind ((error (lambda (c) (declare (ignore c))
+                            (error 'iso-8601-syntax-error
+                                   :input input
+                                   :bad-component `(timezone . ,offset-str))
+                            )))
+      (let* ((hours (parse-integer offset-str :start 1 :end 3))
+             (hsec (* 60 60 hours))
+             (sec (* 60 (cond
+                          (colon?
+                           (parse-integer offset-str :start 4))
+                          ((> len 3)
+                           (parse-integer offset-str :start 3))
+                          (t 0))))
+             (total (+ hsec sec)))
+        (if pos? (- total) total)))))
 
 (defun syntax-parse-iso-8601 (string)
   ;; use strlen to determine if fractional seconds are present in timestamp
@@ -1309,45 +1412,36 @@ Will throw a hissy fit if the date string is a duration. Will ignore any precisi
                 second         (if (<= 19 strlen)
                                    (parse-integer string :start 17 :end 19)
                                    0))
-          (cond
-            ((and (> strlen 19)
-                  (or (char= #\, (char string 19))
-                      (char= #\. (char string 19))))
-             (multiple-value-bind (parsed-usec usec-end)
-                 (parse-integer string :start 20 :junk-allowed t)
-               (let ((parsed-usec (and parsed-usec
-                                      (floor (* parsed-usec (expt 10 (+ 6 (- usec-end) 20)))))))
-                (setf usec          (or parsed-usec 0)
-                      gmt-sec-offset (if (<= (+ 3 usec-end)  strlen)
-                                         (let ((skip-to (or (position #\+ string :start 19)
-                                                            (position #\- string :start 19))))
-                                           (if skip-to
-                                               (* 60 60
-                                                  (parse-integer string :start skip-to
-                                                                 :end (+ skip-to 3)))
-                                               0))
-                                         0)))))
-            (t
-             (setf usec           0
-                   gmt-sec-offset (if (<= 22  strlen)
-                                      (let ((skip-to (or (position #\+ string :start 19)
-                                                         (position #\- string :start 19))))
-                                        (if skip-to
-                                            (* 60 60
-                                               (parse-integer string :start skip-to
-                                                              :end (+ skip-to 3)))
-                                            0))
-                                      0))))
-          (unless (< 0 year)
-            (error 'iso-8601-syntax-error
-                   :bad-component '(year . 0)))
-          (unless (< 0 month)
-            (error 'iso-8601-syntax-error
-                   :bad-component '(month . 0)))
-          (unless (< 0 day)
-            (error 'iso-8601-syntax-error
-                   :bad-component '(month . 0)))
-          (values year month day hour minute second usec gmt-sec-offset))
+          (when (> strlen 19)
+            ;; fractional second
+            (let* ((has-frac? (or (char= #\, (char string 19))
+                                   (char= #\. (char string 19))))
+                   (z-idx (position #\Z string :start 19))
+                   (offset-start (or (position #\+ string :start 19)
+                                     (position #\- string :start 19)))
+                   (frac-end (or z-idx offset-start strlen ))
+                   (frac-string (when has-frac? (subseq string 20 frac-end)))
+                   (offset-string (when offset-start
+                                    (subseq string offset-start))))
+              (setf usec (or (%frac-string-to-usec frac-string)
+                             0)
+                    gmt-sec-offset
+                    (cond
+                      (z-idx 0)
+                      (offset-string
+                       (%parse-offset-string offset-string string))))))
+
+            (unless (< 0 year)
+              (error 'iso-8601-syntax-error
+                     :input string
+                     :bad-component '(year . 0)))
+            (unless (< 0 month)
+              (error 'iso-8601-syntax-error
+                     :bad-component '(month . 0)))
+            (unless (< 0 day)
+              (error 'iso-8601-syntax-error
+                     :bad-component '(month . 0)))
+            (values year month day hour minute second usec gmt-sec-offset))
       (simple-error ()
         (error 'iso-8601-syntax-error
                :bad-component
@@ -1355,5 +1449,4 @@ Will throw a hissy fit if the date string is a duration. Will ignore any precisi
                              `((year . ,year) (month . ,month)
                                (day . ,day) (hour . ,hour)
                                (minute . ,minute) (second . ,second)
-                               (usec . ,usec)
-                               (timezone . ,gmt-sec-offset)))))))))
+                               (usec . ,usec)))))))))
index 8312784216c8fd84f50f4575f255bab0de691363..2ad787bdc6d48d5781cda33d2ae265e534125f12 100644 (file)
   *default-database*)
 
 (defun rl ()
-  (rapid-load :postgresql))
+  (rapid-load :postgresql-socket3))
 
 (defun rlm ()
   (rapid-load :mysql))
index e5b4d64befccba2ea7190fe17e99e7fc991a52e1..d631340a36b15f816c62c547af2931ef52f1637c 100644 (file)
 (deftest :time/iso-parse/0
     (let* ((time1 (parse-timestring "2010-01-23")))
       (decode-time time1))
-  0 0 0 0 23 1 2010 6)
+  0 0 0 0 23 1 2010 6 nil)
 
 (deftest :time/iso-parse/1
     (let* ((time1 (parse-timestring "2010-01-23T14:56:32Z")))
       (decode-time time1))
 0 32 56 14 23 1 2010 6)
0 32 56 14 23 1 2010 6 T)
 
 (deftest :time/iso-parse/2
     (let* ((time1 (parse-timestring "2008-02-29 12:46:32")))
       (decode-time time1))
-  0 32 46 12 29 2 2008 5)
+  0 32 46 12 29 2 2008 5 nil)
 
 (deftest :time/iso-parse/3
     (let* ((time1 (parse-timestring "2010-01-23 14:56:32.44")))
       (decode-time time1))
-  440000 32 56 14 23 1 2010 6)
+  440000 32 56 14 23 1 2010 6 nil)
 
 (deftest :time/iso-parse/4
     (let* ((time1 (parse-timestring "2010-01-23 14:56:32.0044")))
       (decode-time time1))
-  4400 32 56 14 23 1 2010 6)
+  4400 32 56 14 23 1 2010 6 nil)
 
 (deftest :time/iso-parse/5
     (let* ((time1 (parse-timestring "2010-01-23 14:56:32.000003")))
       (decode-time time1))
-  3 32 56 14 23 1 2010 6)
+ 3 32 56 14 23 1 2010 6 nil)
+
+(deftest :time/iso-parse/6
+    (let* ((time1 (parse-timestring "2010-01-23T14:56:32-05")))
+      (decode-time time1))
+ 0 32 56 19 23 1 2010 6 t)
+
+(deftest :time/iso-parse/7
+    (let* ((time1 (parse-timestring "2010-01-23T14:56:32-05")))
+      (decode-time time1))
+ 0 32 56 19 23 1 2010 6 t)
+
+(deftest :time/iso-parse/8
+    (let* ((time1 (parse-timestring "2010-01-23T14:56:32-05:30")))
+      (decode-time time1))
+  0 32 26 20 23 1 2010 6 t)
 
 (deftest :time/print-parse/1
     ;;make sure when we print and parse we get the same time.
@@ -84,7 +99,7 @@
           (string-time (iso-timestring time))
           (time2 (parse-timestring string-time)))
       (decode-time time2))
-  0 44 15 14 4 1 2010 1)
+  0 44 15 14 4 1 2010 1 nil)
 
 (deftest :time/print-parse/2
     ;;make sure when we print and parse we get the same time.
           (string-time (iso-timestring time))
           (time2 (parse-timestring string-time)))
       (decode-time time2))
-  3 44 15 14 4 1 2010 1)
+  3 44 15 14 4 1 2010 1 nil)
 
 
 ;; relations of intervals
 
 ;;; The cross platform dataset uses the 'timestamp' column type which is
 ;;; in sql-92, for all that means.
-
 (deftest :time/cross-platform/no-usec/no-tz
     (with-dataset *cross-platform-datetest*
       (let ((time (parse-timestring "2008-09-09T14:37:29")))
          )))
   #.(format-time nil (parse-timestring "2008-09-09T14:37:29") :format :iso))
 
+ ;; I think the reasonable thing is that timezones be stripped and dates be
+ ;; converted to UTC, as the DB should be returning a zoneless stamp
 (deftest :time/cross-platform/no-usec/tz
     (with-dataset *cross-platform-datetest*
       (let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
                                    :where [= [testtime] time] ))))
          (format-time nil (parse-timestring testtime) :format :iso)
          )))
-  #.(format-time nil (parse-timestring "2008-09-09T14:37:29-04:00") :format :iso))
+ ;; I think the reasonable thing is that timezones be stripped, as the DB should
+ ;; be returning a zoneless stamp
+  #.(format-time nil (parse-timestring "2008-09-09T18:37:29") :format :iso))
 
 ;;;This test gets at the databases that only support miliseconds,
 ;;; not microseconds.
                                    :where [= [testtime] time] ))))
          (format-time nil (parse-timestring testtime) :format :iso)
          )))
-  #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213-04:00") :format :iso))
+  #.(format-time nil (parse-timestring "2008-09-09T18:37:29.000213") :format :iso))
 
 
 
 ;;; All odbc databases use local times exclusively (they do not send timezone info)
 ;;; Postgresql can use timezones, except when being used over odbc.  This test when
 ;;; run through both postgres socket and postgres odbc should test a fairly
-;;; broad swath of available problem space
+;;; broad swath of available problem space, Timestamptz should return UTC times,
+;;; timestamps should return zoneless local times
 ;;;
 ;;; Things the following tests try to prove correct
 ;;;  * Reading and writing usec and usec-less times
                               :where [= [testtime] time] ))
        (values (iso-timestring (parse-timestring testtime))
                (iso-timestring (parse-timestring testtimetz))))))
-  #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000213-04:00"))
+  #.(iso-timestring (parse-timestring "2008-09-09T18:37:29.000213"))
   #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
 
 (deftest :time/pg/oodml/no-usec
        (update-instance-from-records o)
        (values (iso-timestring (testtime o))
                (iso-timestring (testtimetz o))))))
-  #.(iso-timestring (parse-timestring "2008-09-09T14:37:29-04:00"))
+  #.(iso-timestring (parse-timestring "2008-09-09T18:37:29"))
   #.(iso-timestring (parse-timestring "2008-09-09T14:37:29-04:00")))
 
 (deftest :time/pg/oodml/usec
          (values (iso-timestring (testtime o))
                  (iso-timestring (testtimetz o)))
          )))
-    #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000278-04:00"))
+    #.(iso-timestring (parse-timestring "2008-09-09T18:37:29.000278"))
     #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000278-04:00")))
 
 (deftest :time/historic-datetimes
diff --git a/tests/utc-time-compare.lisp b/tests/utc-time-compare.lisp
new file mode 100644 (file)
index 0000000..215cae9
--- /dev/null
@@ -0,0 +1,58 @@
+(in-package :clsql-tests)
+
+;;;; This file contains a test ensuring that our utc conversion goes the same
+;;;; though UTC as it would through local-time, the values should match in each pairing
+;;;; This is left as a manual test, because it requires local-time and nothing else does
+;;;;
+
+(ql:quickload :local-time)
+(local-time:reread-timezone-repository)
+
+(defun %localtime-timestamp-offset (time)
+  (when (time-is-utc? time)
+    (return-from %localtime-timestamp-offset 0))
+  (multiple-value-bind (tusec tsec tmin thour tday tmonth tyear)
+      (decode-time time)
+    (multiple-value-bind (_nsec _sec _min _hour _day _month _year
+                          _day-of-week _daylight-saving-time-p
+                          offset)
+        (local-time:decode-timestamp
+         (local-time:encode-timestamp
+          (* 1000 (or tusec 0)) tsec tmin thour tday tmonth tyear))
+      (declare (ignore _nsec _sec _min _hour _day _month _year
+                       _day-of-week _daylight-saving-time-p))
+      offset)))
+
+(list
+ (let* ((clsql-sys::*default-timezone* -1)
+        (clsql-sys::*default-timezone-is-dst?* t)
+        (local-time:*default-timezone*
+          (local-time:find-timezone-by-location-name "Europe/Berlin"))
+        (ts (parse-timestring "2017-07-01T08:10:00")))
+   (list (multiple-value-list (clsql-sys::%universal-ts-offset ts))
+         (multiple-value-list  (clsql-sys::%localtime-timestamp-offset ts))))
+
+ (let* ((clsql-sys::*default-timezone* -1)
+        (clsql-sys::*default-timezone-is-dst?* nil)
+        (local-time:*default-timezone*
+          (local-time:find-timezone-by-location-name "Europe/Berlin"))
+        (ts (parse-timestring "2017-12-01T08:10:00")))
+   (list (multiple-value-list (clsql-sys::%universal-ts-offset ts))
+         (multiple-value-list  (clsql-sys::%localtime-timestamp-offset ts))))
+
+ (let* ((clsql-sys::*default-timezone* 5)
+        (clsql-sys::*default-timezone-is-dst?* t)
+        (local-time:*default-timezone*
+          (local-time:find-timezone-by-location-name "America/New_York"))
+        (ts (parse-timestring "2017-07-01T08:10:00")))
+   (list (multiple-value-list (clsql-sys::%universal-ts-offset ts))
+         (multiple-value-list  (clsql-sys::%localtime-timestamp-offset ts))))
+
+ (let* ((clsql-sys::*default-timezone* 5)
+        (clsql-sys::*default-timezone-is-dst?* nil)
+        (local-time:*default-timezone*
+          (local-time:find-timezone-by-location-name "America/New_York"))
+        (ts (parse-timestring "2017-12-01T08:10:00")))
+   (list (multiple-value-list (clsql-sys::%universal-ts-offset ts))
+         (multiple-value-list  (clsql-sys::%localtime-timestamp-offset ts))))
+ )