From 67a4ab3576b630b8d34a6476ec8c1e9dfa913800 Mon Sep 17 00:00:00 2001 From: Russ Tyndall Date: Sun, 4 Feb 2018 14:43:58 -0500 Subject: [PATCH] Work to add UTC tracking to wall-times * 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 | 27 ++++ clsql.asd | 2 +- db-postgresql-socket3/sql.lisp | 34 ++--- sql/time.lisp | 219 +++++++++++++++++++++++---------- tests/test-init.lisp | 2 +- tests/test-time.lisp | 49 +++++--- tests/utc-time-compare.lisp | 58 +++++++++ 7 files changed, 297 insertions(+), 94 deletions(-) create mode 100644 tests/utc-time-compare.lisp diff --git a/ChangeLog b/ChangeLog index 8827550..29ac560 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,30 @@ +2018-02-03 Russ Tyndall + * 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 * Version 6.7.0 release * sql/utils.lisp: Apply patch from Martin Simmons for diff --git a/clsql.asd b/clsql.asd index 4f00950..c1c46aa 100644 --- 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 diff --git a/db-postgresql-socket3/sql.lisp b/db-postgresql-socket3/sql.lisp index 3172e6d..8edacf1 100644 --- a/db-postgresql-socket3/sql.lisp +++ b/db-postgresql-socket3/sql.lisp @@ -22,24 +22,30 @@ (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)) @@ -183,8 +189,8 @@ (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)))) diff --git a/sql/time.lisp b/sql/time.lisp index 0bb18c3..a7674a8 100644 --- a/sql/time.lisp +++ b/sql/time.lisp @@ -54,14 +54,15 @@ ;; ------------------------------------------------------------ ;; 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)) @@ -111,24 +112,76 @@ ;; ------------------------------------------------------------ ;; 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)" @@ -196,7 +249,9 @@ (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))) @@ -263,6 +318,8 @@ (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) @@ -272,6 +329,8 @@ (< (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)) @@ -279,6 +338,8 @@ (>= (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)) @@ -286,6 +347,8 @@ (<= (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)) @@ -293,6 +356,8 @@ (> (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)))) @@ -427,14 +492,14 @@ ;; ------------------------------------------------------------ ;; 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) @@ -467,6 +532,7 @@ (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))))))))) diff --git a/tests/test-init.lisp b/tests/test-init.lisp index 8312784..2ad787b 100644 --- a/tests/test-init.lisp +++ b/tests/test-init.lisp @@ -390,7 +390,7 @@ *default-database*) (defun rl () - (rapid-load :postgresql)) + (rapid-load :postgresql-socket3)) (defun rlm () (rapid-load :mysql)) diff --git a/tests/test-time.lisp b/tests/test-time.lisp index e5b4d64..d631340 100644 --- a/tests/test-time.lisp +++ b/tests/test-time.lisp @@ -50,32 +50,47 @@ (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. @@ -93,7 +108,7 @@ (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 @@ -303,7 +318,6 @@ ;;; 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"))) @@ -318,6 +332,8 @@ ))) #.(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"))) @@ -330,7 +346,9 @@ :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. @@ -375,7 +393,7 @@ :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)) @@ -383,7 +401,8 @@ ;;; 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 @@ -406,7 +425,7 @@ :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 @@ -423,7 +442,7 @@ (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 @@ -441,7 +460,7 @@ (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 index 0000000..215cae9 --- /dev/null +++ b/tests/utc-time-compare.lisp @@ -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)))) + ) -- 2.34.1