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-dataset *ds-datetest*
  12   (:setup (lambda () (clsql-sys:create-view-from-class 'datetest)))
  13   (:cleanup "DROP TABLE datetest"))
  14
  15 (def-dataset *cross-platform-datetest*
  16   (:setup "CREATE TABLE DATETEST (TESTTIME TIMESTAMP)")
  17   (:cleanup "DROP TABLE DATETEST"))
  18
  19 (def-view-class datetest ()
  20   ((testtimetz :COLUMN "testtimetz" :TYPE
  21                clsql-sys:wall-time :DB-KIND :BASE
  22                :DB-CONSTRAINTS COMMON-LISP:NIL
  23                :ACCESSOR testtimetz :INITARG
  24                :testtimetz :INITFORM COMMON-LISP:NIL
  25                :DB-TYPE "timestamptz")
  26    (testtime :COLUMN "testtime" :TYPE
  27              clsql-sys:wall-time :DB-KIND :BASE
  28              :DB-CONSTRAINTS COMMON-LISP:NIL
  29              :ACCESSOR testtime :INITARG
  30              :testtime :INITFORM COMMON-LISP:NIL
  31              :DB-TYPE "timestamp")))
  32
  33 (setq *rt-time*
  34       '(
  35
  36 ;; relations of intervals
  37 (deftest :time/1
  38     (let* ((time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
  39            (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
  40            (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
  41            (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
  42            (interval-1 (clsql:make-interval :start time-1 :end time-2))
  43            (interval-2 (clsql:make-interval :start time-2 :end time-3))
  44            (interval-3 (clsql:make-interval :start time-3 :end time-4))
  45            (interval-4 (clsql:make-interval :start time-1 :end time-3))
  46            (interval-5 (clsql:make-interval :start time-2 :end time-4))
  47            (interval-6 (clsql:make-interval :start time-1 :end time-4)))
  48       (flet ((my-assert (number relation i1 i2)
  49                (declare (ignore number))
  50                (let ((found-relation (clsql:interval-relation i1 i2)))
  51                  (equal relation found-relation))))
  52         (and
  53          (my-assert 1 :contains interval-1 interval-1)
  54          (my-assert 2 :precedes interval-1 interval-2)
  55          (my-assert 3 :precedes interval-1 interval-3)
  56          (my-assert 4 :contained interval-1 interval-4)
  57          (my-assert 5 :precedes interval-1 interval-5)
  58          (my-assert 6 :contained interval-1 interval-6)
  59          (my-assert 7 :follows interval-2 interval-1)
  60          (my-assert 8 :contains interval-2 interval-2)
  61          (my-assert 9 :precedes interval-2 interval-3)
  62          (my-assert 10 :contained interval-2 interval-4)
  63          (my-assert 11 :contained interval-2 interval-5)
  64          (my-assert 12 :contained interval-2 interval-6)
  65          (my-assert 13 :follows interval-3 interval-1)
  66          (my-assert 14 :follows interval-3 interval-2)
  67          (my-assert 15 :contains interval-3 interval-3)
  68          (my-assert 16 :follows interval-3 interval-4)
  69          (my-assert 17 :contained interval-3 interval-5)
  70          (my-assert 18 :contained interval-3 interval-6)
  71          (my-assert 19 :contains interval-4 interval-1)
  72          (my-assert 20 :contains interval-4 interval-2)
  73          (my-assert 21 :precedes interval-4 interval-3)
  74          (my-assert 22 :contains interval-4 interval-4)
  75          (my-assert 23 :overlaps interval-4 interval-5)
  76          (my-assert 24 :contained interval-4 interval-6)
  77          (my-assert 25 :follows interval-5 interval-1)
  78          (my-assert 26 :contains interval-5 interval-2)
  79          (my-assert 27 :contains interval-5 interval-3)
  80          (my-assert 28 :overlaps interval-5 interval-4)
  81          (my-assert 29 :contains interval-5 interval-5)
  82          (my-assert 30 :contained interval-5 interval-6)
  83          (my-assert 31 :contains interval-6 interval-1)
  84          (my-assert 32 :contains interval-6 interval-2)
  85          (my-assert 33 :contains interval-6 interval-3)
  86          (my-assert 34 :contains interval-6 interval-4)
  87          (my-assert 35 :contains interval-6 interval-5)
  88          (my-assert 36 :contains interval-6 interval-6))))
  89   t)
  90
  91 ;; adjacent intervals in list
  92 (deftest :time/2
  93   (let* ((interval-list nil)
  94          (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
  95          (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
  96          (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
  97     (setf interval-list
  98           (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3
  99                                                       :type :open)))
 100     (setf interval-list
 101           (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4
 102                                                       :type :open)))
 103     (clsql:interval-relation (car interval-list) (cadr interval-list)))
 104   :precedes)
 105
 106 ;; nested intervals in list
 107 (deftest :time/3
 108     (let* ((interval-list nil)
 109            (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
 110            (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
 111            (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
 112            (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
 113       (setf interval-list
 114             (clsql:interval-push interval-list (clsql:make-interval :start time-1
 115                                                         :end time-4
 116                                                         :type :open)))
 117       (setf interval-list
 118             (clsql:interval-push interval-list (clsql:make-interval :start time-2
 119                                                         :end time-3
 120                                                         :type :closed)))
 121       (let* ((interval (car interval-list))
 122              (interval-contained
 123               (when interval (car (clsql:interval-contained interval)))))
 124         (when (and interval interval-contained)
 125           (and (clsql:time= (clsql:interval-start interval) time-1)
 126                (clsql:time= (clsql:interval-end interval) time-4)
 127                (eq (clsql:interval-type interval) :open)
 128                (clsql:time= (clsql:interval-start interval-contained) time-2)
 129                (clsql:time= (clsql:interval-end interval-contained) time-3)
 130                (eq (clsql:interval-type interval-contained) :closed)))))
 131   t)
 132
 133 ;; interval-edit - nonoverlapping
 134 (deftest :time/4
 135     (let* ((interval-list nil)
 136            (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
 137            (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
 138            (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
 139            (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
 140       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
 141       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 :type :closed)))
 142       (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-3))
 143       ;; should be time-3 not time-2
 144       (clsql:time= (clsql:interval-end (car interval-list)) time-3))
 145   t)
 146
 147 ;; interval-edit - overlapping
 148 (deftest :time/5
 149     (let* ((interval-list nil)
 150            (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
 151            (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
 152            (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
 153            (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
 154       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
 155       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-4 :type :closed)))
 156       (let ((pass t))
 157         (handler-case
 158             (progn
 159               (setf interval-list
 160                     (clsql:interval-edit interval-list time-1 time-1 time-3))
 161               (setf pass nil))
 162           (error nil))
 163         pass))
 164   t)
 165
 166 ;; interval-edit - nested intervals in list
 167 (deftest :time/6
 168     (let* ((interval-list nil)
 169            (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
 170            (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
 171            (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
 172            (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
 173            (time-5 (clsql:parse-timestring "2002-01-01 14:00:00"))
 174            (time-6 (clsql:parse-timestring "2002-01-01 15:00:00")))
 175       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-6 :type :open)))
 176       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-3 :type :closed)))
 177       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-4 :end time-5 :type :closed)))
 178       (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-4))
 179       ;; should be time-4 not time-6
 180       (clsql:time= (clsql:interval-end (car interval-list)) time-4))
 181   t)
 182
 183 ;; Test the boundaries of Local Time with granularity of 1 year
 184 (deftest :time/7
 185     (let ((sec-in-year (* 60 60 24 365))
 186           (year (clsql:time-element (clsql:make-time) :year)))
 187       (dotimes (n 50 n)
 188         (let ((date (clsql:make-time :second (* n sec-in-year))))
 189           (unless (= (+ year n)
 190                      (clsql:time-element date :year))
 191             (return n)))))
 192   50)
 193
 194 ;; Test db-timestring
 195 (deftest :time/9
 196     (flet ((grab-year (dbstring)
 197              (parse-integer (subseq dbstring 1 5))))
 198       (let ((second-in-year (* 60 60 24 365)))
 199         (dotimes (n 2000 n)
 200           (let* ((second (* -1 n second-in-year))
 201                  (date (clsql:make-time :year 2525 :second second)))
 202             (unless
 203                 (= (grab-year (clsql:db-timestring date))
 204                    (clsql:time-element date :year))
 205               (return n))))))
 206   2000)
 207
 208 ;; Conversion between MJD and Gregorian
 209 (deftest :time/10
 210     (dotimes (base 10000 base)
 211       (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base))
 212                  base)
 213         (return base)))
 214   10000)
 215
 216 ;; Clsql:Roll by minutes: +90
 217 (deftest :time/11
 218     (let ((now (clsql:get-time)))
 219       (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90))
 220              (clsql:roll now :minute 90)))
 221   t)
 222
 223 ;;Clsql:Roll by minutes: +900
 224 (deftest :time/12
 225     (let ((now (clsql:get-time)))
 226       (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900))
 227              (clsql:roll now :minute 900)))
 228   t)
 229
 230
 231 ;; Clsql:Roll by minutes: +900
 232 (deftest :time/13
 233     (let* ((now (clsql:get-time))
 234            (add-time (clsql:time+ now (clsql:make-duration :minute 9000)))
 235            (roll-time (clsql:roll now :minute 9000)))
 236       (clsql:time= add-time roll-time))
 237   t)
 238
 239
 240 (deftest :time/14-usec
 241     ;;make sure when we print and parse we get the same time.
 242     (let* ((time (clsql-sys:make-time :year 2010 :month 1 :day 4
 243                                       :hour 14 :minute 15 :second 44 :usec 3))
 244            (string-time (clsql-sys:format-time nil time :format :iso))
 245            (time2 (clsql-sys:parse-timestring string-time)))
 246       (format-time nil time2 :format :iso))
 247   #.(format-time nil (clsql-sys:make-time :year 2010 :month 1 :day 4
 248                                       :hour 14 :minute 15 :second 44 :usec 3)
 249      :format :iso)
 250   t)
 251
 252
 253 ;;; The cross platform dataset uses the 'timestamp' column type which is
 254 ;;; in sql-92, for all that means.
 255
 256 (deftest :time/cross-platform/no-usec/no-tz
 257     (with-dataset *cross-platform-datetest*
 258       (let ((time (parse-timestring "2008-09-09T14:37:29")))
 259         (clsql-sys:insert-records :into [datetest]
 260                                   :attributes '([testtime])
 261                                   :values (list time))
 262         (let ((testtime
 263                (first (clsql:select [testtime]
 264                                     :from [datetest]
 265                                     :limit 1 :flatp T
 266                                     :where [= [testtime] time] ))))
 267           (format-time nil (parse-timestring testtime) :format :iso)
 268           )))
 269   #.(format-time nil (parse-timestring "2008-09-09T14:37:29") :format :iso))
 270
 271 (deftest :time/cross-platform/no-usec/tz
 272     (with-dataset *cross-platform-datetest*
 273       (let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
 274         (clsql-sys:insert-records :into [datetest]
 275                                   :attributes '([testtime])
 276                                   :values (list time))
 277         (let ((testtime
 278                (first (clsql:select [testtime]
 279                                     :from [datetest]
 280                                     :limit 1 :flatp T
 281                                     :where [= [testtime] time] ))))
 282           (format-time nil (parse-timestring testtime) :format :iso)
 283           )))
 284   #.(format-time nil (parse-timestring "2008-09-09T14:37:29-04:00") :format :iso))
 285
 286 (deftest :time/cross-platform/usec/no-tz
 287     (with-dataset *cross-platform-datetest*
 288       (let ((time (parse-timestring "2008-09-09T14:37:29.000213")))
 289         (clsql-sys:insert-records :into [datetest]
 290                                   :attributes '([testtime])
 291                                   :values (list time))
 292         (let ((testtime
 293                (first (clsql:select [testtime]
 294                                     :from [datetest]
 295                                     :limit 1 :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 ;;; All odbc databases use local times exclusively (they do not send timezone info)
 319 ;;; Postgresql can use timezones, except when being used over odbc.  This test when
 320 ;;; run through both postgres socket and postgres odbc should test a fairly
 321 ;;; broad swath of available problem space
 322 ;;;
 323 ;;; Things the following tests try to prove correct
 324 ;;;  * Reading and writing usec and usec-less times
 325 ;;;  * reading and writing timezones (Z=utc) when appropriate (eg: postgresql-socket)
 326 ;;;  * reading and writing localtimes when appropriate (eg: ODBC)
 327 ;;;  * reading and writing through both the oodml and fdml layers
 328
 329
 330
 331 (deftest :time/pg/fdml/usec
 332     (with-dataset *ds-datetest*
 333       (let ((time (parse-timestring "2008-09-09T14:37:29.000213-04:00")))
 334         (clsql-sys:insert-records :into [datetest]
 335                                   :attributes '([testtimetz] [testtime])
 336                                   :values (list time time))
 337         (destructuring-bind (testtimetz testtime)
 338             (first (clsql:select [testtimetz] [testtime]
 339                                  :from [datetest]
 340                                  :limit 1 :flatp T
 341                                  :where [= [testtime] time] ))
 342           (assert (time= (parse-timestring testtimetz) time) (testtimetz time)
 343                   "Timetz of o: ~s should be time:~s" testtimetz time)
 344           (assert (time= (parse-timestring testtime) time) (testtime time)
 345                   "Time of o: ~s should be time:~s" testtime time))))
 346   nil)
 347
 348 (deftest :time/pg/oodml/no-usec
 349     (with-dataset *ds-datetest*
 350       (let ((time (parse-timestring "2008-09-09T14:37:29-04:00")))
 351         (clsql-sys:update-records-from-instance
 352          (make-instance 'datetest :testtimetz time :testtime time))
 353         (let ((o (first (clsql:select
 354                          'datetest
 355                          :limit 1 :flatp T
 356                          :where [= [testtime] time] ))))
 357           (assert o (o) "o shouldnt be null here (we should have just inserted)")
 358           (update-records-from-instance o)
 359           (update-instance-from-records o)
 360           (assert (time= (testtime o) time) (time o)
 361                   "Time of o: ~s should be time:~s" (testtime o) time)
 362           (assert (time= (testtimetz o) time) (time o)
 363                   "Timetz of o: ~s should be time:~s" (testtime o) time))))
 364   nil)
 365
 366 (deftest :time/pg/oodml/usec
 367     (with-dataset *ds-datetest*
 368       (let ((time (parse-timestring "2008-09-09T14:37:29.000278-04:00")))
 369         (clsql-sys:update-records-from-instance
 370          (make-instance 'datetest :testtimetz time :testtime time))
 371         (let ((o (first (clsql:select
 372                          'datetest
 373                          :limit 1 :flatp T
 374                          :where [= [testtime] time] ))))
 375           (assert o (o) "o shouldnt be null here (we should have just inserted)")
 376           (update-records-from-instance o)
 377           (update-instance-from-records o)
 378           (assert (time= (testtime o) time) (time o)
 379                   "Time of o: ~s should be time:~s" (testtime o) time)
 380           (assert (time= (testtimetz o) time) (time o)
 381                   "Timetz of o: ~s should be time:~s" (testtime o) time)
 382           )))
 383   nil)
 384
 385 ))
 386
 387
 388 #.(clsql-sys:locally-disable-sql-reader-syntax)