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 ;; relations of intervals
42 (let* ((time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
43 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
44 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
45 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
46 (interval-1 (clsql:make-interval :start time-1 :end time-2))
47 (interval-2 (clsql:make-interval :start time-2 :end time-3))
48 (interval-3 (clsql:make-interval :start time-3 :end time-4))
49 (interval-4 (clsql:make-interval :start time-1 :end time-3))
50 (interval-5 (clsql:make-interval :start time-2 :end time-4))
51 (interval-6 (clsql:make-interval :start time-1 :end time-4)))
52 (flet ((my-assert (number relation i1 i2)
53 (declare (ignore number))
54 (let ((found-relation (clsql:interval-relation i1 i2)))
55 (equal relation found-relation))))
57 (my-assert 1 :contains interval-1 interval-1)
58 (my-assert 2 :precedes interval-1 interval-2)
59 (my-assert 3 :precedes interval-1 interval-3)
60 (my-assert 4 :contained interval-1 interval-4)
61 (my-assert 5 :precedes interval-1 interval-5)
62 (my-assert 6 :contained interval-1 interval-6)
63 (my-assert 7 :follows interval-2 interval-1)
64 (my-assert 8 :contains interval-2 interval-2)
65 (my-assert 9 :precedes interval-2 interval-3)
66 (my-assert 10 :contained interval-2 interval-4)
67 (my-assert 11 :contained interval-2 interval-5)
68 (my-assert 12 :contained interval-2 interval-6)
69 (my-assert 13 :follows interval-3 interval-1)
70 (my-assert 14 :follows interval-3 interval-2)
71 (my-assert 15 :contains interval-3 interval-3)
72 (my-assert 16 :follows interval-3 interval-4)
73 (my-assert 17 :contained interval-3 interval-5)
74 (my-assert 18 :contained interval-3 interval-6)
75 (my-assert 19 :contains interval-4 interval-1)
76 (my-assert 20 :contains interval-4 interval-2)
77 (my-assert 21 :precedes interval-4 interval-3)
78 (my-assert 22 :contains interval-4 interval-4)
79 (my-assert 23 :overlaps interval-4 interval-5)
80 (my-assert 24 :contained interval-4 interval-6)
81 (my-assert 25 :follows interval-5 interval-1)
82 (my-assert 26 :contains interval-5 interval-2)
83 (my-assert 27 :contains interval-5 interval-3)
84 (my-assert 28 :overlaps interval-5 interval-4)
85 (my-assert 29 :contains interval-5 interval-5)
86 (my-assert 30 :contained interval-5 interval-6)
87 (my-assert 31 :contains interval-6 interval-1)
88 (my-assert 32 :contains interval-6 interval-2)
89 (my-assert 33 :contains interval-6 interval-3)
90 (my-assert 34 :contains interval-6 interval-4)
91 (my-assert 35 :contains interval-6 interval-5)
92 (my-assert 36 :contains interval-6 interval-6))))
95 ;; adjacent intervals in list
97 (let* ((interval-list nil)
98 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
99 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
100 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
102 (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3
105 (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4
107 (clsql:interval-relation (car interval-list) (cadr interval-list)))
110 ;; nested intervals in list
112 (let* ((interval-list nil)
113 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
114 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
115 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
116 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
118 (clsql:interval-push interval-list (clsql:make-interval :start time-1
122 (clsql:interval-push interval-list (clsql:make-interval :start time-2
125 (let* ((interval (car interval-list))
127 (when interval (car (clsql:interval-contained interval)))))
128 (when (and interval interval-contained)
129 (and (clsql:time= (clsql:interval-start interval) time-1)
130 (clsql:time= (clsql:interval-end interval) time-4)
131 (eq (clsql:interval-type interval) :open)
132 (clsql:time= (clsql:interval-start interval-contained) time-2)
133 (clsql:time= (clsql:interval-end interval-contained) time-3)
134 (eq (clsql:interval-type interval-contained) :closed)))))
137 ;; interval-edit - nonoverlapping
139 (let* ((interval-list nil)
140 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
141 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
142 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
143 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
144 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
145 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 :type :closed)))
146 (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-3))
147 ;; should be time-3 not time-2
148 (clsql:time= (clsql:interval-end (car interval-list)) time-3))
151 ;; interval-edit - overlapping
153 (let* ((interval-list nil)
154 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
155 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
156 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
157 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
158 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
159 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-4 :type :closed)))
164 (clsql:interval-edit interval-list time-1 time-1 time-3))
170 ;; interval-edit - nested intervals in list
172 (let* ((interval-list nil)
173 (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
174 (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
175 (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
176 (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
177 (time-5 (clsql:parse-timestring "2002-01-01 14:00:00"))
178 (time-6 (clsql:parse-timestring "2002-01-01 15:00:00")))
179 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-6 :type :open)))
180 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-3 :type :closed)))
181 (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-4 :end time-5 :type :closed)))
182 (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-4))
183 ;; should be time-4 not time-6
184 (clsql:time= (clsql:interval-end (car interval-list)) time-4))
187 ;; Test the boundaries of Local Time with granularity of 1 year
189 (let ((sec-in-year (* 60 60 24 365))
190 (year (clsql:time-element (clsql:make-time) :year)))
192 (let ((date (clsql:make-time :second (* n sec-in-year))))
193 (unless (= (+ year n)
194 (clsql:time-element date :year))
198 ;; Test db-timestring
200 (flet ((grab-year (dbstring)
201 (parse-integer (subseq dbstring 1 5))))
202 (let ((second-in-year (* 60 60 24 365)))
204 (let* ((second (* -1 n second-in-year))
205 (date (clsql:make-time :year 2525 :second second)))
207 (= (grab-year (clsql:db-timestring date))
208 (clsql:time-element date :year))
212 ;; Conversion between MJD and Gregorian
214 (dotimes (base 10000 base)
215 (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base))
220 ;; Clsql:Roll by minutes: +90
222 (let ((now (clsql:get-time)))
223 (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90))
224 (clsql:roll now :minute 90)))
227 ;;Clsql:Roll by minutes: +900
229 (let ((now (clsql:get-time)))
230 (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900))
231 (clsql:roll now :minute 900)))
235 ;; Clsql:Roll by minutes: +900
237 (let* ((now (clsql:get-time))
238 (add-time (clsql:time+ now (clsql:make-duration :minute 9000)))
239 (roll-time (clsql:roll now :minute 9000)))
240 (clsql:time= add-time roll-time))
244 (deftest :time/14-usec
245 ;;make sure when we print and parse we get the same time.
246 (let* ((time (clsql-sys:make-time :year 2010 :month 1 :day 4
247 :hour 14 :minute 15 :second 44 :usec 3))
248 (string-time (clsql-sys:format-time nil time :format :iso))
249 (time2 (clsql-sys:parse-timestring string-time)))
250 (format-time nil time2 :format :iso))
251 #.(format-time nil (clsql-sys:make-time :year 2010 :month 1 :day 4
252 :hour 14 :minute 15 :second 44 :usec 3)
256 ;;; The cross platform dataset uses the 'timestamp' column type which is
257 ;;; in sql-92, for all that means.
259 (deftest :time/cross-platform/no-usec/no-tz
260 (with-dataset *cross-platform-datetest*
261 (let ((time (parse-timestring "2008-09-09T14:37:29")))
262 (clsql-sys:insert-records :into [datetest]
263 :attributes '([testtime])
266 (first (clsql:select [testtime]
267 :from [datetest] :flatp T
268 :where [= [testtime] time] ))))
269 (format-time nil (parse-timestring testtime) :format :iso)
271 #.(format-time nil (parse-timestring "2008-09-09T14:37:29") :format :iso))
273 (deftest :time/cross-platform/no-usec/tz
274 (with-dataset *cross-platform-datetest*
275 (let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
276 (clsql-sys:insert-records :into [datetest]
277 :attributes '([testtime])
280 (first (clsql:select [testtime]
281 :from [datetest] :flatp T
282 :where [= [testtime] time] ))))
283 (format-time nil (parse-timestring testtime) :format :iso)
285 #.(format-time nil (parse-timestring "2008-09-09T14:37:29-04:00") :format :iso))
287 (deftest :time/cross-platform/usec/no-tz
288 (with-dataset *cross-platform-datetest*
289 (let ((time (parse-timestring "2008-09-09T14:37:29.000213")))
290 (clsql-sys:insert-records :into [datetest]
291 :attributes '([testtime])
294 (first (clsql:select [testtime]
295 :from [datetest] :flatp T
296 :where [= [testtime] time] ))))
297 (format-time nil (parse-timestring testtime) :format :iso)
299 #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213") :format :iso))
301 (deftest :time/cross-platform/usec/tz
302 (with-dataset *cross-platform-datetest*
303 (let ((time (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
304 (clsql-sys:insert-records :into [datetest]
305 :attributes '([testtime])
308 (first (clsql:select [testtime]
311 :where [= [testtime] time] ))))
312 (format-time nil (parse-timestring testtime) :format :iso)
314 #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213-04:00") :format :iso))
319 ;;; All odbc databases use local times exclusively (they do not send timezone info)
320 ;;; Postgresql can use timezones, except when being used over odbc. This test when
321 ;;; run through both postgres socket and postgres odbc should test a fairly
322 ;;; broad swath of available problem space
324 ;;; Things the following tests try to prove correct
325 ;;; * Reading and writing usec and usec-less times
326 ;;; * reading and writing timezones (Z=utc) when appropriate (eg: postgresql-socket)
327 ;;; * reading and writing localtimes when appropriate (eg: ODBC)
328 ;;; * reading and writing through both the oodml and fdml layers
332 (deftest :time/pg/fdml/usec
333 (with-dataset *ds-datetest*
334 (let ((time (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
335 (clsql-sys:insert-records :into [datetest]
336 :attributes '([testtimetz] [testtime])
337 :values (list time time))
338 (destructuring-bind (testtimetz testtime)
339 (first (clsql:select [testtimetz] [testtime]
342 :where [= [testtime] time] ))
343 (assert (time= (parse-timestring testtimetz) time) (testtimetz time)
344 "Timetz of db: ~s should be time:~s" testtimetz time)
345 (assert (time= (parse-timestring testtime) time) (testtime time)
346 "Time of db: ~s should be time:~s" testtime time))))
349 (deftest :time/pg/oodml/no-usec
350 (with-dataset *ds-datetest*
351 (let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
352 (clsql-sys:update-records-from-instance
353 (make-instance 'datetest :testtimetz time :testtime time))
354 (let ((o (first (clsql:select
357 :where [= [testtime] time] ))))
358 (assert o (o) "o shouldnt be null here (we should have just inserted)")
359 (update-records-from-instance o)
360 (update-instance-from-records o)
361 (assert (time= (testtime o) time) (time o)
362 "Time of o: ~s should be time:~s" (testtime o) time)
363 (assert (time= (testtimetz o) time) (time o)
364 "Timetz of o: ~s should be time:~s" (testtime o) time))))
367 (deftest :time/pg/oodml/usec
368 (with-dataset *ds-datetest*
369 (let ((time (parse-timestring "2008-09-09T14:37:29.000278-04:00")))
370 (clsql-sys:update-records-from-instance
371 (make-instance 'datetest :testtimetz time :testtime time))
372 (let ((o (first (clsql:select
375 :where [= [testtime] time] ))))
376 (assert o (o) "o shouldnt be null here (we should have just inserted)")
377 (update-records-from-instance o)
378 (update-instance-from-records o)
379 (assert (time= (testtime o) time) (time o)
380 "Time of o: ~s should be time:~s" (testtime o) time)
381 (assert (time= (testtimetz o) time) (time o)
382 "Timetz of o: ~s should be time:~s" (testtime o) time)
389 #.(clsql-sys:locally-disable-sql-reader-syntax)