4 ;;; Copyright (c) 2000, 2001 onShore Development, Inc.
6 ;;; Test time functions (time.lisp)
8 (in-package #:clsql-tests)
9 #.(clsql-sys:locally-enable-sql-reader-syntax)
11 (def-view-class datetest ()
12 ((testtimetz :COLUMN "testtimetz" :TYPE
13 clsql-sys:wall-time :DB-KIND :BASE
14 :DB-CONSTRAINTS COMMON-LISP:NIL
15 :ACCESSOR testtimetz :INITARG
16 :testtimetz :INITFORM COMMON-LISP:NIL
17 :DB-TYPE "timestamp with time zone")
18 (testtime :COLUMN "testtime" :TYPE
19 clsql-sys:wall-time :DB-KIND :BASE
20 :DB-CONSTRAINTS COMMON-LISP:NIL
21 :ACCESSOR testtime :INITARG
22 :testtime :INITFORM COMMON-LISP:NIL
23 :DB-TYPE "timestamp without time zone")))
25 (def-dataset *ds-datetest*
26 (:setup (lambda () (clsql-sys:create-view-from-class 'datetest)))
27 (:cleanup "DROP TABLE datetest"))
30 (def-dataset *cross-platform-datetest*
31 (:setup (lambda () (create-table [datetest]
32 '(([testtime] wall-time)))))
34 (drop-table [datetest]))))
40 ;; we use parse timestring a lot through here verifying other things
41 ;; start off just checking that.
42 (deftest :time/iso-parse/0
43 (let* ((time1 (parse-timestring "2010-01-23")))
47 (deftest :time/iso-parse/1
48 (let* ((time1 (parse-timestring "2010-01-23T14:56:32Z")))
50 0 32 56 14 23 1 2010 6)
52 (deftest :time/iso-parse/2
53 (let* ((time1 (parse-timestring "2008-02-29 12:46:32")))
55 0 32 46 12 29 2 2008 5)
57 (deftest :time/iso-parse/3
58 (let* ((time1 (parse-timestring "2010-01-23 14:56:32.44")))
60 440000 32 56 14 23 1 2010 6)
62 (deftest :time/iso-parse/4
63 (let* ((time1 (parse-timestring "2010-01-23 14:56:32.0044")))
65 4400 32 56 14 23 1 2010 6)
67 (deftest :time/iso-parse/5
68 (let* ((time1 (parse-timestring "2010-01-23 14:56:32.000003")))
70 3 32 56 14 23 1 2010 6)
72 ;; relations of intervals
74 (let* ((time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
75 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
76 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
77 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
78 (interval-1 (clsql:make-interval :start time-1 :end time-2))
79 (interval-2 (clsql:make-interval :start time-2 :end time-3))
80 (interval-3 (clsql:make-interval :start time-3 :end time-4))
81 (interval-4 (clsql:make-interval :start time-1 :end time-3))
82 (interval-5 (clsql:make-interval :start time-2 :end time-4))
83 (interval-6 (clsql:make-interval :start time-1 :end time-4)))
84 (flet ((my-assert (number relation i1 i2)
85 (declare (ignore number))
86 (let ((found-relation (clsql:interval-relation i1 i2)))
87 (equal relation found-relation))))
89 (my-assert 1 :contains interval-1 interval-1)
90 (my-assert 2 :precedes interval-1 interval-2)
91 (my-assert 3 :precedes interval-1 interval-3)
92 (my-assert 4 :contained interval-1 interval-4)
93 (my-assert 5 :precedes interval-1 interval-5)
94 (my-assert 6 :contained interval-1 interval-6)
95 (my-assert 7 :follows interval-2 interval-1)
96 (my-assert 8 :contains interval-2 interval-2)
97 (my-assert 9 :precedes interval-2 interval-3)
98 (my-assert 10 :contained interval-2 interval-4)
99 (my-assert 11 :contained interval-2 interval-5)
100 (my-assert 12 :contained interval-2 interval-6)
101 (my-assert 13 :follows interval-3 interval-1)
102 (my-assert 14 :follows interval-3 interval-2)
103 (my-assert 15 :contains interval-3 interval-3)
104 (my-assert 16 :follows interval-3 interval-4)
105 (my-assert 17 :contained interval-3 interval-5)
106 (my-assert 18 :contained interval-3 interval-6)
107 (my-assert 19 :contains interval-4 interval-1)
108 (my-assert 20 :contains interval-4 interval-2)
109 (my-assert 21 :precedes interval-4 interval-3)
110 (my-assert 22 :contains interval-4 interval-4)
111 (my-assert 23 :overlaps interval-4 interval-5)
112 (my-assert 24 :contained interval-4 interval-6)
113 (my-assert 25 :follows interval-5 interval-1)
114 (my-assert 26 :contains interval-5 interval-2)
115 (my-assert 27 :contains interval-5 interval-3)
116 (my-assert 28 :overlaps interval-5 interval-4)
117 (my-assert 29 :contains interval-5 interval-5)
118 (my-assert 30 :contained interval-5 interval-6)
119 (my-assert 31 :contains interval-6 interval-1)
120 (my-assert 32 :contains interval-6 interval-2)
121 (my-assert 33 :contains interval-6 interval-3)
122 (my-assert 34 :contains interval-6 interval-4)
123 (my-assert 35 :contains interval-6 interval-5)
124 (my-assert 36 :contains interval-6 interval-6))))
127 ;; adjacent intervals in list
129 (let* ((interval-list nil)
130 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
131 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
132 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
134 (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3
137 (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4
139 (clsql:interval-relation (car interval-list) (cadr interval-list)))
142 ;; nested intervals in list
144 (let* ((interval-list nil)
145 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
146 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
147 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
148 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
150 (clsql:interval-push interval-list (clsql:make-interval :start time-1
154 (clsql:interval-push interval-list (clsql:make-interval :start time-2
157 (let* ((interval (car interval-list))
159 (when interval (car (clsql:interval-contained interval)))))
160 (when (and interval interval-contained)
161 (and (clsql:time= (clsql:interval-start interval) time-1)
162 (clsql:time= (clsql:interval-end interval) time-4)
163 (eq (clsql:interval-type interval) :open)
164 (clsql:time= (clsql:interval-start interval-contained) time-2)
165 (clsql:time= (clsql:interval-end interval-contained) time-3)
166 (eq (clsql:interval-type interval-contained) :closed)))))
169 ;; interval-edit - nonoverlapping
171 (let* ((interval-list nil)
172 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
173 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
174 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
175 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
176 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
177 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 :type :closed)))
178 (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-3))
179 ;; should be time-3 not time-2
180 (clsql:time= (clsql:interval-end (car interval-list)) time-3))
183 ;; interval-edit - overlapping
185 (let* ((interval-list nil)
186 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
187 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
188 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
189 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
190 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
191 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-4 :type :closed)))
196 (clsql:interval-edit interval-list time-1 time-1 time-3))
202 ;; interval-edit - nested intervals in list
204 (let* ((interval-list nil)
205 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
206 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
207 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
208 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
209 (time-5 (clsql:parse-timestring "2002-01-01 14:00:00"))
210 (time-6 (clsql:parse-timestring "2002-01-01 15:00:00")))
211 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-6 :type :open)))
212 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-3 :type :closed)))
213 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-4 :end time-5 :type :closed)))
214 (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-4))
215 ;; should be time-4 not time-6
216 (clsql:time= (clsql:interval-end (car interval-list)) time-4))
219 ;; Test the boundaries of Local Time with granularity of 1 year
221 (let ((sec-in-year (* 60 60 24 365))
222 (year (clsql:time-element (clsql:make-time) :year)))
224 (let ((date (clsql:make-time :second (* n sec-in-year))))
225 (unless (= (+ year n)
226 (clsql:time-element date :year))
230 ;; Test db-timestring
232 (flet ((grab-year (dbstring)
233 (parse-integer (subseq dbstring 1 5))))
234 (let ((second-in-year (* 60 60 24 365)))
236 (let* ((second (* -1 n second-in-year))
237 (date (clsql:make-time :year 2525 :second second)))
239 (= (grab-year (clsql:db-timestring date))
240 (clsql:time-element date :year))
244 ;; Conversion between MJD and Gregorian
246 (dotimes (base 10000 base)
247 (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base))
252 ;; Clsql:Roll by minutes: +90
254 (let ((now (clsql:get-time)))
255 (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90))
256 (clsql:roll now :minute 90)))
259 ;;Clsql:Roll by minutes: +900
261 (let ((now (clsql:get-time)))
262 (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900))
263 (clsql:roll now :minute 900)))
267 ;; Clsql:Roll by minutes: +900
269 (let* ((now (clsql:get-time))
270 (add-time (clsql:time+ now (clsql:make-duration :minute 9000)))
271 (roll-time (clsql:roll now :minute 9000)))
272 (clsql:time= add-time roll-time))
276 (deftest :time/14-usec
277 ;;make sure when we print and parse we get the same time.
278 (let* ((time (clsql-sys:make-time :year 2010 :month 1 :day 4
279 :hour 14 :minute 15 :second 44 :usec 3))
280 (string-time (clsql-sys:format-time nil time :format :iso))
281 (time2 (clsql-sys:parse-timestring string-time)))
282 (format-time nil time2 :format :iso))
283 #.(format-time nil (clsql-sys:make-time :year 2010 :month 1 :day 4
284 :hour 14 :minute 15 :second 44 :usec 3)
288 ;;; The cross platform dataset uses the 'timestamp' column type which is
289 ;;; in sql-92, for all that means.
291 (deftest :time/cross-platform/no-usec/no-tz
292 (with-dataset *cross-platform-datetest*
293 (let ((time (parse-timestring "2008-09-09T14:37:29")))
294 (clsql-sys:insert-records :into [datetest]
295 :attributes '([testtime])
298 (first (clsql:select [testtime]
299 :from [datetest] :flatp T
300 :where [= [testtime] time] ))))
301 (format-time nil (parse-timestring testtime) :format :iso)
303 #.(format-time nil (parse-timestring "2008-09-09T14:37:29") :format :iso))
305 (deftest :time/cross-platform/no-usec/tz
306 (with-dataset *cross-platform-datetest*
307 (let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
308 (clsql-sys:insert-records :into [datetest]
309 :attributes '([testtime])
312 (first (clsql:select [testtime]
313 :from [datetest] :flatp T
314 :where [= [testtime] time] ))))
315 (format-time nil (parse-timestring testtime) :format :iso)
317 #.(format-time nil (parse-timestring "2008-09-09T14:37:29-04:00") :format :iso))
319 (deftest :time/cross-platform/usec/no-tz
320 (with-dataset *cross-platform-datetest*
321 (let ((time (parse-timestring "2008-09-09T14:37:29.000213")))
322 (clsql-sys:insert-records :into [datetest]
323 :attributes '([testtime])
326 (first (clsql:select [testtime]
327 :from [datetest] :flatp T
328 :where [= [testtime] time] ))))
329 (format-time nil (parse-timestring testtime) :format :iso)
331 #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213") :format :iso))
333 (deftest :time/cross-platform/usec/tz
334 (with-dataset *cross-platform-datetest*
335 (let ((time (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
336 (clsql-sys:insert-records :into [datetest]
337 :attributes '([testtime])
340 (first (clsql:select [testtime]
343 :where [= [testtime] time] ))))
344 (format-time nil (parse-timestring testtime) :format :iso)
346 #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213-04:00") :format :iso))
351 ;;; All odbc databases use local times exclusively (they do not send timezone info)
352 ;;; Postgresql can use timezones, except when being used over odbc. This test when
353 ;;; run through both postgres socket and postgres odbc should test a fairly
354 ;;; broad swath of available problem space
356 ;;; Things the following tests try to prove correct
357 ;;; * Reading and writing usec and usec-less times
358 ;;; * reading and writing timezones (Z=utc) when appropriate (eg: postgresql-socket)
359 ;;; * reading and writing localtimes when appropriate (eg: ODBC)
360 ;;; * reading and writing through both the oodml and fdml layers
364 (deftest :time/pg/fdml/usec
365 (with-dataset *ds-datetest*
366 (let ((time (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
367 (clsql-sys:insert-records :into [datetest]
368 :attributes '([testtimetz] [testtime])
369 :values (list time time))
370 (destructuring-bind (testtimetz testtime)
371 (first (clsql:select [testtimetz] [testtime]
374 :where [= [testtime] time] ))
375 (values (iso-timestring (parse-timestring testtime))
376 (iso-timestring (parse-timestring testtimetz))))))
377 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000213-04:00"))
378 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
380 (deftest :time/pg/oodml/no-usec
381 (with-dataset *ds-datetest*
382 (let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
383 (clsql-sys:update-records-from-instance
384 (make-instance 'datetest :testtimetz time :testtime time))
385 (let ((o (first (clsql:select
388 :where [= [testtime] time] ))))
389 (assert o (o) "o shouldnt be null here (we should have just inserted)")
390 (update-records-from-instance o)
391 (update-instance-from-records o)
392 (values (iso-timestring (testtime o))
393 (iso-timestring (testtimetz o))))))
394 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29-04:00"))
395 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29-04:00")))
397 (deftest :time/pg/oodml/usec
398 (with-dataset *ds-datetest*
399 (let ((time (parse-timestring "2008-09-09T14:37:29.000278-04:00")))
400 (clsql-sys:update-records-from-instance
401 (make-instance 'datetest :testtimetz time :testtime time))
402 (let ((o (first (clsql:select
405 :where [= [testtime] time] ))))
406 (assert o (o) "o shouldnt be null here (we should have just inserted)")
407 (update-records-from-instance o)
408 (update-instance-from-records o)
409 (values (iso-timestring (testtime o))
410 (iso-timestring (testtimetz o)))
412 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000278-04:00"))
413 #.(iso-timestring (parse-timestring "2008-09-09T14:37:29.000278-04:00")))
418 #.(clsql-sys:locally-disable-sql-reader-syntax)