aland/cl-dates
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Moved test suite to subdirectory

Browse source
This commit is contained in:
Sudhir Shenoy 2017-08-04 06:58:15 +09:00
parent c16f1f44e3
commit 66196d820f
4 changed files with 0 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

341
test/test-dates.lisp Normal file
View file

@ -0,0 +1,341 @@
;;; Copyright (c) 2017, Sudhir Shenoy. All rights reserved.
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :cl-dates-test)
(deftest julian ()
(check
(= (ymd->date 2017 2 5) 2457789.5)
(= (ymd->date 1959 12 29) 2436931.5)
(= (ymd->date 1959 12 29 18 12 26.3) 2436932.2586376667d0)
(equal '(2017 2 5) (multiple-value-call #'list (date->ymd 2457789.5)))
(= (ymd->date 1600 2 29) 2305506.5)
(= (ymd->date 1600 2 29 9 31 23.5) 2305506.896799773d0)
(equal '(1600 2 29 9 31 23.500385284423828d0)
(multiple-value-call #'list (date->ymd 2305506.896799773d0 :want-time t)))
(= (date->javascript-time (ymd->date 2017 6 18)) 1497744000000)
(= (jday-number (ymd->date 2017 6 18)) 2457923)))
(deftest misc-fns ()
(check
(valid-date-p 2000 2 29)
(null (valid-date-p 1900 2 29))
(null (valid-date-p 1234 65 789))
(null (leap-year-p 1900))
(leap-year-p 2000)
(null (leap-year-p 2001))
(leap-year-p 2004)
(eq :monday (day-of-week (ymd->date 2017 2 6)))
(eq :wednesday (day-of-week (ymd->date 1959 9 23)))
(= (nth-day-of-week (ymd->date 2017 2 5) :tuesday 3) (ymd->date 2017 2 21))
(= (nth-day-of-week (ymd->date 2017 2 5) :thursday 3) (ymd->date 2017 2 16))
;; overflow month - returns last tuesday
(= (nth-day-of-week (ymd->date 2017 2 5) :tuesday 7) (ymd->date 2017 2 28))
;; any number <= 1 should return 1st tuesday
(= (nth-day-of-week (ymd->date 2017 2 5) :tuesday -7) (ymd->date 2017 2 7))
(= (first-of-next-month (ymd->date 2017 6 18)) (ymd->date 2017 7 1))
(= (first-of-next-month (ymd->date 2016 12 18)) (ymd->date 2017 1 1))
(= (last-day-of-month (ymd->date 2016 12 18)) (ymd->date 2016 12 31))
(= (last-day-of-month (ymd->date 2016 2 1)) (ymd->date 2016 2 29))
(= (last-day-of-month (ymd->date 2017 2 1)) (ymd->date 2017 2 28))
(= (last-day-of-prev-month (ymd->date 2016 12 18)) (ymd->date 2016 11 30))
(= (last-day-of-prev-month (ymd->date 2017 1 1)) (ymd->date 2016 12 31))
(= (last-day-of-prev-month (ymd->date 2016 3 1)) (ymd->date 2016 2 29))
(= (last-day-of-prev-month (ymd->date 2017 3 1)) (ymd->date 2017 2 28))
(date= (ymd->date 2007 2 3 10 35 42) (ymd->date 2007 2 3 11 30 20) (ymd->date 2007 2 3 12 45 12))
(date/= (ymd->date 2007 2 4) (ymd->date 2007 2 3) (ymd->date 2007 2 3))
(date< (ymd->date 2007 2 3 10 35 42) (ymd->date 2007 2 4 11 30 20) (ymd->date 2007 2 5 12 45 12))
(not (date< (ymd->date 2007 2 3 10 35 42) (ymd->date 2007 2 3 11 30 20) (ymd->date 2007 2 5 12 45 12)))
(date<= (ymd->date 2007 2 3 10 35 42) (ymd->date 2007 2 3 11 30 20) (ymd->date 2007 2 5 12 45 12))))
(deftest print-fns ()
(let ((dt1 (ymd->date 2017 2 16))
(dt2 (ymd->date 2017 2 16 17 30 25 +9)))
(check
(string= (dow->string :monday) "Monday")
(string= (dow->string :tuesday) "Tuesday")
(string= (dow->string :wednesday) "Wednesday")
(string= (dow->string :thursday) "Thursday")
(string= (dow->string :friday) "Friday")
(string= (dow->string :saturday) "Saturday")
(string= (dow->string :sunday) "Sunday")
(string= (month->string 1) "January")
(string= (month->string 2) "February")
(string= (month->string 3) "March")
(string= (month->string 4) "April")
(string= (month->string 5) "May")
(string= (month->string 6) "June")
(string= (month->string 7) "July")
(string= (month->string 8) "August")
(string= (month->string 9) "September")
(string= (month->string 10) "October")
(string= (month->string 11) "November")
(string= (month->string 12) "December")
(string= (date->string dt1) "2017-02-16")
(string= (date->string dt1 :format :iso-8601) "2017-02-16")
(string= (date->string dt1 :format :asctime) "Thu Feb 16 2017")
(string= (date->string dt1 :format :rfc-822) "Thu, 16 Feb 2017")
(string= (date->string dt1 :format :rfc-850) "Thu, 16-Feb-2017")
(string= (date->string dt2) "2017-02-16 08:30:25 UTC")
(string= (date->string dt2 :format :iso-8601) "2017-02-16T08:30:25Z")
(string= (date->string dt2 :format :asctime) "Thu Feb 16 08:30:25 GMT 2017")
(string= (date->string dt2 :format :rfc-822) "Thu, 16 Feb 2017 08:30:25 GMT")
(string= (date->string dt2 :format :rfc-850) "Thu, 16-Feb-2017 08:30:25 GMT")
(string= (date->string dt2 :zone "JST") "2017-02-16 17:30:25 +09:00")
(string= (date->string dt2 :zone "JST" :format :iso-8601) "2017-02-16T17:30:25+09:00")
(string= (date->string dt2 :zone "JST" :format :asctime) "Thu Feb 16 17:30:25 +0900 2017")
(string= (date->string dt2 :zone "JST" :format :rfc-822) "Thu, 16 Feb 2017 17:30:25 +0900")
(string= (date->string dt2 :zone "JST" :format :rfc-850) "Thu, 16-Feb-2017 17:30:25 +0900"))))
(deftest special-dates ()
(check
(= (easter-day 2001) (ymd->date 2001 4 15))
(= (easter-day 2002) (ymd->date 2002 3 31))
(= (easter-day 2005) (ymd->date 2005 3 27))
(= (easter-day 2011) (ymd->date 2011 4 24))
(= (vernal-equinox 2017)
(ymd->date 2017 3 20 10 28 32.05221712589264d0))
(= (summer-solstice 2017)
(ymd->date 2017 6 21 4 23 43.49940687417984d0))
(= (autumnal-equinox 2017)
(ymd->date 2017 9 22 20 1 8.430179357528687D0))
(= (winter-solstice 2017)
(ymd->date 2017 12 21 16 27 51.39586955308914d0))
(= (vernal-equinox 1959)
(ymd->date 1959 3 21 8 55 7.991203665733337d0))
(= (summer-solstice 1959)
(ymd->date 1959 6 22 3 49 50.55352360010147d0))
(= (autumnal-equinox 1959)
(ymd->date 1959 9 23 19 8 29.363870322704315D0))
(= (winter-solstice 1959)
(ymd->date 1959 12 22 14 34 33.68946969509125d0))))
(deftest date-arith ()
(check
(= (date+ (ymd->date 2016 2 28) 1) (ymd->date 2016 2 29))
(= (date+ (ymd->date 2016 2 28) 2) (ymd->date 2016 3 1))
(= (date- (ymd->date 2016 3 1) 2) (ymd->date 2016 2 28))
(= (date- (ymd->date 2016 3 1) 1) (ymd->date 2016 2 29))
(= (add-months (ymd->date 2016 2 29) 6) (ymd->date 2016 8 29))
(= (add-months (ymd->date 2016 2 29) 6 :eom-rule :eom-normal) (ymd->date 2016 8 31))
(= (add-months (ymd->date 2016 2 29) 6 :eom-rule :eom-no-leap-day) (ymd->date 2016 8 31))
(= (add-months (ymd->date 2016 2 28) 6 :eom-rule :eom-normal) (ymd->date 2016 8 28))
(= (add-months (ymd->date 2016 2 28) 6 :eom-rule :eom-no-leap-day) (ymd->date 2016 8 31))
(= (add-months (ymd->date 2016 2 29) 12) (ymd->date 2017 2 28))
(= (add-months (ymd->date 2016 2 29) 48) (ymd->date 2020 2 29))
(= (add-years (ymd->date 2016 2 29) 4) (add-months (ymd->date 2016 2 29) 48))
(= (add-months (ymd->date 2016 1 31) 1) (ymd->date 2016 2 29))
(= (add-months (ymd->date 2016 1 31) 2) (ymd->date 2016 3 31))
(= (add-months (ymd->date 2016 1 31) 3) (ymd->date 2016 4 30))
(= (add-months (ymd->date 2016 4 30) 1) (ymd->date 2016 5 30))
(= (add-months (ymd->date 2016 4 30) 1 :eom-rule :eom-normal) (ymd->date 2016 5 31))
(= (add-months (ymd->date 2016 4 30) 1 :eom-rule :eom-no-leap-day) (ymd->date 2016 5 31))
(= (add-months (ymd->date 2016 4 30) 46 :eom-rule :eom-normal) (ymd->date 2020 2 29))
(= (add-months (ymd->date 2016 4 30) 46 :eom-rule :eom-no-leap-day) (ymd->date 2020 2 28))
(= 0 (diff-days (ymd->date 2007 2 3 10 35 42) (ymd->date 2007 2 3 11 30 20)))
(= 2 (diff-days (ymd->date 2008 2 28 10 35 42) (ymd->date 2008 3 1 11 30 20)))
(= 366 (diff-days (ymd->date 2008 1 1 10 35 42) (ymd->date 2009 1 1 11 30 20)))
(= 365 (diff-days (ymd->date 2007 1 1 10 35 42) (ymd->date 2008 1 1 11 30 20)))))
(deftest date-arith-360 ()
(let ((test-cases
;; Start date End Date Bond Basis 30E/360 30E/360 ISDA Act/360
'(("2007-01-15" "2007-01-30" 0.041666667 0.041666667 0.041666667 0.041666667)
("2007-01-15" "2007-02-15" 0.083333333 0.083333333 0.083333333 0.086111111)
("2007-01-15" "2007-07-15" 0.5 0.5 0.5 0.502777778)
("2007-09-30" "2008-03-31" 0.5 0.5 0.5 0.508333333)
("2007-09-30" "2007-10-31" 0.083333333 0.083333333 0.083333333 0.086111111)
("2007-09-30" "2008-09-30" 1 1 1 1.016666667)
("2007-01-15" "2007-01-31" 0.044444444 0.041666667 0.041666667 0.044444444)
("2007-01-31" "2007-02-28" 0.077777778 0.077777778 0.083333333 0.077777778)
("2007-02-28" "2007-03-31" 0.091666667 0.088888889 0.083333333 0.086111111)
("2006-08-31" "2007-02-28" 0.494444444 0.494444444 0.5 0.502777778)
("2007-02-28" "2007-08-31" 0.508333333 0.505555556 0.5 0.511111111)
("2007-02-14" "2007-02-28" 0.038888889 0.038888889 0.044444444 0.038888889)
("2007-02-26" "2008-02-29" 1.008333333 1.008333333 1.011111111 1.022222222)
("2008-02-29" "2009-02-28" 0.997222222 0.997222222 0.994444444 1.013888889)
("2008-02-29" "2008-03-30" 0.086111111 0.086111111 0.083333333 0.083333333)
("2008-02-29" "2008-03-31" 0.088888889 0.086111111 0.083333333 0.086111111)
("2007-02-28" "2007-03-05" 0.019444444 0.019444444 0.013888889 0.013888889)
("2007-10-31" "2007-11-28" 0.077777778 0.077777778 0.077777778 0.077777778)
("2007-08-31" "2008-02-29" 0.497222222 0.497222222 0.5 0.505555556)
("2008-02-29" "2008-08-31" 0.505555556 0.502777778 0.5 0.511111111)
("2008-08-31" "2009-02-28" 0.494444444 0.494444444 0.494444444 0.502777778)
("2009-02-28" "2009-08-31" 0.508333333 0.505555556 0.5 0.511111111)))
(term-date (ymd->date 2009 2 28)))
(labels ((a= (a b)
(< (abs (- a b)) 0.000001)))
(combine-results
(loop for test in test-cases
collect (let ((d1 (string->date (first test)))
(d2 (string->date (second test)))
(bond-basis (third test))
(euro-basis (fourth test))
(german (fifth test))
(actual (sixth test)))
(check
(a= (diff-years d1 d2 :30a-360) bond-basis)
(a= (diff-years d1 d2 :30e-360) euro-basis)
(a= (diff-years d1 d2 :30e-360-isda :termination-date term-date) german)
(a= (diff-years d1 d2 :act-360) actual))))))))
(deftest date-arith-act-act ()
(let ((test-cases
(list
;; Start End Date F LC AFB ISDA ISMA
(list "2003-11-01" "2004-05-01" 2 nil 182/366 (+ 61/365 121/366) (/ 182 (* 2 182)))
(list "1999-02-01" "1999-07-01" 1 nil 150/365 150/365 (/ 150 (* 1 365)))
(list "1999-07-01" "2000-07-01" 1 nil 1 (+ 184/365 182/366) (/ 366 (* 1 366)))
(list "2002-08-15" "2003-07-15" 2 nil 334/365 334/365 (+ (/ 181 (* 2 181))
(/ 153 (* 2 184))))
(list "2003-07-15" "2004-01-15" 2 nil 184/365 (+ 170/365 14/366) (/ 184 (* 2 184)))
(list "1999-07-30" "2000-01-30" 2 t 184/365 (+ 155/365 29/366) (/ 184 (* 2 184)))
(list "2000-01-30" "2000-06-30" 2 t 152/366 152/366 (/ 152 (* 2 182)))
(list "1999-11-30" "2000-04-30" 4 t 152/366 (+ 32/365 120/366) (+ (/ 91 (* 4 91))
(/ 61 (* 4 92)))))))
(combine-results
(loop for test in test-cases
collect (let ((d1 (string->date (first test)))
(d2 (string->date (second test)))
(freq (third test))
(last-cpn (fourth test))
(afb (fifth test))
(isda (sixth test))
(isma (seventh test)))
(check
(= (diff-years d1 d2 :act-act-afb) afb)
(= (diff-years d1 d2 :act-act) isda)
(= (diff-years d1 d2 :act-act-isma :frequency freq :is-last-coupon last-cpn) isma)))))))
(deftest bus-date-arith ()
(let ((cal (make-calendar :jpy :base-year 2017)))
(check
(= 245 (workday-number (ymd->date 2016 12 31) cal))
(= 20 (workday-number (ymd->date 2017 2 1) cal))
(= 247 (workday-number (ymd->date 2017 12 31) cal))
(date= (ymd->date 2017 1 4) (next-workday (ymd->date 2016 12 31) cal))
(date= (ymd->date 2016 5 2) (next-workday (ymd->date 2016 4 28) cal))
(date= (ymd->date 2017 5 8) (next-workday (ymd->date 2017 5 2) cal))
(date= (ymd->date 2016 12 30) (prev-workday (ymd->date 2017 1 4) cal))
(date= (ymd->date 2017 4 28) (prev-workday (ymd->date 2017 5 1) cal))
(date= (ymd->date 2017 5 2) (prev-workday (ymd->date 2017 5 8) cal))
(date= (ymd->date 2018 1 4) (add-workdays (ymd->date 2017 1 1) cal 248))
(date= (ymd->date 2017 2 1) (add-workdays (ymd->date 2017 1 1) cal 20))
(= 20 (diff-workdays (ymd->date 2017 1 1) (ymd->date 2017 2 1) cal))
(= 247 (diff-workdays (ymd->date 2017 1 1) (ymd->date 2017 12 31) cal))
(= 247 (diff-workdays (ymd->date 2018 1 4) (ymd->date 2017 1 4) cal))
(date= (ymd->date 2016 5 2) (first-workday-of-month (ymd->date 2016 5 10) cal))
(date= (ymd->date 2017 4 28) (last-workday-of-month (ymd->date 2017 4 1) cal))
(date= (ymd->date 2017 4 28) (last-workday-of-prev-month (ymd->date 2017 5 10) cal))
(date= (ymd->date 2016 5 2) (adjust-date (ymd->date 2016 4 30) cal :following))
(date= (ymd->date 2016 4 28) (adjust-date (ymd->date 2016 4 30) cal :modified-following))
(date= (ymd->date 2016 4 28) (adjust-date (ymd->date 2016 4 30 1) cal :preceding)))))
(deftest schedule-generation ()
(let ((target-cal (make-calendar :target :base-year 2002))
(japan-cal (make-calendar :japan :base-year 2009))
(bond-cal (make-calendar :us-bond :base-year 1996)))
(check
;; Adjusted maturity date with month-end roll
(equal (mapcar #'date->string (generate-schedule (ymd->date 2009 9 30) (ymd->date 2012 6 15)
6 japan-cal :rule :normal-front
:roll-convention :following
:maturity-roll :following
:eom-rule :eom-normal))
(list "2009-09-30" "2010-03-31" "2010-09-30" "2011-03-31" "2011-09-30"
"2012-03-30" "2012-06-29"))
;; same as above with unadjusted maturity
(equal (mapcar #'date->string (generate-schedule (ymd->date 2009 9 30) (ymd->date 2012 6 15)
6 japan-cal :rule :normal-front
:roll-convention :following
:maturity-roll nil
:eom-rule :eom-normal))
(list "2009-09-30" "2010-03-31" "2010-09-30" "2011-03-31" "2011-09-30"
"2012-03-30" "2012-06-15"))
;; Coupon date of 2015/3/31 (after EOM adjustment) is dropped because it is beyond maturity
(equal (mapcar #'date->string (generate-schedule (ymd->date 2013 3 28) (ymd->date 2015 3 30)
12 target-cal :rule :normal-front
:roll-convention nil
:maturity-roll nil
:eom-rule :eom-normal))
(list "2013-03-28" "2014-03-31" "2015-03-30"))
;; Coupon date of 2015/3/31 (after EOM adjustment) is dropped because it is equal to maturity
(equal (mapcar #'date->string (generate-schedule (ymd->date 2013 3 28) (ymd->date 2015 3 31)
12 target-cal :rule :normal-front
:roll-convention nil
:maturity-roll nil
:eom-rule :eom-normal))
(list "2013-03-28" "2014-03-31" "2015-03-31"))
(equal (mapcar #'date->string (generate-schedule (ymd->date 1996 8 31) (ymd->date 1997 9 15)
6 bond-cal :rule :normal-front
:roll-convention nil
:maturity-roll nil
:eom-rule :eom-normal))
(list "1996-08-31" "1997-02-28" "1997-08-31" "1997-09-15"))
(equal (mapcar #'date->string (generate-schedule (ymd->date 1996 8 22) (ymd->date 1997 8 31)
6 bond-cal :rule :normal-back
:roll-convention nil
:maturity-roll nil
:eom-rule :eom-normal))
(list "1996-08-22" "1996-08-31" "1997-02-28" "1997-08-31"))
(equal (mapcar #'date->string (generate-schedule (ymd->date 1996 8 22) (ymd->date 1997 8 31)
6 bond-cal :rule :normal-back
:roll-convention :following
:maturity-roll :following
:eom-rule :eom-normal))
(list "1996-08-22" "1996-08-30" "1997-02-28" "1997-08-29"))
(equal (mapcar #'date->string (generate-schedule (ymd->date 2016 12 12) (ymd->date 2021 12 12)
3 japan-cal :rule :cds-dates
:roll-convention :modified-following
:maturity-roll nil
:eom-rule nil))
(list "2016-09-20" "2016-12-20" "2017-03-21" "2017-06-20" "2017-09-20" "2017-12-20"
"2018-03-20" "2018-06-20" "2018-09-20" "2018-12-20" "2019-03-20" "2019-06-20"
"2019-09-20" "2019-12-20" "2020-03-23" "2020-06-22" "2020-09-23" "2020-12-21"
"2021-03-22" "2021-06-21" "2021-09-21" "2021-12-20")))))

