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
  10 (setq *rt-time*
  11       '(
  12
  13 ;; relations of intervals
  14 (deftest :time/1
  15     (let* ((time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
  16            (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
  17            (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
  18            (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
  19            (interval-1 (clsql:make-interval :start time-1 :end time-2))
  20            (interval-2 (clsql:make-interval :start time-2 :end time-3))
  21            (interval-3 (clsql:make-interval :start time-3 :end time-4))
  22            (interval-4 (clsql:make-interval :start time-1 :end time-3))
  23            (interval-5 (clsql:make-interval :start time-2 :end time-4))
  24            (interval-6 (clsql:make-interval :start time-1 :end time-4)))
  25       (flet ((my-assert (number relation i1 i2)
  26                (declare (ignore number))
  27                (let ((found-relation (clsql:interval-relation i1 i2)))
  28                  (equal relation found-relation))))
  29         (and
  30          (my-assert 1 :contains interval-1 interval-1)
  31          (my-assert 2 :precedes interval-1 interval-2)
  32          (my-assert 3 :precedes interval-1 interval-3)
  33          (my-assert 4 :contained interval-1 interval-4)
  34          (my-assert 5 :precedes interval-1 interval-5)
  35          (my-assert 6 :contained interval-1 interval-6)
  36          (my-assert 7 :follows interval-2 interval-1)
  37          (my-assert 8 :contains interval-2 interval-2)
  38          (my-assert 9 :precedes interval-2 interval-3)
  39          (my-assert 10 :contained interval-2 interval-4)
  40          (my-assert 11 :contained interval-2 interval-5)
  41          (my-assert 12 :contained interval-2 interval-6)
  42          (my-assert 13 :follows interval-3 interval-1)
  43          (my-assert 14 :follows interval-3 interval-2)
  44          (my-assert 15 :contains interval-3 interval-3)
  45          (my-assert 16 :follows interval-3 interval-4)
  46          (my-assert 17 :contained interval-3 interval-5)
  47          (my-assert 18 :contained interval-3 interval-6)
  48          (my-assert 19 :contains interval-4 interval-1)
  49          (my-assert 20 :contains interval-4 interval-2)
  50          (my-assert 21 :precedes interval-4 interval-3)
  51          (my-assert 22 :contains interval-4 interval-4)
  52          (my-assert 23 :overlaps interval-4 interval-5)
  53          (my-assert 24 :contained interval-4 interval-6)
  54          (my-assert 25 :follows interval-5 interval-1)
  55          (my-assert 26 :contains interval-5 interval-2)
  56          (my-assert 27 :contains interval-5 interval-3)
  57          (my-assert 28 :overlaps interval-5 interval-4)
  58          (my-assert 29 :contains interval-5 interval-5)
  59          (my-assert 30 :contained interval-5 interval-6)
  60          (my-assert 31 :contains interval-6 interval-1)
  61          (my-assert 32 :contains interval-6 interval-2)
  62          (my-assert 33 :contains interval-6 interval-3)
  63          (my-assert 34 :contains interval-6 interval-4)
  64          (my-assert 35 :contains interval-6 interval-5)
  65          (my-assert 36 :contains interval-6 interval-6))))
  66   t)
  67
  68 ;; adjacent intervals in list
  69 (deftest :time/2
  70   (let* ((interval-list nil)
  71          (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
  72          (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
  73          (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
  74     (setf interval-list
  75           (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3
  76                                                       :type :open)))
  77     (setf interval-list
  78           (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4
  79                                                       :type :open)))
  80     (clsql:interval-relation (car interval-list) (cadr interval-list)))
  81   :precedes)
  82
  83 ;; nested intervals in list
  84 (deftest :time/3
  85     (let* ((interval-list nil)
  86            (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
  87            (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
  88            (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
  89            (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
  90       (setf interval-list
  91             (clsql:interval-push interval-list (clsql:make-interval :start time-1
  92                                                         :end time-4
  93                                                         :type :open)))
  94       (setf interval-list
  95             (clsql:interval-push interval-list (clsql:make-interval :start time-2
  96                                                         :end time-3
  97                                                         :type :closed)))
  98       (let* ((interval (car interval-list))
  99              (interval-contained
 100               (when interval (car (clsql:interval-contained interval)))))
 101         (when (and interval interval-contained)
 102           (and (clsql:time= (clsql:interval-start interval) time-1)
 103                (clsql:time= (clsql:interval-end interval) time-4)
 104                (eq (clsql:interval-type interval) :open)
 105                (clsql:time= (clsql:interval-start interval-contained) time-2)
 106                (clsql:time= (clsql:interval-end interval-contained) time-3)
 107                (eq (clsql:interval-type interval-contained) :closed)))))
 108   t)
 109
 110 ;; interval-edit - nonoverlapping
 111 (deftest :time/4
 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 (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
 118       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 :type :closed)))
 119       (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-3))
 120       ;; should be time-3 not time-2
 121       (clsql:time= (clsql:interval-end (car interval-list)) time-3))
 122   t)
 123
 124 ;; interval-edit - overlapping
 125 (deftest :time/5
 126     (let* ((interval-list nil)
 127            (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
 128            (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
 129            (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
 130            (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")))
 131       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open)))
 132       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-4 :type :closed)))
 133       (let ((pass t))
 134         (handler-case
 135             (progn
 136               (setf interval-list
 137                     (clsql:interval-edit interval-list time-1 time-1 time-3))
 138               (setf pass nil))
 139           (error nil))
 140         pass))
 141   t)
 142
 143 ;; interval-edit - nested intervals in list
 144 (deftest :time/6
 145     (let* ((interval-list nil)
 146            (time-1 (clsql:parse-timestring "2002-01-01 10:00:00"))
 147            (time-2 (clsql:parse-timestring "2002-01-01 11:00:00"))
 148            (time-3 (clsql:parse-timestring "2002-01-01 12:00:00"))
 149            (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))
 150            (time-5 (clsql:parse-timestring "2002-01-01 14:00:00"))
 151            (time-6 (clsql:parse-timestring "2002-01-01 15:00:00")))
 152       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-6 :type :open)))
 153       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-3 :type :closed)))
 154       (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-4 :end time-5 :type :closed)))
 155       (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-4))
 156       ;; should be time-4 not time-6
 157       (clsql:time= (clsql:interval-end (car interval-list)) time-4))
 158   t)
 159
 160 ;; Test the boundaries of Local Time with granularity of 1 year
 161 (deftest :time/7
 162     (let ((sec-in-year (* 60 60 24 365))
 163           (year (clsql:time-element (clsql:make-time) :year)))
 164       (dotimes (n 50 n)
 165         (let ((date (clsql:make-time :second (* n sec-in-year))))
 166           (unless (= (+ year n)
 167                      (clsql:time-element date :year))
 168             (return n)))))
 169   50)
 170
 171 ;; Test db-timestring
 172 (deftest :time/9
 173     (flet ((grab-year (dbstring)
 174              (parse-integer (subseq dbstring 1 5))))
 175       (let ((second-in-year (* 60 60 24 365)))
 176         (dotimes (n 2000 n)
 177           (let* ((second (* -1 n second-in-year))
 178                  (date (clsql:make-time :year 2525 :second second)))
 179             (unless
 180                 (= (grab-year (clsql:db-timestring date))
 181                    (clsql:time-element date :year))
 182               (return n))))))
 183   2000)
 184
 185 ;; Conversion between MJD and Gregorian
 186 (deftest :time/10
 187     (dotimes (base 10000 base)
 188       (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base))
 189                  base)
 190         (return base)))
 191   10000)
 192
 193 ;; Clsql:Roll by minutes: +90
 194 (deftest :time/11
 195     (let ((now (clsql:get-time)))
 196       (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90))
 197              (clsql:roll now :minute 90)))
 198   t)
 199
 200 ;;Clsql:Roll by minutes: +900
 201 (deftest :time/12
 202     (let ((now (clsql:get-time)))
 203       (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900))
 204              (clsql:roll now :minute 900)))
 205   t)
 206
 207
 208 ;; Clsql:Roll by minutes: +900
 209 (deftest :time/13
 210     (let* ((now (clsql:get-time))
 211            (add-time (clsql:time+ now (clsql:make-duration :minute 9000)))
 212            (roll-time (clsql:roll now :minute 9000)))
 213       (clsql:time= add-time roll-time))
 214   t)
 215
 216 ))