Fix some case issues for case-sensitive, modern-mode Allegro
[clsql.git] / tests / test-time.lisp
1 ;;; -*- Mode: Lisp -*-
2 ;;;
3 ;;; Copyright (c) 2000, 2001 onShore Development, Inc.
4 ;;;
5 ;;; Test time functions (time.lisp)
6
7 (in-package #:clsql-tests)
8 #.(clsql-sys:locally-enable-sql-reader-syntax)
9
10 (def-view-class datetest ()
11   ((testtimetz :column "testtimetz"
12                 :type clsql-sys:wall-time
13                 :db-kind :base
14                 :db-constraints nil
15                 :accessor testtimetz :initarg :testtimetz
16                 :initform nil
17                 :db-type "timestamp with time zone")
18    (testtime :column "testtime"
19              :type clsql-sys:wall-time
20              :db-kind :base
21              :db-constraints nil
22              :accessor testtime :initarg :testtime
23              :initform nil
24              :db-type "timestamp without time zone")))
25
26 (def-dataset *ds-datetest*
27   (:setup (lambda () (clsql-sys:create-view-from-class 'datetest)))
28   (:cleanup "DROP TABLE datetest"))
29
30
31 (def-dataset *cross-platform-datetest*
32   (:setup (lambda () (create-table [datetest]
33                                    '(([testtime] wall-time)))))
34   (:cleanup (lambda ()
35               (drop-table [datetest]))))
36
37
38 (setq *rt-time*
39       '(
40
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")))
45       (decode-time time1))
46   0 0 0 0 23 1 2010 6)
47
48 (deftest :time/iso-parse/1
49     (let* ((time1 (parse-timestring "2010-01-23T14:56:32Z")))
50       (decode-time time1))
51   0 32 56 14 23 1 2010 6)
52
53 (deftest :time/iso-parse/2
54     (let* ((time1 (parse-timestring "2008-02-29 12:46:32")))
55       (decode-time time1))
56   0 32 46 12 29 2 2008 5)
57
58 (deftest :time/iso-parse/3
59     (let* ((time1 (parse-timestring "2010-01-23 14:56:32.44")))
60       (decode-time time1))
61   440000 32 56 14 23 1 2010 6)
62
63 (deftest :time/iso-parse/4
64     (let* ((time1 (parse-timestring "2010-01-23 14:56:32.0044")))
65       (decode-time time1))
66   4400 32 56 14 23 1 2010 6)
67
68 (deftest :time/iso-parse/5
69     (let* ((time1 (parse-timestring "2010-01-23 14:56:32.000003")))
70       (decode-time time1))
71   3 32 56 14 23 1 2010 6)
72
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)))
79       (decode-time time2))
80   0 44 15 14 4 1 2010 1)
81
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)))
88       (decode-time time2))
89   3 44 15 14 4 1 2010 1)
90
91
92 ;; relations of intervals
93 (deftest :time/1
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))))
108         (and
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))))
145   t)
146
147 ;; adjacent intervals in list
148 (deftest :time/2
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")))
153     (setf interval-list
154           (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3
155                                                       :type :open)))
156     (setf interval-list
157           (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4
158                                                       :type :open)))
159     (clsql:interval-relation (car interval-list) (cadr interval-list)))
160   :precedes)
161
162 ;; nested intervals in list
163 (deftest :time/3
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")))
169       (setf interval-list
170             (clsql:interval-push interval-list (clsql:make-interval :start time-1
171                                                         :end time-4
172                                                         :type :open)))
173       (setf interval-list
174             (clsql:interval-push interval-list (clsql:make-interval :start time-2
175                                                         :end time-3
176                                                         :type :closed)))
177       (let* ((interval (car interval-list))
178              (interval-contained
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)))))
187   t)
188
189 ;; interval-edit - nonoverlapping
190 (deftest :time/4
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))
201   t)
202
203 ;; interval-edit - overlapping
204 (deftest :time/5
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)))
212       (let ((pass t))
213         (handler-case
214             (progn
215               (setf interval-list
216                     (clsql:interval-edit interval-list time-1 time-1 time-3))
217               (setf pass nil))
218           (error nil))
219         pass))
220   t)
221
222 ;; interval-edit - nested intervals in list
223 (deftest :time/6
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))
237   t)
238
239 ;; Test the boundaries of Local Time with granularity of 1 year
240 (deftest :time/7
241     (let ((sec-in-year (* 60 60 24 365))
242           (year (clsql:time-element (clsql:make-time) :year)))
243       (dotimes (n 50 n)
244         (let ((date (clsql:make-time :second (* n sec-in-year))))
245           (unless (= (+ year n)
246                      (clsql:time-element date :year))
247             (return n)))))
248   50)
249
250 ;; Test db-timestring
251 (deftest :time/9
252     (flet ((grab-year (dbstring)
253              (parse-integer (subseq dbstring 1 5))))
254       (let ((second-in-year (* 60 60 24 365)))
255         (dotimes (n 2000 n)
256           (let* ((second (* -1 n second-in-year))
257                  (date (clsql:make-time :year 2525 :second second)))
258             (unless
259                 (= (grab-year (clsql:db-timestring date))
260                    (clsql:time-element date :year))
261               (return n))))))
262   2000)
263
264 ;; Conversion between MJD and Gregorian
265 (deftest :time/10
266     (dotimes (base 10000 base)
267       (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base))
268                  base)
269         (return base)))
270   10000)
271
272 ;; Clsql:Roll by minutes: +90
273 (deftest :time/11
274     (let ((now (clsql:get-time)))
275       (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90))
276              (clsql:roll now :minute 90)))
277   t)
278
279 ;;Clsql:Roll by minutes: +900
280 (deftest :time/12
281     (let ((now (clsql:get-time)))
282       (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900))
283              (clsql:roll now :minute 900)))
284   t)
285
286
287 ;; Clsql:Roll by minutes: +900
288 (deftest :time/13
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))
293   t)
294
295
296
297 ;;; The cross platform dataset uses the 'timestamp' column type which is
298 ;;; in sql-92, for all that means.
299
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])
305                                   :values (list time))
306         (let ((testtime
307                (first (clsql:select [testtime]
308                                     :from [datetest] :flatp t
309                                     :where [= [testtime] time] ))))
310           (format-time nil (parse-timestring testtime) :format :iso)
311           )))
312   #.(format-time nil (parse-timestring "2008-09-09T14:37:29") :format :iso))
313
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])
319                                   :values (list time))
320         (let ((testtime
321                (first (clsql:select [testtime]
322                                     :from [datetest] :flatp t
323                                     :where [= [testtime] time] ))))
324           (format-time nil (parse-timestring testtime) :format :iso)
325           )))
326   #.(format-time nil (parse-timestring "2008-09-09T14:37:29-04:00") :format :iso))
327
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])
335                                   :values (list time))
336         (let ((testtime
337                (first (clsql:select [testtime]
338                                     :from [datetest] :flatp t
339                                     :where [= [testtime] time] ))))
340           (format-time nil (parse-timestring testtime) :format :iso)
341           )))
342   #.(format-time nil (parse-timestring "2008-09-09T14:37:29.423") :format :iso))
343
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])
349                                   :values (list time))
350         (let ((testtime
351                (first (clsql:select [testtime]
352                                     :from [datetest] :flatp t
353                                     :where [= [testtime] time] ))))
354           (format-time nil (parse-timestring testtime) :format :iso)
355           )))
356   #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213") :format :iso))
357
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])
363                                   :values (list time))
364         (let ((testtime
365                (first (clsql:select [testtime]
366                                     :from [datetest]
367                                     :limit 1 :flatp t
368                                     :where [= [testtime] time] ))))
369           (format-time nil (parse-timestring testtime) :format :iso)
370           )))
371   #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213-04:00") :format :iso))
372
373
374
375
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
380 ;;;
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
386
387
388
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]
397                                :from [datetest]
398                                :limit 1 :flatp t
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")))
404
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
411                           'datetest
412                         :limit 1 :flatp t
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")))
421
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
428                          'datetest
429                          :limit 1 :flatp t
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)))
436           )))
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")))
439
440 ))
441
442
443 #.(clsql-sys:locally-disable-sql-reader-syntax)