diff options
Diffstat (limited to 'tests')
| -rwxr-xr-x | tests/run-tests.scm | 42 | ||||
| -rw-r--r-- | tests/test/datetime.scm | 20 | ||||
| -rw-r--r-- | tests/test/let.scm | 45 | ||||
| -rw-r--r-- | tests/test/server.scm | 8 | ||||
| -rw-r--r-- | tests/test/timespec.scm | 88 | ||||
| -rw-r--r-- | tests/test/web-server.scm | 58 | ||||
| -rw-r--r-- | tests/test/zic.scm | 317 |
7 files changed, 476 insertions, 102 deletions
diff --git a/tests/run-tests.scm b/tests/run-tests.scm index 008090d0..b0cd4882 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -51,19 +51,22 @@ fi (define (yellow s) (escaped 33 s)) (define (bold s) (escaped 1 s)) -;;; TODO handle nested grups in a better fassion +(define (make-indent depth) + (make-string (* 2 depth) #\space)) (define (construct-test-runner) (define runner (test-runner-null)) + (define depth 0) ;; end of individual test case (test-runner-on-test-begin! runner (lambda (runner) (test-runner-aux-value! runner (transform-time-of-day (gettimeofday))))) (test-runner-on-test-end! runner (lambda (runner) + (when (verbose?) (display (make-indent depth))) (case (test-result-kind runner) ((pass) (display (green "X"))) - ((fail) (newline) (display (red "E"))) + ((fail) (display (red "E"))) ((xpass) (display (yellow "X"))) ((xfail) (display (yellow "E"))) ((skip) (display (yellow "-")))) @@ -75,15 +78,19 @@ fi => (lambda (p) (with-output-to-string (lambda () (display (bold "[SOURCE]: ")) (truncated-print p)))))))) (when (eq? 'fail (test-result-kind)) (cond ((test-result-ref runner 'actual-error) - => (lambda (err) (format #t "Error: ~s~%" err))) + => (lambda (err) (format #t "~aError: ~s~%" (make-indent (1+ depth)) err))) (else - (format #t "Expected: ~s~%Received: ~s~%" - (test-result-ref runner 'expected-value "[UNKNOWN]") - (test-result-ref runner 'actual-value "[UNKNOWN]")))) - (format #t "Near ~a:~a~%~y" + (format #t "~aExpected: ~s~%~aReceived: ~s~%" + (make-indent (1+ depth)) (test-result-ref runner 'expected-value "[UNKNOWN]") + (make-indent (1+ depth)) (test-result-ref runner 'actual-value "[UNKNOWN]")))) + (format #t "~aNear ~a:~a~%" + (make-indent (1+ depth)) (test-result-ref runner 'source-file) - (test-result-ref runner 'source-line) - (test-result-ref runner 'source-form))) + (test-result-ref runner 'source-line)) + (pretty-print (test-result-ref runner 'source-form) + (current-output-port) + per-line-prefix: (string-append (make-indent (1+ depth)) "> ") + )) (let ((start (test-runner-aux-value runner)) (end (transform-time-of-day (gettimeofday)))) @@ -97,12 +104,19 @@ fi (test-runner-on-group-begin! runner ;; count is number of #f (lambda (runner name count) - (format #t "~a ~a ~a~%" - (make-string 10 #\=) - name - (make-string 10 #\=)))) + (if (<= depth 1) + (format #t "~a ~a ~a~%" + (make-string 10 #\=) + name + (make-string 10 #\=)) + (when (verbose?) + (format #t "~a~a~%" (make-string (* depth 2) #\space) name))) + (set! depth (1+ depth)))) (test-runner-on-group-end! runner - (lambda (runner) (newline))) + (lambda (runner) + (set! depth (1- depth)) + (when (<= depth 1) + (newline)))) ;; after everything else is done (test-runner-on-final! runner (lambda (runner) diff --git a/tests/test/datetime.scm b/tests/test/datetime.scm index 3435aad6..d646052d 100644 --- a/tests/test/datetime.scm +++ b/tests/test/datetime.scm @@ -5,12 +5,12 @@ (define-module (test datetime) :use-module (srfi srfi-64) + :use-module (srfi srfi-71) :use-module (srfi srfi-88) :use-module ((srfi srfi-41) :select (stream->list stream-take)) :use-module (datetime) :use-module ((ice-9 format) :select (format)) - :use-module ((hnh util) :select (let*)) :use-module ((ice-9 i18n) :select (make-locale)) :use-module ((guile) :select (LC_CTYPE LC_TIME))) @@ -164,18 +164,18 @@ (date day: 4) (date day: 5))) -(let* ((diff overflow - (time- #10:20:30 - #10:20:30))) +(let ((diff overflow + (time- #10:20:30 + #10:20:30))) (test-equal "time- self" #00:00:00 diff) (test-equal "time- self overflow" 0 overflow)) -(let* ((diff overflow - (time- #10:00:00 - #10:00:01))) +(let ((diff overflow + (time- #10:00:00 + #10:00:01))) (test-equal "time- overflow 1s" #23:59:59 @@ -185,9 +185,9 @@ 1 overflow)) -(let* ((diff overflow - (time- #10:00:00 - (time hour: (+ 48 4))))) +(let ((diff overflow + (time- #10:00:00 + (time hour: (+ 48 4))))) (test-equal "time- overflow multiple" #06:00:00 diff --git a/tests/test/let.scm b/tests/test/let.scm deleted file mode 100644 index 5312409e..00000000 --- a/tests/test/let.scm +++ /dev/null @@ -1,45 +0,0 @@ -;;; Commentary: -;; Tests my custom let*. -;;; Code: - -(define-module (test let) - :use-module (srfi srfi-64) - :use-module (srfi srfi-88) - :use-module ((hnh util) :select (let*))) - -(test-assert (let* ((a #t)) a)) - -(test-assert (let* (((a . b) (cons #t #f))) a)) - -(test-assert (let* (((a . b) (cons* #f #t))) b)) - -(test-assert - (let* ((a b c (values #f #t #f))) b)) - -(test-assert - (let* (((a b c) (list #f #t #f))) b)) - -(test-assert (let* (((a) '(#t))) a)) - -(test-equal '(2) (let* (((a . b) '(1 2))) b)) - -(test-equal - '(3 4) - (let* (((a b . c) '(1 2 3 4))) c)) - -(test-equal 10 (let* (x) (set! x 10) x)) - -(test-equal - 30 - (let* (x y) (set! x 10) (set! y 20) (+ x y))) - -(test-assert (let* (x) (not x))) - -(test-equal - 6 - (let* ((x 1) y z) - (set! y 2) - (set! z 3) - (+ x y z))) - - diff --git a/tests/test/server.scm b/tests/test/server.scm index 1b5d4775..43b60769 100644 --- a/tests/test/server.scm +++ b/tests/test/server.scm @@ -4,21 +4,21 @@ (define-module (test server) :use-module (srfi srfi-64) + :use-module (srfi srfi-71) :use-module (srfi srfi-88) :use-module ((web http make-routes) - :select (parse-endpoint-string)) - :use-module ((hnh util) :select (let*))) + :select (parse-endpoint-string))) (test-assert "Check that parsing doesn't crash" (parse-endpoint-string "/static/:dir/:file")) ;; Checks that parsing produces correct results -(let* ((path args (parse-endpoint-string "/static/:dir/:file"))) +(let ((path args (parse-endpoint-string "/static/:dir/:file"))) (test-equal "/static/([^/.]+)/([^/.]+)" path) (test-equal '(dir file) args)) ;; Checks that parsing with custom regex works ;; along with literal periods. -(let* ((path args (parse-endpoint-string "/static/:filename{.*}.:ext"))) +(let ((path args (parse-endpoint-string "/static/:filename{.*}.:ext"))) (test-equal "/static/(.*)\\.([^/.]+)" path) (test-equal '(filename ext) args)) diff --git a/tests/test/timespec.scm b/tests/test/timespec.scm new file mode 100644 index 00000000..256c01bf --- /dev/null +++ b/tests/test/timespec.scm @@ -0,0 +1,88 @@ +(define-module (test timespec) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (datetime) + :use-module (datetime timespec)) + +(test-equal "The empty string parses to the empty timespec" + (timespec-zero) (parse-time-spec "")) + +(test-group "timespec-add" + + (test-equal "Zero operands gives 0" + (timespec-zero) (timespec-add)) + + (let ((ts (make-timespec #10:20:30 '- #\z))) + (test-equal "Single operand gives that operand" + ts (timespec-add ts))) + + (test-equal "0 + 0 = 0" + (timespec-zero) (timespec-add (timespec-zero) (timespec-zero))) + + (test-group + "+ -" + (test-equal "Remove a number less than the base" + (make-timespec #10:00:00 '+ #\w) + (timespec-add (make-timespec #10:20:30 '+ #\w) + (make-timespec #00:20:30 '- #\w))) + + (test-equal "Remove a number greater than the base" + (make-timespec #01:00:00 '- #\w) + (timespec-add (make-timespec #10:00:00 '+ #\w) + (make-timespec #11:00:00 '- #\w))) + + (test-equal "x + -x = 0" + (timespec-zero) (timespec-add (make-timespec #10:20:30 '+ #\w) + (make-timespec #10:20:30 '- #\w)))) + + (test-group "- +" + (test-equal "Add a number less than the (negative) base" + (make-timespec #10:00:00 '+ #\w) + (timespec-add (make-timespec #10:20:30 '- #\w) + (make-timespec #00:20:30 '+ #\w))) + + (test-equal "Add a number greater than the (negative) base" + (make-timespec #01:00:00 '- #\w) + (timespec-add (make-timespec #10:00:00 '- #\w) + (make-timespec #11:00:00 '+ #\w))) + + (test-equal "-x + x = 0" + (timespec-zero) (timespec-add (make-timespec #10:20:30 '- #\w) + (make-timespec #10:20:30 '+ #\w)))) + + (test-group "+ +" + (test-equal "x + x = 2x" + (make-timespec #20:41:00 '+ #\w) + (timespec-add (make-timespec #10:20:30 '+ #\w) + (make-timespec #10:20:30 '+ #\w)))) + + (test-group "- -" + (test-equal "-x + -x = -2x" + (make-timespec #20:41:00 '- #\w) + (timespec-add (make-timespec #10:20:30 '- #\w) + (make-timespec #10:20:30 '- #\w)))) + + ;; add more than two timespecs + + ;; add timespecs of differing types + ) + +(test-group "parse-time-spec" + ;; TODO what even is this case? + (test-equal (make-timespec (time) '+ #\g) (parse-time-spec "-g")) + + (test-equal "Parse direct date, with hour minute and second" + (make-timespec #20:00:00 '+ #\w) (parse-time-spec "20:00:00")) + (test-equal "Parse direct date, with hour and minute" + (make-timespec #20:00:00 '+ #\w) (parse-time-spec "20:00")) + (test-equal "Parse direct date, with just hour" + (make-timespec #20:00:00 '+ #\w) (parse-time-spec "20")) + + (test-equal "Parse timespec with letter at end" + (make-timespec #20:00:00 '+ #\g) (parse-time-spec "20:00g")) + + (test-equal "Parse negative timespec" + (make-timespec #20:00:00 '- #\w) (parse-time-spec "-20")) + + (test-equal "Parse negative timespec with letter at end" + (make-timespec #20:00:00 '- #\z) (parse-time-spec "-20z"))) diff --git a/tests/test/web-server.scm b/tests/test/web-server.scm index e5a796b6..69d18536 100644 --- a/tests/test/web-server.scm +++ b/tests/test/web-server.scm @@ -9,13 +9,13 @@ (define-module (test web-server) :use-module (srfi srfi-64) + :use-module (srfi srfi-71) :use-module (srfi srfi-88) :use-module ((calp server routes) :select (make-make-routes)) :use-module ((web server) :select (run-server)) :use-module ((ice-9 threads) :select (call-with-new-thread cancel-thread)) :use-module ((web client) :select (http-get)) - :use-module ((hnh util) :select (let*)) :use-module ((web response) :select (response-code response-location)) :use-module ((web uri) :select (build-uri uri-path)) :use-module ((guile) @@ -71,39 +71,39 @@ ;; This test should always fail, but should never be run (test-assert "Server returned unexpectedly" #f)))) -(let* ((response - _ - (catch 'system-error - (lambda () - (http-get - (build-uri 'http host: host port: port))) - (lambda (err proc fmt args data) - (format - (current-error-port) - "~a (in ~a) ~?~%" - err - proc - fmt - args) - (values (build-response code: 500) #f))))) +(let ((response + _ + (catch 'system-error + (lambda () + (http-get + (build-uri 'http host: host port: port))) + (lambda (err proc fmt args data) + (format + (current-error-port) + "~a (in ~a) ~?~%" + err + proc + fmt + args) + (values (build-response code: 500) #f))))) (test-eqv "Basic connect" 200 (response-code response))) -(let* ((response - body - (http-get - (build-uri - 'http - host: - host - port: - port - path: - "/today" - query: - "view=week&date=2020-01-04")))) +(let ((response + body + (http-get + (build-uri + 'http + host: + host + port: + port + path: + "/today" + query: + "view=week&date=2020-01-04")))) (test-eqv "Redirect" 302 diff --git a/tests/test/zic.scm b/tests/test/zic.scm new file mode 100644 index 00000000..99247cf1 --- /dev/null +++ b/tests/test/zic.scm @@ -0,0 +1,317 @@ +(define-module (test zic) + :use-module ((srfi srfi-1) :select (every)) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (datetime) + :use-module (datetime timespec) + :use-module (datetime zic)) + + +(test-expect-fail "Simple Leap") +(test-expect-fail "Simple Expire") + +(define big-sample + "# Rule NAME FROM TO - IN ON AT SAVE LETTER/S +Rule Swiss 1941 1942 - May Mon>=1 1:00 1:00 S +Rule Swiss 1941 1942 - Oct Mon>=1 2:00 0 - +Rule EU 1977 1980 - Apr Sun>=1 1:00u 1:00 S +Rule EU 1977 only - Sep lastSun 1:00u 0 - +Rule EU 1978 only - Oct 1 1:00u 0 - +Rule EU 1979 1995 - Sep lastSun 1:00u 0 - +Rule EU 1981 max - Mar lastSun 1:00u 1:00 S +Rule EU 1996 max - Oct lastSun 1:00u 0 - + +# Zone NAME STDOFF RULES FORMAT [UNTIL] +Zone Europe/Zurich 0:34:08 - LMT 1853 Jul 16 + 0:29:45.50 - BMT 1894 Jun + 1:00 Swiss CE%sT 1981 + 1:00 EU CE%sT + +Link Europe/Zurich Europe/Vaduz +") + +(define parse-zic-file (@@ (datetime zic) parse-zic-file)) + +;; Some of the tests are slightly altered to score better on the coverage +(test-group "From zic(8)" + (test-equal "Basic Rule" + (list ((@@ (datetime zic) make-rule) + 'US 1967 1973 4 '(last 0) + ((@ (datetime zic) make-timespec) #02:00:00 '+ #\w) + ((@ (datetime zic) make-timespec) #01:00:00 '+ #\d) + "D")) + (call-with-input-string "Rule US 1967 1973 - Apr lastSun 2:00w 1:00d D" + parse-zic-file)) + + ;; Technically not from zic(8), since that example has an until field + (test-equal "Basic Zone" + (list ((@@ (datetime zic) make-zone) "Asia/Amman" + (list ((@@ (datetime zic) make-zone-entry) + (make-timespec #02:00:00 '+ #\w) + 'Jordan "EE%sT" #f)))) + + (call-with-input-string + "Zone Asia/Amman 2:00 Jordan EE%sT" + parse-zic-file)) + + ;; Modified from the following example + (test-equal "Basic Zone with continuation" + (list ((@@ (datetime zic) make-zone) "America/Menominee" + (list ((@@ (datetime zic) make-zone-entry) + (make-timespec #05:00:00 '- #\w) + #f "EST" #1973-04-29T02:00:00) + ((@@ (datetime zic) make-zone-entry) + (make-timespec #06:00:00 '- #\w) + 'US "C%sT" #f)))) + ;; Why can't I single read a zone with an until field? + (call-with-input-string + "Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00 + -6:00 US C%sT" + parse-zic-file)) + + + (test-equal "Rules and Zone" + (list ((@@ (datetime zic) make-zone) "America/Menominee" + (list ((@@ (datetime zic) make-zone-entry) + (make-timespec #05:00:00 '- #\w) + #f "EST" #1973-04-29T02:00:00) + ((@@ (datetime zic) make-zone-entry) + (make-timespec #06:00:00 '- #\w) + 'US "C%sT" #f))) + ((@@ (datetime zic) make-rule) + 'US 1967 1973 dec '(last 0) + (make-timespec #02:00:00 '+ #\w) + (make-timespec #01:00:00 '+ #\w) + "D") + ((@@ (datetime zic) make-rule) + 'US 1967 2006 nov '(last 0) + (make-timespec #02:00:00 '+ #\w) + (make-timespec #00:00:00 '+ #\w) + "S")) + (call-with-input-string + "# Rule NAME FROM TO - IN ON AT SAVE LETTER/S +Rule US 1967 2006 - Nov lastSun 2:00 0 S +Rule US 1967 1973 - Dec lastSun 2:00 1:00 D +# Zone NAME STDOFF RULES FORMAT [UNTIL] +Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00 + -6:00 US C%sT +" parse-zic-file)) + + + (test-equal "Simple Link" + (list ((@@ (datetime zic) make-link) "Asia/Istanbul" "Europe/Istanbul")) + (call-with-input-string "Link Europe/Istanbul Asia/Istanbul" + parse-zic-file)) + + (test-equal "Simple Leap" + 'not-yet-implemented + (call-with-input-string "Leap 2016 Dec 31 23:59:60 + S" + parse-zic-file)) + + (test-equal "Simple Expire" + 'not-yet-implemented + (call-with-input-string "Expires 2020 Dec 28 00:00:00" + parse-zic-file)) + + + (test-equal "Extended example" + ;; Items are in reverse order of discovery + (list ((@@ (datetime zic) make-link) "Europe/Vaduz" "Europe/Zurich") + ((@@ (datetime zic) make-zone) "Europe/Zurich" + (list ((@@ (datetime zic) make-zone-entry) + (make-timespec #00:34:08 '+ #\w) + #f "LMT" #1853-07-16T00:00:00) + ((@@ (datetime zic) make-zone-entry) + (make-timespec #00:29:45 '+ #\w) ; NOTE that the .50 is discarded + #f "BMT" #1894-06-01T00:00:00) + ((@@ (datetime zic) make-zone-entry) + (make-timespec #01:00:00 '+ #\w) + 'Swiss "CE%sT" #1981-01-01T00:00:00) + ((@@ (datetime zic) make-zone-entry) + (make-timespec #01:00:00 '+ #\w) + 'EU "CE%sT" #f))) + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 '(last 0) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'EU 1981 'maximum 3 '(last 0) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #01:00:00 '+ #\w) + "S") + ((@@ (datetime zic) make-rule) 'EU 1979 1995 9 `(last ,sun) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'EU 1978 'only 10 1 + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'EU 1977 'only 9 `(last ,sun) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'EU 1977 1980 4 `(> ,sun 1) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #01:00:00 '+ #\w) + "S") + ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 10 `(> ,mon 1) + (make-timespec #02:00:00 '+ #\w) + (make-timespec #00:00:00 '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 5 `(> ,mon 1) + (make-timespec #01:00:00 '+ #\w) + (make-timespec #01:00:00 '+ #\w) + "S")) + (call-with-input-string big-sample + parse-zic-file))) + +(test-group "rule->dtstart" + (test-equal "last sunday" + #1967-04-30T02:00:00 + (rule->dtstart + ((@@ (datetime zic) make-rule) + 'US 1967 1973 4 '(last 0) + ((@ (datetime zic) make-timespec) #02:00:00 '+ #\w) + ((@ (datetime zic) make-timespec) #01:00:00 '+ #\d) + "D"))) + + (test-equal "sunday >= 1" + #1977-04-03T01:00:00Z + (rule->dtstart + ((@@ (datetime zic) make-rule) 'EU 1977 1980 4 `(> ,sun 1) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #01:00:00 '+ #\w) + "S"))) + + ;; Max and min uses dummy dates, which is slightly wrong + ;; but shouldn't cause any real problems + + (test-equal "Minimum time" + #0000-10-30T01:00:00Z + (rule->dtstart + ((@@ (datetime zic) make-rule) 'EU 'minimum 2000 10 '(last 0) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + ""))) + + (test-equal "Maximum time" + (datetime year: 9999 month: oct day: 27 + hour: 1 tz: "UTC") + (rule->dtstart + ((@@ (datetime zic) make-rule) 'EU 'maximum 2000 10 '(last 0) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + "")))) + +(test-group "zone-format" + + (test-equal "Zone format with argument" "CEST" (zone-format "CE%sT" "S")) + (test-equal "Zone format with empty" "CET" (zone-format "CE%sT" "")) + + ;; TODO zone-format %z is not yet implemented, and therefore untested + + ;; TODO this error message is currently translatable... + (test-equal "Invalid format specifier" + '(misc-error "zone-format" "Invalid format char ~s in ~s at position ~a" (#\S "%S" 1) #f) + (catch 'misc-error (lambda () (zone-format "%S" "A")) + list))) + +(test-group "Actual object" + ;; NOTE this doesn't test read-zoneinfos ability to + ;; - take filenames + ;; - take multiple items + (let ((zoneinfo (call-with-input-string big-sample (compose read-zoneinfo list)))) + (test-assert "get-zone returns a zone-entry object" + (every zone-entry? (get-zone zoneinfo "Europe/Zurich"))) + (test-equal "A link resolves to the same object as its target" + (get-zone zoneinfo "Europe/Zurich") (get-zone zoneinfo "Europe/Vaduz")) + (test-equal "Get rules returns correctly, and in order" + ;; Rules are sorted + (list ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 5 `(> ,mon 1) + (make-timespec #01:00:00 '+ #\w) + (make-timespec #01:00:00 '+ #\w) + "S") + ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 10 `(> ,mon 1) + (make-timespec #02:00:00 '+ #\w) + (make-timespec #00:00:00 '+ #\w) + "")) + (get-rule zoneinfo 'Swiss)))) + + +(test-group "rule->rrule" + (test-equal "Basic example, and to = maximum" + ((@ (vcomponent recurrence internal) make-recur-rule) + freq: 'YEARLY interval: 1 wkst: mon + byday: (list (cons -1 sun)) + bymonth: (list oct)) + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 '(last 0) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + "") + )) + + (test-equal "with to = only" + #f + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'only 10 '(last 2) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + ""))) + + (test-equal "with definitive to year" + ((@ (vcomponent recurrence internal) make-recur-rule) + freq: 'YEARLY interval: 1 wkst: mon + byday: (list (cons -1 tue)) + bymonth: (list oct) + until: #2000-01-01T00:00:00) + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 2000 10 '(last 2) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + ""))) + + (test-equal "on being a month day" + ((@ (vcomponent recurrence internal) make-recur-rule) + freq: 'YEARLY interval: 1 wkst: mon + bymonthday: (list 2) + bymonth: (list oct)) + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 2 + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + ""))) + + (test-equal "on being first day after date" + ((@ (vcomponent recurrence internal) make-recur-rule) + freq: 'YEARLY interval: 1 wkst: mon + byday: (list (cons 1 mon)) + bymonth: (list oct)) + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 `(> ,mon 2) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + ""))) + + (test-equal "Crash on counting backwards from date" + '(misc-error "rule->rrule" "Counting backward for RRULES unsupported" #f #f) + (catch 'misc-error + (lambda () + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 `(< ,mon 2) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + ""))) + list)) + + (test-equal "Crash on to = minimum" + '(misc-error "rule->rrule" "Check your input" #f #f) + (catch 'misc-error + (lambda () + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'minimum 10 `(< ,mon 2) + (make-timespec #01:00:00 '+ #\u) + (make-timespec #00:00:00 '+ #\w) + ""))) + list)) + ) |