X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-time.lisp;h=9b4b85780dacada03d4ea2b717e516036deedf28;hp=92cf022ac46bff5b45a9f3135fff5610c1e690d7;hb=e567409d9fff3f7231c2a0bb69b345e19de2b246;hpb=215ec41559dda52d46539d48a0aa390811c2423c diff --git a/tests/test-time.lisp b/tests/test-time.lisp index 92cf022..9b4b857 100644 --- a/tests/test-time.lisp +++ b/tests/test-time.lisp @@ -7,62 +7,62 @@ (in-package #:clsql-tests) -(setq *rt-time* +(setq *rt-time* '( ;; relations of intervals (deftest :time/1 (let* ((time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")) - (interval-1 (clsql:make-interval :start time-1 :end time-2)) - (interval-2 (clsql:make-interval :start time-2 :end time-3)) - (interval-3 (clsql:make-interval :start time-3 :end time-4)) - (interval-4 (clsql:make-interval :start time-1 :end time-3)) - (interval-5 (clsql:make-interval :start time-2 :end time-4)) - (interval-6 (clsql:make-interval :start time-1 :end time-4))) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")) + (interval-1 (clsql:make-interval :start time-1 :end time-2)) + (interval-2 (clsql:make-interval :start time-2 :end time-3)) + (interval-3 (clsql:make-interval :start time-3 :end time-4)) + (interval-4 (clsql:make-interval :start time-1 :end time-3)) + (interval-5 (clsql:make-interval :start time-2 :end time-4)) + (interval-6 (clsql:make-interval :start time-1 :end time-4))) (flet ((my-assert (number relation i1 i2) - (declare (ignore number)) - (let ((found-relation (clsql:interval-relation i1 i2))) - (equal relation found-relation)))) - (and - (my-assert 1 :contains interval-1 interval-1) - (my-assert 2 :precedes interval-1 interval-2) - (my-assert 3 :precedes interval-1 interval-3) - (my-assert 4 :contained interval-1 interval-4) - (my-assert 5 :precedes interval-1 interval-5) - (my-assert 6 :contained interval-1 interval-6) - (my-assert 7 :follows interval-2 interval-1) - (my-assert 8 :contains interval-2 interval-2) - (my-assert 9 :precedes interval-2 interval-3) - (my-assert 10 :contained interval-2 interval-4) - (my-assert 11 :contained interval-2 interval-5) - (my-assert 12 :contained interval-2 interval-6) - (my-assert 13 :follows interval-3 interval-1) - (my-assert 14 :follows interval-3 interval-2) - (my-assert 15 :contains interval-3 interval-3) - (my-assert 16 :follows interval-3 interval-4) - (my-assert 17 :contained interval-3 interval-5) - (my-assert 18 :contained interval-3 interval-6) - (my-assert 19 :contains interval-4 interval-1) - (my-assert 20 :contains interval-4 interval-2) - (my-assert 21 :precedes interval-4 interval-3) - (my-assert 22 :contains interval-4 interval-4) - (my-assert 23 :overlaps interval-4 interval-5) - (my-assert 24 :contained interval-4 interval-6) - (my-assert 25 :follows interval-5 interval-1) - (my-assert 26 :contains interval-5 interval-2) - (my-assert 27 :contains interval-5 interval-3) - (my-assert 28 :overlaps interval-5 interval-4) - (my-assert 29 :contains interval-5 interval-5) - (my-assert 30 :contained interval-5 interval-6) - (my-assert 31 :contains interval-6 interval-1) - (my-assert 32 :contains interval-6 interval-2) - (my-assert 33 :contains interval-6 interval-3) - (my-assert 34 :contains interval-6 interval-4) - (my-assert 35 :contains interval-6 interval-5) - (my-assert 36 :contains interval-6 interval-6)))) + (declare (ignore number)) + (let ((found-relation (clsql:interval-relation i1 i2))) + (equal relation found-relation)))) + (and + (my-assert 1 :contains interval-1 interval-1) + (my-assert 2 :precedes interval-1 interval-2) + (my-assert 3 :precedes interval-1 interval-3) + (my-assert 4 :contained interval-1 interval-4) + (my-assert 5 :precedes interval-1 interval-5) + (my-assert 6 :contained interval-1 interval-6) + (my-assert 7 :follows interval-2 interval-1) + (my-assert 8 :contains interval-2 interval-2) + (my-assert 9 :precedes interval-2 interval-3) + (my-assert 10 :contained interval-2 interval-4) + (my-assert 11 :contained interval-2 interval-5) + (my-assert 12 :contained interval-2 interval-6) + (my-assert 13 :follows interval-3 interval-1) + (my-assert 14 :follows interval-3 interval-2) + (my-assert 15 :contains interval-3 interval-3) + (my-assert 16 :follows interval-3 interval-4) + (my-assert 17 :contained interval-3 interval-5) + (my-assert 18 :contained interval-3 interval-6) + (my-assert 19 :contains interval-4 interval-1) + (my-assert 20 :contains interval-4 interval-2) + (my-assert 21 :precedes interval-4 interval-3) + (my-assert 22 :contains interval-4 interval-4) + (my-assert 23 :overlaps interval-4 interval-5) + (my-assert 24 :contained interval-4 interval-6) + (my-assert 25 :follows interval-5 interval-1) + (my-assert 26 :contains interval-5 interval-2) + (my-assert 27 :contains interval-5 interval-3) + (my-assert 28 :overlaps interval-5 interval-4) + (my-assert 29 :contains interval-5 interval-5) + (my-assert 30 :contained interval-5 interval-6) + (my-assert 31 :contains interval-6 interval-1) + (my-assert 32 :contains interval-6 interval-2) + (my-assert 33 :contains interval-6 interval-3) + (my-assert 34 :contains interval-6 interval-4) + (my-assert 35 :contains interval-6 interval-5) + (my-assert 36 :contains interval-6 interval-6)))) t) ;; adjacent intervals in list @@ -71,145 +71,145 @@ (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) - (setf interval-list - (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3 - :type :open))) - (setf interval-list - (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 - :type :open))) + (setf interval-list + (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-3 + :type :open))) + (setf interval-list + (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 + :type :open))) (clsql:interval-relation (car interval-list) (cadr interval-list))) :precedes) ;; nested intervals in list (deftest :time/3 (let* ((interval-list nil) - (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) - (setf interval-list - (clsql:interval-push interval-list (clsql:make-interval :start time-1 - :end time-4 - :type :open))) - (setf interval-list - (clsql:interval-push interval-list (clsql:make-interval :start time-2 - :end time-3 - :type :closed))) + (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) + (setf interval-list + (clsql:interval-push interval-list (clsql:make-interval :start time-1 + :end time-4 + :type :open))) + (setf interval-list + (clsql:interval-push interval-list (clsql:make-interval :start time-2 + :end time-3 + :type :closed))) (let* ((interval (car interval-list)) - (interval-contained - (when interval (car (clsql:interval-contained interval))))) - (when (and interval interval-contained) - (and (clsql:time= (clsql:interval-start interval) time-1) - (clsql:time= (clsql:interval-end interval) time-4) - (eq (clsql:interval-type interval) :open) - (clsql:time= (clsql:interval-start interval-contained) time-2) - (clsql:time= (clsql:interval-end interval-contained) time-3) - (eq (clsql:interval-type interval-contained) :closed))))) + (interval-contained + (when interval (car (clsql:interval-contained interval))))) + (when (and interval interval-contained) + (and (clsql:time= (clsql:interval-start interval) time-1) + (clsql:time= (clsql:interval-end interval) time-4) + (eq (clsql:interval-type interval) :open) + (clsql:time= (clsql:interval-start interval-contained) time-2) + (clsql:time= (clsql:interval-end interval-contained) time-3) + (eq (clsql:interval-type interval-contained) :closed))))) t) ;; interval-edit - nonoverlapping (deftest :time/4 (let* ((interval-list nil) - (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) + (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open))) (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-3 :end time-4 :type :closed))) (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-3)) - ;; should be time-3 not time-2 + ;; should be time-3 not time-2 (clsql:time= (clsql:interval-end (car interval-list)) time-3)) t) ;; interval-edit - overlapping (deftest :time/5 (let* ((interval-list nil) - (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) + (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00"))) (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-2 :type :open))) (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-4 :type :closed))) (let ((pass t)) - (handler-case - (progn - (setf interval-list - (clsql:interval-edit interval-list time-1 time-1 time-3)) - (setf pass nil)) - (error nil)) - pass)) + (handler-case + (progn + (setf interval-list + (clsql:interval-edit interval-list time-1 time-1 time-3)) + (setf pass nil)) + (error nil)) + pass)) t) ;; interval-edit - nested intervals in list (deftest :time/6 (let* ((interval-list nil) - (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) - (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) - (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) - (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")) - (time-5 (clsql:parse-timestring "2002-01-01 14:00:00")) - (time-6 (clsql:parse-timestring "2002-01-01 15:00:00"))) + (time-1 (clsql:parse-timestring "2002-01-01 10:00:00")) + (time-2 (clsql:parse-timestring "2002-01-01 11:00:00")) + (time-3 (clsql:parse-timestring "2002-01-01 12:00:00")) + (time-4 (clsql:parse-timestring "2002-01-01 13:00:00")) + (time-5 (clsql:parse-timestring "2002-01-01 14:00:00")) + (time-6 (clsql:parse-timestring "2002-01-01 15:00:00"))) (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-1 :end time-6 :type :open))) (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-2 :end time-3 :type :closed))) (setf interval-list (clsql:interval-push interval-list (clsql:make-interval :start time-4 :end time-5 :type :closed))) (setf interval-list (clsql:interval-edit interval-list time-1 time-1 time-4)) - ;; should be time-4 not time-6 + ;; should be time-4 not time-6 (clsql:time= (clsql:interval-end (car interval-list)) time-4)) t) - + ;; Test the boundaries of Local Time with granularity of 1 year (deftest :time/7 (let ((sec-in-year (* 60 60 24 365)) - (year (clsql:time-element (clsql:make-time) :year))) + (year (clsql:time-element (clsql:make-time) :year))) (dotimes (n 50 n) - (let ((date (clsql:make-time :second (* n sec-in-year)))) - (unless (= (+ year n) - (clsql:time-element date :year)) - (return n))))) + (let ((date (clsql:make-time :second (* n sec-in-year)))) + (unless (= (+ year n) + (clsql:time-element date :year)) + (return n))))) 50) ;; Test db-timestring (deftest :time/9 (flet ((grab-year (dbstring) - (parse-integer (subseq dbstring 1 5)))) + (parse-integer (subseq dbstring 1 5)))) (let ((second-in-year (* 60 60 24 365))) - (dotimes (n 2000 n) - (let* ((second (* -1 n second-in-year)) - (date (clsql:make-time :year 2525 :second second))) - (unless + (dotimes (n 2000 n) + (let* ((second (* -1 n second-in-year)) + (date (clsql:make-time :year 2525 :second second))) + (unless (= (grab-year (clsql:db-timestring date)) (clsql:time-element date :year)) - (return n)))))) + (return n)))))) 2000) ;; Conversion between MJD and Gregorian (deftest :time/10 (dotimes (base 10000 base) (unless (= (apply #'clsql:gregorian-to-mjd (clsql:mjd-to-gregorian base)) - base) - (return base))) + base) + (return base))) 10000) - + ;; Clsql:Roll by minutes: +90 (deftest :time/11 (let ((now (clsql:get-time))) (clsql:time= (clsql:time+ now (clsql:make-duration :minute 90)) - (clsql:roll now :minute 90))) + (clsql:roll now :minute 90))) t) ;;Clsql:Roll by minutes: +900 (deftest :time/12 (let ((now (clsql:get-time))) (clsql:time= (clsql:time+ now (clsql:make-duration :minute 900)) - (clsql:roll now :minute 900))) + (clsql:roll now :minute 900))) t) ;; Clsql:Roll by minutes: +900 (deftest :time/13 (let* ((now (clsql:get-time)) - (add-time (clsql:time+ now (clsql:make-duration :minute 9000))) - (roll-time (clsql:roll now :minute 9000))) + (add-time (clsql:time+ now (clsql:make-duration :minute 9000))) + (roll-time (clsql:roll now :minute 9000))) (clsql:time= add-time roll-time)) t)