simple-date/tests.lisp

   1 (defpackage :simple-date-tests
   2   (:use :common-lisp :fiveam :simple-date))
   3
   4 (in-package :simple-date-tests)
   5
   6 ;; After loading the file, run the tests with (fiveam:run! :simple-date)
   7
   8 (def-suite :simple-date)
   9 (in-suite :simple-date)
  10
  11 (test days-in-month
  12   ;; Note: internal date numbers, so 0 is March
  13   (is (= 31 (simple-date::days-in-month 0 2000)))
  14   (is (= 30 (simple-date::days-in-month 1 2000)))
  15   (is (= 31 (simple-date::days-in-month 2 2000)))
  16   (is (= 30 (simple-date::days-in-month 3 2000)))
  17   (is (= 31 (simple-date::days-in-month 4 2000)))
  18   (is (= 31 (simple-date::days-in-month 5 2000)))
  19   (is (= 30 (simple-date::days-in-month 6 2000)))
  20   (is (= 31 (simple-date::days-in-month 7 2000)))
  21   (is (= 30 (simple-date::days-in-month 8 2000)))
  22   (is (= 31 (simple-date::days-in-month 9 2000)))
  23   (is (= 31 (simple-date::days-in-month 10 2000)))
  24   (is (= 29 (simple-date::days-in-month 11 2000)))
  25   (is (= 28 (simple-date::days-in-month 11 2001))))
  26
  27 (defmacro with-random-dates (amount &body body)
  28   (let ((i (gensym)))
  29     `(dotimes (,i ,amount)
  30       (let ((year (+ 1900 (random 300)))
  31             (month (1+ (random 12)))
  32             (day (1+ (random 28)))
  33             (hour (random 24))
  34             (min (random 60))
  35             (sec (random 60))
  36             (millisec (random 1000)))
  37         ,@body))))
  38
  39 (test encode-date
  40   (with-random-dates 100
  41     (declare (ignore hour min sec millisec))
  42     (multiple-value-bind (year* month* day*) (decode-date (encode-date year month day))
  43       (is (and (= year* year)
  44                (= month* month)
  45                (= day* day))))))
  46
  47 (test leap-year
  48   (flet ((test-date (y m d)
  49            (multiple-value-bind (y2 m2 d2) (decode-date (encode-date y m d))
  50              (and (= y y2) (= m m2) (= d d2)))))
  51     (is (test-date 2000 2 29))
  52     (is (test-date 2004 2 29))
  53     (is (test-date 2108 2 29))
  54     (is (test-date 1992 2 29))))
  55
  56 (test encode-timestamp
  57   (with-random-dates 100
  58     (multiple-value-bind (year* month* day* hour* min* sec* millisec*)
  59         (decode-timestamp (encode-timestamp year month day hour min sec millisec))
  60       (is (and (= year* year)
  61                (= month* month)
  62                (= day* day)
  63                (= hour* hour)
  64                (= min* min)
  65                (= sec* sec)
  66                (= millisec* millisec))))))
  67
  68 (test timestamp-universal-times
  69   (with-random-dates 100
  70     (declare (ignore millisec))
  71     (let ((stamp (encode-timestamp year month day hour min sec 0))
  72           (utime (encode-universal-time sec min hour day month year 0)))
  73       (is (= (timestamp-to-universal-time stamp) utime))
  74       (is (time= (universal-time-to-timestamp utime) stamp)))))
  75
  76 (test add-month
  77   (with-random-dates 100
  78     (multiple-value-bind (year* month* day* hour* min* sec* millisec*)
  79         (decode-timestamp (time-add (encode-timestamp year month day hour min sec millisec)
  80                                     (encode-interval :month 1)))
  81       (is (and (or (and (= year* year) (= month* (1+ month)))
  82                    (and (= year* (1+ year)) (= month* 1)))
  83                (= day* day)
  84                (= hour* hour)
  85                (= min* min)
  86                (= sec* sec)
  87                (= millisec* millisec))))))
  88
  89 (test subtract-month
  90   (with-random-dates 100
  91     (multiple-value-bind (year* month* day* hour* min* sec* millisec*)
  92         (decode-timestamp (time-add (encode-timestamp year month day hour min sec millisec)
  93                                     (encode-interval :month -1)))
  94       (is (and (or (and (= year* year) (= month* (1- month)))
  95                    (and (= year* (1- year)) (= month* 12)))
  96                (= day* day)
  97                (= hour* hour)
  98                (= min* min)
  99                (= sec* sec)
 100                (= millisec* millisec))))))
 101
 102 (test add-hour
 103   (with-random-dates 100
 104     (declare (ignore millisec))
 105     (is (= (- (timestamp-to-universal-time (time-add (encode-timestamp year month day hour min sec 0)
 106                                                      (encode-interval :hour 1)))
 107               (encode-universal-time sec min hour day month year 0))
 108            3600))))
 109
 110 (test time<
 111   (with-random-dates 100
 112     (is (time< (encode-date year month day)
 113                (encode-date (1+ year) month day)))
 114     (is (time< (encode-timestamp year month day hour min sec millisec)
 115                (encode-timestamp year month day hour min (1+ sec) millisec)))
 116     (is (time< (encode-interval :month month :hour hour)
 117                (encode-interval :month month :hour hour :minute 30)))))