From 28604b19d45d402f23f1e7245a62ff02856062b8 Mon Sep 17 00:00:00 2001 From: Sudhir Shenoy Date: Sat, 15 Jul 2017 08:40:05 +0900 Subject: [PATCH] Added tests for day convention arithmetic and other miscellaneous functions --- test-dates.lisp | 255 +++++++++++++++++++++++++------------------ test-main.lisp | 23 ++-- test-parse-date.lisp | 7 +- 3 files changed, 163 insertions(+), 122 deletions(-) diff --git a/test-dates.lisp b/test-dates.lisp index 887b4dd..e50a6c3 100644 --- a/test-dates.lisp +++ b/test-dates.lisp @@ -27,107 +27,145 @@ (in-package :cl-dates-test) (deftest julian () - (format t "Julian date conversions ...~%") (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))) + (= (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 () - (format t "Miscellaneous date functions ...~%") (check - (valid-date-p 2000 2 29) - (null (valid-date-p 1900 2 29)) - (null (valid-date-p 1234 65 789)) - - (eq :monday (day-of-week (ymd->date 2017 2 6))) - (eq :wednesday (day-of-week (ymd->date 1959 9 23))) + (valid-date-p 2000 2 29) + (null (valid-date-p 1900 2 29)) + (null (valid-date-p 1234 65 789)) - (= (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)))) + (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)) + + (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 () - (format t "Conversions to strings ...~%") (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= (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= (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 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")))) + (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 () - (format t "Computation of 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)) + (= (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)))) + (= (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 () - (format t "Checking 30/360 and Actual/360 day basis computations~%") (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) @@ -153,22 +191,22 @@ ("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))) - (dolist (test test-cases) - (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))))))) + (< (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 () - (format t "Checking Actual/Actual day basis computations~%") (let ((test-cases (list ;; Start End Date F LC AFB ISDA ISMA @@ -182,15 +220,16 @@ (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))))))) - (dolist (test test-cases) - (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)))))) + (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))))))) diff --git a/test-main.lisp b/test-main.lisp index 788c427..79bbdc0 100644 --- a/test-main.lisp +++ b/test-main.lisp @@ -47,6 +47,7 @@ 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) @@ -54,12 +55,9 @@ `(combine-results ,@(loop for f in forms collect `(report-result ,f ',f)))) -(defmacro combine-results (&body forms) - "Combine the results (as booleans) of evaluating 'forms' in order." - (let ((result (gensym))) - `(let ((,result t)) - ,@(loop for f in forms collect `(unless ,f (setf ,result nil))) - ,result))) +(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'." @@ -67,19 +65,20 @@ (when (not result) (incf *failed-tests*)) (if *verbose-results* - (format t "~:[FAIL~;pass~] ... ~a: ~a~%" result *test-name* form) + (format t "#~d: ~:[FAIL~;pass~] ... ~a: ~a~%" *total-tests* result *test-name* form) (when (not result) - (format t "FAIL ... ~a: ~a~%" *test-name* form))) + (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 + (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) diff --git a/test-parse-date.lisp b/test-parse-date.lisp index b869d58..473cc1e 100644 --- a/test-parse-date.lisp +++ b/test-parse-date.lisp @@ -33,7 +33,6 @@ (< (abs (- a b)) +max-error+)) (deftest parse-dates () - (format t "Parse dates from strings ...~%") (let ((dt (ymd->date 2003 9 25 1 36 28))) (check ;; Fully specified date with time and timezone @@ -200,4 +199,8 @@ (= (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))))) + (= (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日") (ymd->date 2004 8 9)))))