tests/test-time.lisp

   1 ;;; -*- Mode: Lisp -*-
   2 ;;; $Id$
   3 ;;;
   4 ;;; Copyright (c) 2000, 2001 onShore Development, Inc.
   5 ;;;
   6 ;;; Test time functions (time.lisp)
   7
   8 (in-package #:clsql-tests)
   9 #.(clsql-sys:locally-enable-sql-reader-syntax)
  10
  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")))
  24
  25 (def-dataset *ds-datetest*
  26   (:setup (lambda () (clsql-sys:create-view-from-class 'datetest)))
  27   (:cleanup "DROP TABLE datetest"))
  28
  29
  30 (def-dataset *cross-platform-datetest*
  31   (:setup (lambda () (create-table [datetest]
  32                                    '(([testtime] wall-time)))))
  33   (:cleanup (lambda ()
  34               (drop-table [datetest]))))
  35
  36
  37 (setq *rt-time*
  38       '(
  39
  40 ;; relations of intervals
  41 (deftest :time/1
  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))))
  56         (and
  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))))
  93   t)
  94
  95 ;; adjacent intervals in list
  96 (deftest :time/2
  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")))
 101     (setf interval-list
 102           (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3
 103                                                       :type :open)))
 104     (setf interval-list
 105           (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4
 106                                                       :type :open)))
 107     (clsql:interval-relation (car interval-list) (cadr interval-list)))
 108   :precedes)
 109
 110 ;; nested intervals in list
 111 (deftest :time/3
 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")))
 117       (setf interval-list
 118             (clsql:interval-push interval-list (clsql:make-interval :start time-1
 119                                                         :end time-4
 120                                                         :type :open)))
 121       (setf interval-list
 122             (clsql:interval-push interval-list (clsql:make-interval :start time-2
 123                                                         :end time-3
 124                                                         :type :closed)))
 125       (let* ((interval (car interval-list))
 126              (interval-contained
 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)))))
 135   t)
 136
 137 ;; interval-edit - nonoverlapping
 138 (deftest :time/4
 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))
 149   t)
 150
 151 ;; interval-edit - overlapping
 152 (deftest :time/5
 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)))
 160       (let ((pass t))
 161         (handler-case
 162             (progn
 163               (setf interval-list
 164                     (clsql:interval-edit interval-list time-1 time-1 time-3))
 165               (setf pass nil))
 166           (error nil))
 167         pass))
 168   t)
 169
 170 ;; interval-edit - nested intervals in list
 171 (deftest :time/6
 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))
 185   t)
 186
 187 ;; Test the boundaries of Local Time with granularity of 1 year
 188 (deftest :time/7
 189     (let ((sec-in-year (* 60 60 24 365))
 190           (year (clsql:time-element (clsql:make-time) :year)))
 191       (dotimes (n 50 n)
 192         (let ((date (clsql:make-time :second (* n sec-in-year))))
 193           (unless (= (+ year n)
 194                      (clsql:time-element date :year))
 195             (return n)))))
 196   50)
 197
 198 ;; Test db-timestring
 199 (deftest :time/9
 200     (flet ((grab-year (dbstring)
 201              (parse-integer (subseq dbstring 1 5))))
 202       (let ((second-in-year (* 60 60 24 365)))
 203         (dotimes (n 2000 n)
 204           (let* ((second (* -1 n second-in-year))
 205                  (date (clsql:make-time :year 2525 :second second)))
 206             (unless
 207                 (= (grab-year (clsql:db-timestring date))
 208                    (clsql:time-element date :year))
 209               (return n))))))
 210   2000)
 211
 212 ;; Conversion between MJD and Gregorian
 213 (deftest :time/10
 214     (dotimes (base 10000 base)
 215       (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base))
 216                  base)
 217         (return base)))
 218   10000)
 219
 220 ;; Clsql:Roll by minutes: +90
 221 (deftest :time/11
 222     (let ((now (clsql:get-time)))
 223       (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90))
 224              (clsql:roll now :minute 90)))
 225   t)
 226
 227 ;;Clsql:Roll by minutes: +900
 228 (deftest :time/12
 229     (let ((now (clsql:get-time)))
 230       (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900))
 231              (clsql:roll now :minute 900)))
 232   t)
 233
 234
 235 ;; Clsql:Roll by minutes: +900
 236 (deftest :time/13
 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))
 241   t)
 242
 243
 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)
 253      :format :iso))
 254
 255
 256 ;;; The cross platform dataset uses the 'timestamp' column type which is
 257 ;;; in sql-92, for all that means.
 258
 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])
 264                                   :values (list time))
 265         (let ((testtime
 266                (first (clsql:select [testtime]
 267                                     :from [datetest] :flatp T
 268                                     :where [= [testtime] time] ))))
 269           (format-time nil (parse-timestring testtime) :format :iso)
 270           )))
 271   #.(format-time nil (parse-timestring "2008-09-09T14:37:29") :format :iso))
 272
 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])
 278                                   :values (list time))
 279         (let ((testtime
 280                (first (clsql:select [testtime]
 281                                     :from [datetest] :flatp T
 282                                     :where [= [testtime] time] ))))
 283           (format-time nil (parse-timestring testtime) :format :iso)
 284           )))
 285   #.(format-time nil (parse-timestring "2008-09-09T14:37:29-04:00") :format :iso))
 286
 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])
 292                                   :values (list time))
 293         (let ((testtime
 294                (first (clsql:select [testtime]
 295                                     :from [datetest] :flatp T
 296                                     :where [= [testtime] time] ))))
 297           (format-time nil (parse-timestring testtime) :format :iso)
 298           )))
 299   #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213") :format :iso))
 300
 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])
 306                                   :values (list time))
 307         (let ((testtime
 308                (first (clsql:select [testtime]
 309                                     :from [datetest]
 310                                     :limit 1 :flatp T
 311                                     :where [= [testtime] time] ))))
 312           (format-time nil (parse-timestring testtime) :format :iso)
 313           )))
 314   #.(format-time nil (parse-timestring "2008-09-09T14:37:29.000213-04:00") :format :iso))
 315
 316
 317
 318
 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
 323 ;;;
 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
 329
 330
 331
 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]
 340                                  :from [datetest]
 341                                  :limit 1 :flatp T
 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))))
 347   nil)
 348
 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
 355                          'datetest
 356                          :limit 1 :flatp T
 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))))
 365   nil)
 366
 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
 373                          'datetest
 374                          :limit 1 :flatp T
 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)
 383           )))
 384   nil)
 385
 386 ))
 387
 388
 389 #.(clsql-sys:locally-disable-sql-reader-syntax)