3 ;;; Copyright (c) 2000, 2001 onShore Development, Inc.
5 ;;; Test time functions (time.lisp)
7 (in-package #:clsql-tests)
8 (clsql-sys:file-enable-sql-reader-syntax)
10 (def-view-class datetest ()
11 ((testtimetz :column "testtimetz"
12 :type clsql-sys:wall-time
15 :accessor testtimetz :initarg :testtimetz
17 :db-type "timestamp with time zone")
18 (testtime :column "testtime"
19 :type clsql-sys:wall-time
22 :accessor testtime :initarg :testtime
24 :db-type "timestamp without time zone")))
26 (def-dataset *ds-datetest*
27 (:setup (lambda () (clsql-sys:create-view-from-class 'datetest)))
28 (:cleanup "DROP TABLE datetest"))
31 (def-dataset *cross-platform-datetest*
32 (:setup (lambda () (create-table [datetest]
33 '(([testtime] wall-time)))))
35 (drop-table [datetest]))))
41 ;; we use parse timestring a lot through here verifying other things
42 ;; start off just checking that.
43 (deftest :time/iso-parse/0
44 (let* ((time1 (parse-timestring "2010-01-23")))
48 (deftest :time/iso-parse/1
49 (let* ((time1 (parse-timestring "2010-01-23T14:56:32Z")))
51 0 32 56 14 23 1 2010 6)
53 (deftest :time/iso-parse/2
54 (let* ((time1 (parse-timestring "2008-02-29 12:46:32")))
56 0 32 46 12 29 2 2008 5)
58 (deftest :time/iso-parse/3
59 (let* ((time1 (parse-timestring "2010-01-23 14:56:32.44")))
61 440000 32 56 14 23 1 2010 6)
63 (deftest :time/iso-parse/4
64 (let* ((time1 (parse-timestring "2010-01-23 14:56:32.0044")))
66 4400 32 56 14 23 1 2010 6)
68 (deftest :time/iso-parse/5
69 (let* ((time1 (parse-timestring "2010-01-23 14:56:32.000003")))
71 3 32 56 14 23 1 2010 6)
73 (deftest :time/print-parse/1
74 ;;make sure when we print and parse we get the same time.
75 (let* ((time (clsql-sys:make-time :year 2010 :month 1 :day 4
76 :hour 14 :minute 15 :second 44))
77 (string-time (iso-timestring time))
78 (time2 (parse-timestring string-time)))
80 0 44 15 14 4 1 2010 1)
82 (deftest :time/print-parse/2
83 ;;make sure when we print and parse we get the same time.
84 (let* ((time (clsql-sys:make-time :year 2010 :month 1 :day 4
85 :hour 14 :minute 15 :second 44 :usec 3))
86 (string-time (iso-timestring time))
87 (time2 (parse-timestring string-time)))
89 3 44 15 14 4 1 2010 1)
92 ;; relations of intervals
94 (let* ((time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
95 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
96 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
97 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
98 (interval-1 (clsql:make-interval :start time-1 :end time-2))
99 (interval-2 (clsql:make-interval :start time-2 :end time-3))
100 (interval-3 (clsql:make-interval :start time-3 :end time-4))
101 (interval-4 (clsql:make-interval :start time-1 :end time-3))
102 (interval-5 (clsql:make-interval :start time-2 :end time-4))
103 (interval-6 (clsql:make-interval :start time-1 :end time-4)))
104 (flet ((my-assert (number relation i1 i2)
105 (declare (ignore number))
106 (let ((found-relation (clsql:interval-relation i1 i2)))
107 (equal relation found-relation))))
109 (my-assert 1 :contains interval-1 interval-1)
110 (my-assert 2 :precedes interval-1 interval-2)
111 (my-assert 3 :precedes interval-1 interval-3)
112 (my-assert 4 :contained interval-1 interval-4)
113 (my-assert 5 :precedes interval-1 interval-5)
114 (my-assert 6 :contained interval-1 interval-6)
115 (my-assert 7 :follows interval-2 interval-1)
116 (my-assert 8 :contains interval-2 interval-2)
117 (my-assert 9 :precedes interval-2 interval-3)
118 (my-assert 10 :contained interval-2 interval-4)
119 (my-assert 11 :contained interval-2 interval-5)
120 (my-assert 12 :contained interval-2 interval-6)
121 (my-assert 13 :follows interval-3 interval-1)
122 (my-assert 14 :follows interval-3 interval-2)
123 (my-assert 15 :contains interval-3 interval-3)
124 (my-assert 16 :follows interval-3 interval-4)
125 (my-assert 17 :contained interval-3 interval-5)
126 (my-assert 18 :contained interval-3 interval-6)
127 (my-assert 19 :contains interval-4 interval-1)
128 (my-assert 20 :contains interval-4 interval-2)
129 (my-assert 21 :precedes interval-4 interval-3)
130 (my-assert 22 :contains interval-4 interval-4)
131 (my-assert 23 :overlaps interval-4 interval-5)
132 (my-assert 24 :contained interval-4 interval-6)
133 (my-assert 25 :follows interval-5 interval-1)
134 (my-assert 26 :contains interval-5 interval-2)
135 (my-assert 27 :contains interval-5 interval-3)
136 (my-assert 28 :overlaps interval-5 interval-4)
137 (my-assert 29 :contains interval-5 interval-5)
138 (my-assert 30 :contained interval-5 interval-6)
139 (my-assert 31 :contains interval-6 interval-1)
140 (my-assert 32 :contains interval-6 interval-2)
141 (my-assert 33 :contains interval-6 interval-3)
142 (my-assert 34 :contains interval-6 interval-4)
143 (my-assert 35 :contains interval-6 interval-5)
144 (my-assert 36 :contains interval-6 interval-6))))
147 ;; adjacent intervals in list
149 (let* ((interval-list nil)
150 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
151 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
152 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
154 (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3
157 (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4
159 (clsql:interval-relation (car interval-list) (cadr interval-list)))
162 ;; nested intervals in list
164 (let* ((interval-list nil)
165 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
166 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
167 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
168 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
170 (clsql:interval-push interval-list (clsql:make-interval :start time-1
174 (clsql:interval-push interval-list (clsql:make-interval :start time-2
177 (let* ((interval (car interval-list))
179 (when interval (car (clsql:interval-contained interval)))))
180 (when (and interval interval-contained)
181 (and (clsql:time= (clsql:interval-start interval) time-1)
182 (clsql:time= (clsql:interval-end interval) time-4)
183 (eq (clsql:interval-type interval) :open)
184 (clsql:time= (clsql:interval-start interval-contained) time-2)
185 (clsql:time= (clsql:interval-end interval-contained) time-3)
186 (eq (clsql:interval-type interval-contained) :closed)))))
189 ;; interval-edit - nonoverlapping
191 (let* ((interval-list nil)
192 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
193 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
194 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
195 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
196 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
197 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 :type :closed)))
198 (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-3))
199 ;; should be time-3 not time-2
200 (clsql:time= (clsql:interval-end (car interval-list)) time-3))
203 ;; interval-edit - overlapping
205 (let* ((interval-list nil)
206 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
207 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
208 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
209 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
210 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
211 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-4 :type :closed)))
216 (clsql:interval-edit interval-list time-1 time-1 time-3))
222 ;; interval-edit - nested intervals in list
224 (let* ((interval-list nil)
225 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
226 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
227 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
228 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
229 (time-5 (clsql:parse-timestring "2002-01-01 14:00:00"))
230 (time-6 (clsql:parse-timestring "2002-01-01 15:00:00")))
231 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-6 :type :open)))
232 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-3 :type :closed)))
233 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-4 :end time-5 :type :closed)))
234 (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-4))
235 ;; should be time-4 not time-6
236 (clsql:time= (clsql:interval-end (car interval-list)) time-4))
239 ;; Test the boundaries of Local Time with granularity of 1 year
241 (let ((sec-in-year (* 60 60 24 365))
242 (year (clsql:time-element (clsql:make-time) :year)))
244 (let ((date (clsql:make-time :second (* n sec-in-year))))
245 (unless (= (+ year n)
246 (clsql:time-element date :year))
250 ;; Test db-timestring
252 (flet ((grab-year (dbstring)
253 (parse-integer (subseq dbstring 1 5))))
254 (let ((second-in-year (* 60 60 24 365)))
256 (let* ((second (* -1 n second-in-year))
257 (date (clsql:make-time :year 2525 :second second)))
259 (= (grab-year (clsql:db-timestring date))
260 (clsql:time-element date :year))
264 ;; Conversion between MJD and Gregorian
266 (dotimes (base 10000 base)
267 (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base))
272 ;; Clsql:Roll by minutes: +90
274 (let ((now (clsql:get-time)))
275 (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90))
276 (clsql:roll now :minute 90)))
279 ;;Clsql:Roll by minutes: +900
281 (let ((now (clsql:get-time)))
282 (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900))
283 (clsql:roll now :minute 900)))
287 ;; Clsql:Roll by minutes: +900
289 (let* ((now (clsql:get-time))
290 (add-time (clsql:time+ now (clsql:make-duration :minute 9000)))
291 (roll-time (clsql:roll now :minute 9000)))
292 (clsql:time= add-time roll-time))
297 ;;; The cross platform dataset uses the 'timestamp' column type which is
298 ;;; in sql-92, for all that means.
300 (deftest :time/cross-platform/no-usec/no-tz
301 (with-dataset *cross-platform-datetest*
302 (let ((time (parse-timestring "2008-09-09T14:37:29")))
303 (clsql-sys:insert-records :into [datetest]
304 :attributes '([testtime])
307 (first (clsql:select [testtime]
308 :from [datetest] :flatp t
309 :where [= [testtime] time] ))))
310 (format-time nil (parse-timestring testtime) :format :iso)
312 #.(format-time nil (parse-timestring "2008-09-09T14:37:29") :format :iso))
314 (deftest :time/cross-platform/no-usec/tz
315 (with-dataset *cross-platform-datetest*
316 (let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
317 (clsql-sys:insert-records :into [datetest]
318 :attributes '([testtime])
321 (first (clsql:select [testtime]
322 :from [datetest] :flatp t
323 :where [= [testtime] time] ))))
324 (format-time nil (parse-timestring testtime) :format :iso)
326 #.(format-time nil (parse-timestring "2008-09-09T14:37:29-04:00") :format :iso))
328 ;;;This test gets at the databases that only support miliseconds,
329 ;;; not microseconds.
330 (deftest :time/cross-platform/msec
331 (with-dataset *cross-platform-datetest*
332 (let ((time (parse-timestring "2008-09-09T14:37:29.423")))
333 (clsql-sys:insert-records :into [datetest]
334 :attributes '([testtime])
337 (first (clsql:select [testtime]
338 :from [datetest] :flatp t
339 :where [= [testtime] time] ))))
340 (format-time nil (parse-timestring testtime) :format :iso)
342 #.(format-time nil (parse-timestring "2008-09-09T14:37:29.423") :format :iso))
344 (deftest :time/cross-platform/usec/no-tz
345 (with-dataset *cross-platform-datetest*
346 (let ((time (parse-timestring "2008-09-09T14:37:29.000213")))
347 (clsql-sys:insert-records :into [datetest]
348 :attributes '([testtime])
351 (first (clsql:select [testtime]
352 :from [datetest] :flatp t
353 :where [= [testtime] time] ))))
354 (format-time nil (parse-timestring testtime) :format :iso)
356 #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213") :format :iso))
358 (deftest :time/cross-platform/usec/tz
359 (with-dataset *cross-platform-datetest*
360 (let ((time (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
361 (clsql-sys:insert-records :into [datetest]
362 :attributes '([testtime])
365 (first (clsql:select [testtime]
368 :where [= [testtime] time] ))))
369 (format-time nil (parse-timestring testtime) :format :iso)
371 #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213-04:00") :format :iso))
376 ;;; All odbc databases use local times exclusively (they do not send timezone info)
377 ;;; Postgresql can use timezones, except when being used over odbc. This test when
378 ;;; run through both postgres socket and postgres odbc should test a fairly
379 ;;; broad swath of available problem space
381 ;;; Things the following tests try to prove correct
382 ;;; * Reading and writing usec and usec-less times
383 ;;; * reading and writing timezones (Z=utc) when appropriate (eg: postgresql-socket)
384 ;;; * reading and writing localtimes when appropriate (eg: ODBC)
385 ;;; * reading and writing through both the oodml and fdml layers
389 (deftest :time/pg/fdml/usec
390 (with-dataset *ds-datetest*
391 (let ((time (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
392 (clsql-sys:insert-records :into [datetest]
393 :attributes '([testtimetz] [testtime])
394 :values (list time time))
395 (destructuring-bind (testtimetz testtime)
396 (first (clsql:select [testtimetz] [testtime]
399 :where [= [testtime] time] ))
400 (values (iso-timestring (parse-timestring testtime))
401 (iso-timestring (parse-timestring testtimetz))))))
402 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000213-04:00"))
403 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
405 (deftest :time/pg/oodml/no-usec
406 (with-dataset *ds-datetest*
407 (let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
408 (clsql-sys:update-records-from-instance
409 (make-instance 'datetest :testtimetz time :testtime time))
410 (let ((o (first (clsql:select
413 :where [= [testtime] time] ))))
414 (assert o (o) "o shouldnt be null here (we should have just inserted)")
415 (update-records-from-instance o)
416 (update-instance-from-records o)
417 (values (iso-timestring (testtime o))
418 (iso-timestring (testtimetz o))))))
419 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29-04:00"))
420 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29-04:00")))
422 (deftest :time/pg/oodml/usec
423 (with-dataset *ds-datetest*
424 (let ((time (parse-timestring "2008-09-09T14:37:29.000278-04:00")))
425 (clsql-sys:update-records-from-instance
426 (make-instance 'datetest :testtimetz time :testtime time))
427 (let ((o (first (clsql:select
430 :where [= [testtime] time] ))))
431 (assert o (o) "o shouldnt be null here (we should have just inserted)")
432 (update-records-from-instance o)
433 (update-instance-from-records o)
434 (values (iso-timestring (testtime o))
435 (iso-timestring (testtimetz o)))
437 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000278-04:00"))
438 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000278-04:00")))
440 (deftest :time/historic-datetimes
441 (with-dataset *cross-platform-datetest*
442 (let ((time (parse-timestring "1800-09-09T14:37:29")))
443 (clsql-sys:insert-records :into [datetest]
444 :attributes '([testtime])
447 (first (clsql:select [testtime]
448 :from [datetest] :flatp t
449 :where [= [testtime] time] ))))
450 (format-time nil (parse-timestring testtime) :format :iso)
452 #.(format-time nil (parse-timestring "1800-09-09T14:37:29") :format :iso))