98
test/test-hols.lisp Normal file
View file

@ -0,0 +1,98 @@
;;; Copyright (c) 2017, Sudhir Shenoy. All rights reserved.
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :cl-dates-test)
(defparameter +holiday-tests+
'(;; US settlement holidays
(:usd (2004 2005) ("1 January 2004" "19 January 2004" "16 February 2004" "31 May 2004"
"5 July 2004" "6 September 2004" "11 October 2004" "11 November 2004"
"25 November 2004" "24 December 2004" "31 December 2004"
"17 January 2005" "21 February 2005" "30 May 2005" "4 July 2005"
"5 September 2005" "10 October 2005" "11 November 2005"
"24 November 2005" "26 December 2005"))
;; US settlement - before Uniform Monday Holiday Act
(:usd (1961 1961) ("2 January 1961" "22 February 1961" "30 May 1961" "4 July 1961"
"4 September 1961" "10 November 1961" "23 November 1961"
"25 December 1961"))
;; US Bond market
(:ust (2004 2004) ("1 January 2004" "19 January 2004" "16 February 2004" "9 April 2004"
"31 May 2004" "5 July 2004" "6 September 2004" "11 October 2004"
"11 November 2004" "25 November 2004" "24 December 2004"))
;; NY Stock exchange
(:nyse (2004 2006) ("1 January 2004" "19 January 2004" "16 February 2004" "9 April 2004"
"31 May 2004" "11 June 2004" "5 July 2004" "6 September 2004"
"25 November 2004" "24 December 2004"
"17 January 2005" "21 February 2005" "25 March 2005" "30 May 2005"
"4 July 2005" "5 September 2005" "24 November 2005" "26 December 2005"
"2 January 2006" "16 January 2006" "20 February 2006" "14 April 2006"
"29 May 2006" "4 July 2006" "4 September 2006" "23 November 2006"
"25 December 2006"))
;; TARGET
(:target (1999 2002) ("1 January 1999" "31 December 1999"
"21 April 2000" "24 April 2000" "1 May 2000" "25 December 2000"
"26 December 2000"
"1 January 2001" "13 April 2001" "16 April 2001" "1 May 2001"
"25 December 2001" "26 December 2001" "31 December 2001"
"1 January 2002" "29 March 2002" "1 April 2002" "1 May 2002"
"25 December 2002" "26 December 2002"))
(:target (2003 2006) ("1 January 2003" "18 April 2003" "21 April 2003" "1 May 2003"
"25 December 2003" "26 December 2003"
"1 January 2004" "9 April 2004" "12 April 2004"
"25 March 2005" "28 March 2005" "26 December 2005"
"14 April 2006" "17 April 2006" "1 May 2006" "25 December 2006"
"26 December 2006"))
;; EUREX
(:eurex (2003 2004) ("1 January 2003" "18 April 2003" "21 April 2003" "1 May 2003"
"24 December 2003" "25 December 2003" "26 December 2003" "31 December 2003"
"1 January 2004" "9 April 2004" "12 April 2004" "24 December 2004"
"31 December 2004"))
;; UK
(:gbp (2004 2007) ("1 January 2004" "9 April 2004" "12 April 2004" "3 May 2004" "31 May 2004"
"30 August 2004" "27 December 2004" "28 December 2004"
"3 January 2005" "25 March 2005" "28 March 2005" "2 May 2005" "30 May 2005"
"29 August 2005" "26 December 2005" "27 December 2005"
"2 January 2006" "14 April 2006" "17 April 2006" "1 May 2006" "29 May 2006"
"28 August 2006" "25 December 2006" "26 December 2006"
"1 January 2007" "6 April 2007" "9 April 2007" "7 May 2007" "28 May 2007"
"27 August 2007" "25 December 2007" "26 December 2007"))))
(deftest holiday-tests ()
(combine-results
(loop for test-case in +holiday-tests+
collect (destructuring-bind (centre year-range dates) test-case
(setf dates (mapcar #'jday-number (mapcar #'string->date dates)))
(let* ((from-year (car year-range))
(start-range (ymd->date from-year 1 1))
(end-range (ymd->date (cadr year-range) 12 31))
(cal (make-calendar centre :base-year from-year))
(hols (sort (loop for dt being the
hash-keys in (cl-dates::holidays cal)
when (date<= start-range dt end-range)
collect dt)
#'date<)))
(check
(equal hols dates)))))))

93
test/test-main.lisp Normal file
View file

@ -0,0 +1,93 @@
;;; Copyright (c) 2017, Sudhir Shenoy. All rights reserved.
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :cl-user)
(defpackage :cl-dates-test
(:use :common-lisp :cl-dates)
(:export :run-all-tests))
(in-package :cl-dates-test)
;;;
;;; Peter Siebel's test framework from Practical Common Lisp with
;;; slight modifications
;;;
(defvar *test-name* nil)
(defvar *verbose-results* nil)
(defvar *total-tests* 0)
(defvar *failed-tests* 0)
(defmacro deftest (name parameters &body body)
"Define a test function. Within a test function we can call
other test functions or use 'check' to run individual test
cases."
`(defun ,name ,parameters
(let ((*test-name* (append *test-name* (list ',name))))
(format t "~a ... from test #~d~%" *test-name* (1+ *total-tests*))
,@body)))
(defmacro check (&body forms)
"Run each expression in 'forms' as a test case."
`(combine-results
,@(loop for f in forms collect `(report-result ,f ',f))))
(defun combine-results (&rest exprs)
"Combine the results (as booleans) of evaluating 'exprs' in order."
(every #'identity exprs))
(defun report-result (result form)
"Report the results of a single test case. Called by 'check'."
(incf *total-tests*)
(when (not result)
(incf *failed-tests*))
(if *verbose-results*
(format t "#~d: ~:[FAIL~;pass~] ... ~a: ~a~%" *total-tests* result *test-name* form)
(when (not result)
(format t "#~d: FAIL ... ~a: ~a~%" *total-tests* *test-name* form)))
result)
(defun run-all-tests (&key (verbose nil))
(let* ((*total-tests* 0)
(*failed-tests* 0)
(*verbose-results* verbose)
(status (combine-results
(julian)
(misc-fns)
(special-dates)
(date-arith)
(date-arith-360)
(date-arith-act-act)
(print-fns)
(parse-dates)
(holiday-tests)
(bus-date-arith)
(schedule-generation))))
(unless (zerop *total-tests*)
(format t "~d tests executed - ~d passed (~,2f%)~%"
*total-tests* (- *total-tests* *failed-tests*)
(/ (* 100 (- *total-tests* *failed-tests*)) *total-tests*)))
status))

206
test/test-parse-date.lisp Normal file
View file

@ -0,0 +1,206 @@
;;; Copyright (c) 2017, Sudhir Shenoy. All rights reserved.
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
(in-package :cl-dates-test)
;; Rounding errors in fractional seconds when changing timezones require
;; testing for approximate equality in some test cases
(defparameter +max-error+ 1/1000000)
(defun a= (a b)
(< (abs (- a b)) +max-error+))
(deftest parse-dates ()
(let ((dt (ymd->date 2003 9 25 1 36 28)))
(check
;; Fully specified date with time and timezone
(= (string->date "Thu Sep 25 10:36:28 JST 2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(null (string->date "Wed Sep 25 10:36:28 JST 2003" :reference-date dt)) ; day of week doesn't match date
(= (string->date "2003 10:36:28 JST 25 Sep Thu" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "Thu, 25 Sep 2003 10:36:28 JST" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "Thu, 25 Sep 2003 10:36:28 +0900" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "2003-09-25T10:49:41-03:00" :reference-date dt) (ymd->date 2003 9 25 13 49 41))
(a= (string->date "2003-09-25T10:49:41.5-03:00" :reference-date dt) (ymd->date 2003 9 25 13 49 41.5))
(= (string->date "20030925T10:49:41-03:00" :reference-date dt) (ymd->date 2003 9 25 13 49 41))
(a= (string->date "20030925T10:49:41.5-03:00" :reference-date dt) (ymd->date 2003 9 25 13 49 41.5))
;; Partially specified dates (alphanumeric)
(= (string->date "Thu Sep 25 10:36:28 2003" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "Thu Sep 25 10:36:28" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "Thu Sep 10:36:28" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "Thu 10:36:28" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "Sep 10:36:28" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "10:36:28" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "10:36" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "Thu Sep 25 2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "Sep 25 2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "Sep 2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "Sep" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "2003-09-25T10:49:41" :reference-date dt) (ymd->date 2003 9 25 10 49 41))
(= (string->date "2003-09-25T10:49" :reference-date dt) (ymd->date 2003 9 25 10 49 28))
(= (string->date "2003-09-25T10" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "2003-09-25" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "20030925T104941" :reference-date dt) (ymd->date 2003 9 25 10 49 41))
(= (string->date "20030925T1049" :reference-date dt) (ymd->date 2003 9 25 10 49 28))
(= (string->date "20030925T10" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "20030925T10:49:41" :reference-date dt) (ymd->date 2003 9 25 10 49 41))
(= (string->date "20030925T10:49" :reference-date dt) (ymd->date 2003 9 25 10 49 28))
(= (string->date "20030925T10" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "20030925" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
;; Partially specified (numeric with possible alphabetic month name
(= (string->date "19970902090807" :reference-date dt) (ymd->date 1997 9 2 9 8 7))
(= (string->date "199709020908" :reference-date dt) (ymd->date 1997 9 2 9 8 28))
(= (string->date "2003-Sep-25" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "25-Sep-2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "Sep-25-2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "09-25-2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28)) ; no ambiguity because 25 is a day
(= (string->date "25-09-2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28)) ; no ambiguity because 25 is a day
(= (string->date "10-09-2003" :precedence :dmy :reference-date dt)
(ymd->date 2003 9 10 1 36 28)) ; explicitly dd/mm/yy
(= (string->date "10-09-2003" :precedence :mdy :reference-date dt)
(ymd->date 2003 10 9 1 36 28)) ; explicitly mm/dd/yy
(= (string->date "10-09-03" :precedence :mdy :reference-date dt)
(ymd->date 2003 10 9 1 36 28)) ; explicitly mm/dd/yy
(= (string->date "10-09-03" :precedence :ymd :reference-date dt)
(ymd->date 2010 9 3 1 36 28)) ; explicitly yy/mm/dd
(= (string->date "2003.09.25" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "2003.Sep.25" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "25.Sep.2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "09.25.2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "25.09.2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "2003/09/25" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "2003/Sep/25" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "25/Sep/2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "09/25/2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "25/09/2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "10.09.2003" :precedence :dmy :reference-date dt)
(ymd->date 2003 9 10 1 36 28)) ; explicitly dd/mm/yy
(= (string->date "10.09.2003" :precedence :mdy :reference-date dt)
(ymd->date 2003 10 9 1 36 28)) ; explicitly mm/dd/yy
(= (string->date "10.09.03" :precedence :dmy :reference-date dt)
(ymd->date 2003 9 10 1 36 28)) ; explicitly dd/mm/yy
(= (string->date "10.09.03" :precedence :mdy :reference-date dt)
(ymd->date 2003 10 9 1 36 28)) ; explicitly mm/dd/yy
(= (string->date "10/09/2003" :precedence :dmy :reference-date dt)
(ymd->date 2003 9 10 1 36 28)) ; explicitly dd/mm/yy
(= (string->date "10/09/2003" :precedence :mdy :reference-date dt)
(ymd->date 2003 10 9 1 36 28)) ; explicitly mm/dd/yy
(= (string->date "10/09/03" :precedence :dmy :reference-date dt)
(ymd->date 2003 9 10 1 36 28)) ; explicitly dd/mm/yy
(= (string->date "10/09/03" :precedence :mdy :reference-date dt)
(ymd->date 2003 10 9 1 36 28)) ; explicitly mm/dd/yy
(null (string->date "2003/25/Sep" :reference-date dt)) ; invalid - yy/dd/MMM
(= (string->date "2003 09 25" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "2003 Sep 25" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "2003 25 Sep" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "25 Sep 2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "Sep 25 2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "09 25 2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "25 09 2003" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "10 09 2003" :precedence :dmy :reference-date dt)
(ymd->date 2003 9 10 1 36 28)) ; explicitly dd/mm/yy
(= (string->date "10 09 2003" :precedence :mdy :reference-date dt)
(ymd->date 2003 10 9 1 36 28)) ; explicitly mm/dd/yy
(= (string->date "10 09 03" :precedence :dmy :reference-date dt)
(ymd->date 2003 9 10 1 36 28)) ; explicitly dd/mm/yy
(= (string->date "10 09 03" :precedence :mdy :reference-date dt)
(ymd->date 2003 10 9 1 36 28)) ; explicitly mm/dd/yy
(= (string->date "03 25 Sep" :reference-date dt)
(ymd->date 2003 9 25 1 36 28)) ; default is yy/mm/dd
(= (string->date "25 03 Sep" :precedence :dmy :reference-date dt)
(ymd->date 2003 9 25 1 36 28)) ; explicitly day before year
;; Assorted time formats
(a= (string->date "10h16m38.5s" :reference-date dt) (ymd->date 2003 9 25 10 16 38.5))
(= (string->date "10h16m38s" :reference-date dt) (ymd->date 2003 9 25 10 16 38))
(a= (string->date "10h16m" :reference-date dt) (ymd->date 2003 9 25 10 16 28))
(= (string->date "10h" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(a= (string->date "10 h 16" :reference-date dt) (ymd->date 2003 9 25 10 16 28))
(= (string->date "10h am" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "10h pm" :reference-date dt) (ymd->date 2003 9 25 22 36 28))
(= (string->date "10 am" :reference-date dt) (ymd->date 2003 9 25 10 36 28))
(= (string->date "10 pm" :reference-date dt) (ymd->date 2003 9 25 22 36 28))
(= (string->date "10:00 am" :reference-date dt) (ymd->date 2003 9 25 10 0 28))
(= (string->date "10:00 pm" :reference-date dt) (ymd->date 2003 9 25 22 0 28))
(= (string->date "10:00am" :reference-date dt) (ymd->date 2003 9 25 10 0 28))
(= (string->date "10:00pm" :reference-date dt) (ymd->date 2003 9 25 22 0 28))
(= (string->date "10:00a.m." :reference-date dt) (ymd->date 2003 9 25 10 0 28))
(= (string->date "10:00p.m." :reference-date dt) (ymd->date 2003 9 25 22 0 28))
(= (string->date "10:00a.m" :reference-date dt) (ymd->date 2003 9 25 10 0 28))
(= (string->date "10:00p.m" :reference-date dt) (ymd->date 2003 9 25 22 0 28))
;; relative dates etc
(= (string->date "Sep 03" :reference-date dt) (ymd->date 2003 9 3 1 36 28))
(= (string->date "Sep of 03" :reference-date dt) (ymd->date 2003 9 25 1 36 28))
(= (string->date "Wed" :reference-date dt) (ymd->date 2003 9 24 1 36 28))
(= (string->date "Wednesday" :reference-date dt) (ymd->date 2003 9 24 1 36 28))
(= (string->date "last Wednesday" :reference-date dt) (ymd->date 2003 9 24 1 36 28))
(= (string->date "next Wednesday" :reference-date dt) (ymd->date 2003 10 1 1 36 28))
(= (string->date "October" :reference-date dt) (ymd->date 2003 10 25 1 36 28))
(= (string->date "31-Dec-00" :precedence :dmy :reference-date dt)
(ymd->date 2000 12 31 1 36 28))
;; Random verbiage / unusual formats
(= (string->date "The date is the 25th of September of 2003, exactly at 10:49:41 with time zone -03:00"
:reference-date dt) (ymd->date 2003 9 25 13 49 41))
(null (string->date "Today is the 25th of September of 2003, exactly at 10:49:41 with time zone -03:00"
:reference-date dt)) ; 'today' is assumed to be a date spec so a duplicate date is detected
(= (string->date " July 4 , 1976 12:01:02 am " :reference-date dt)
(ymd->date 1976 7 4 0 1 2))
(= (string->date "today 12:35" :reference-date dt) (ymd->date 2003 9 25 12 35 28))
(= (string->date "today 12:35 JST" :reference-date dt) (ymd->date 2003 9 25 3 35 28))
(= (string->date "tomorrow 12:35" :reference-date dt) (ymd->date 2003 9 26 12 35 28))
(= (string->date "yesterday 12:35 am JST" :reference-date dt) (ymd->date 2003 9 23 15 35 28)) ; date is 2 days prior in UTC
(= (string->date "Wed Jul 10, '96" :reference-date dt) (ymd->date 1996 7 10 1 36 28))
(a= (string->date "1996.07.10 AD at 15:08:56 PDT" :reference-date dt) (ymd->date 1996 7 10 22 8 56))
(= (string->date "1996.07.10 AD at 12:08 PM" :reference-date dt) (ymd->date 1996 7 10 12 8 28))
(= (string->date "Saturday, April 12, 1952 AD 3:30:42pm PST" :reference-date dt) (ymd->date 1952 4 12 23 30 42))
(= (string->date "November 5, 1994, 8:15:30 am EST" :reference-date dt) (ymd->date 1994 11 5 13 15 30))
(= (string->date "1994-11-05T08:15:30-05:00" :reference-date dt) (ymd->date 1994 11 5 13 15 30))
(= (string->date "1994-11-05T08:15:30Z" :reference-date dt) (ymd->date 1994 11 5 8 15 30))
(= (string->date "0:01:02" :reference-date dt) (ymd->date 2003 9 25 0 1 2))
(= (string->date "12h 01m02s am" :reference-date dt) (ymd->date 2003 9 25 0 1 2))
(= (string->date "0:01:02 on July 4, 1976" :reference-date dt) (ymd->date 1976 7 4 0 1 2))
(null (string->date "July 4, 1976 pm 12:01:02" :reference-date dt)) ; am/pm must come after time spec
(= (string->date "July 4, 4pm 4:01:02" :reference-date dt)
(ymd->date 2003 7 4 4 1 2)) ; 4pm overridden by 4:01:02
(= (string->date "July 4, 4pm" :reference-date dt) (ymd->date 2003 7 4 16 36 28)) ; this is ok
(a= (string->date "04.04.95 00:22" :reference-date dt) (ymd->date 1995 4 4 0 22 28))
(= (string->date "950404 122212" :reference-date dt) (ymd->date 1995 4 4 12 22 12))
(= (string->date "0:00 PM, PST" :reference-date dt) (ymd->date 2003 9 25 20 0 28))
(= (string->date "12:08 PM" :reference-date dt) (ymd->date 2003 9 25 12 8 28))
(= (string->date "5:50 A.M on June 13, 1990" :reference-date dt) (ymd->date 1990 6 13 5 50 28))
(= (string->date "01h02m03" :reference-date dt) (ymd->date 2003 9 25 1 2 3))
(= (string->date "01h02" :reference-date dt) (ymd->date 2003 9 25 1 2 28))
(= (string->date "01h02s" :reference-date dt) (ymd->date 2003 9 25 1 36 2))
(= (string->date "01m02" :reference-date dt) (ymd->date 2003 9 25 1 1 2))
(a= (string->date "01m02h" :reference-date dt) (ymd->date 2003 9 25 2 1 28))
(= (string->date "2004 10 April 11h30m" :reference-date dt) (ymd->date 2004 4 10 11 30 28))
;; The next one works coincidentally because Japanese uses a y/m/d format by default.
;; However, it demonstrates that as long as date components are present, the presence
;; of extraneous characters does not matter
(= (string->date "2004年8月9日 17:30:22" :reference-date dt) (ymd->date 2004 8 9 17 30 22)))))