Port cal-period tests.

This commit is contained in:
Dominik Pantůček 2023-05-09 19:53:56 +02:00
parent 95640fbff7
commit dc47cfe36b

View file

@ -223,69 +223,107 @@
;; Performs self-tests of the period module.
(define (cal-period-tests!)
(run-tests
period
cal-period
(test-equal? sort-period-markers
(sort-period-markers
`((start ,(make-cal-month 2023 1))
(stop ,(make-cal-month 2022 10))
(start ,(make-cal-month 2022 3))))
'((start (2022 3)) (stop (2022 10)) (start (2023 1))))
`((start ,(make-cal-month 2022 3))
(stop ,(make-cal-month 2022 10))
(start ,(make-cal-month 2023 1))))
(test-equal? period-markers->cal-periods
(period-markers->cal-periods
'((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4))))
'(#t
(((2022 3) (2022 10) #f #f)
((2023 1) (2023 4) #f #f))
`((start ,(make-cal-month 2022 3))
(stop ,(make-cal-month 2022 10))
(start ,(make-cal-month 2023 1))
(stop ,(make-cal-month 2023 4))))
`(#t
(,(make-cal-period (make-cal-month 2022 3)
(make-cal-month 2022 10) #f #f)
,(make-cal-period (make-cal-month 2023 1)
(make-cal-month 2023 4) #f #f))
""
-1))
(test-equal? period-markers->cal-periods-open
(period-markers->cal-periods
'((start (2022 3)) (stop (2022 10)) (start (2023 1)) (stop (2023 4)) (start (2023 5))))
'(#t
(((2022 3) (2022 10) #f #f)
((2023 1) (2023 4) #f #f)
((2023 5) #f #f #f))
`((start ,(make-cal-month 2022 3))
(stop ,(make-cal-month 2022 10))
(start ,(make-cal-month 2023 1))
(stop ,(make-cal-month 2023 4))
(start ,(make-cal-month 2023 5))))
`(#t
(,(make-cal-period (make-cal-month 2022 3)
(make-cal-month 2022 10) #f #f)
,(make-cal-period (make-cal-month 2023 1)
(make-cal-month 2023 4) #f #f)
,(make-cal-period (make-cal-month 2023 5) #f #f #f))
""
-1))
(test-eq? cal-period->duration
(cal-period->duration '((2023 1) (2023 4) #f #f)) 3)
(parameterize ((*current-month* (list 2023 4)))
(cal-period->duration (make-cal-period (make-cal-month 2023 1)
(make-cal-month 2023 4) #f #f))
3)
(parameterize ((*current-month* (make-cal-month 2023 4)))
(test-eq? cal-period->duration
(cal-period->duration '((2023 1) #f #f #f)) 3))
(cal-period->duration (make-cal-period (make-cal-month 2023 1) #f #f #f))
3))
(test-eq? cal-periods-duration
(cal-periods-duration '(((2022 3) (2022 10) #f #f)
((2023 1) (2023 4) #f #f)))
(cal-periods-duration `(,(make-cal-period (make-cal-month 2022 3)
(make-cal-month 2022 10) #f #f)
,(make-cal-period (make-cal-month 2023 1)
(make-cal-month 2023 4) #f #f)))
10)
(test-true cal-month-in-period?
(cal-month-in-period? '((2022 1) (2022 4) #f #f) '(2022 3)))
(cal-month-in-period? (make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f)
(make-cal-month 2022 3)))
(test-false cal-month-in-period?
(cal-month-in-period? '((2022 1) (2022 4) #f #f) '(2022 5)))
(cal-month-in-period? (make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f)
(make-cal-month 2022 5)))
(test-true cal-month-in-periods?
(cal-month-in-periods? '(((2022 1) (2022 4) #f #f)
((2023 5) (2023 10) #f #f))
'(2022 3)))
(cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f)
,(make-cal-period (make-cal-month 2023 5)
(make-cal-month 2023 10) #f #f))
(make-cal-month 2022 3)))
(test-true cal-month-in-periods?
(cal-month-in-periods? '(((2022 1) (2022 4) #f #f)
((2023 5) (2023 10) #f #f))
'(2023 7)))
(cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f)
,(make-cal-period (make-cal-month 2023 5)
(make-cal-month 2023 10) #f #f))
(make-cal-month 2023 7)))
(test-false cal-month-in-periods?
(cal-month-in-periods? '(((2022 1) (2022 4) #f #f)
((2023 5) (2023 10) #f #f))
'(2022 10)))
(cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f)
,(make-cal-period (make-cal-month 2023 5)
(make-cal-month 2023 10) #f #f))
(make-cal-month 2022 10)))
(test-equal? cal-period->string
(cal-period->string '((2022 1) (2022 4) #f #f))
(cal-period->string (make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f))
"2022-01..2022-04")
(test-equal? cal-periods->string
(cal-periods->string '(((2022 1) (2022 4) #f #f)
((2022 12) (2023 2) #f #f)))
(cal-periods->string `(,(make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f)
,(make-cal-period (make-cal-month 2022 12)
(make-cal-month 2023 2) #f #f)))
"2022-01..2022-04, 2022-12..2023-02")
(test-false cal-periods-match (cal-periods-match '(((2022 1) (2022 4) #f #f)
((2022 12) (2023 2) #f #f))
'(2022 5)))
(test-equal? cal-periods-match (cal-periods-match '(((2022 1) (2022 4) #f #f)
((2022 12) (2023 2) #f #f))
'(2022 2))
'((2022 1) (2022 4) #f #f))
(test-false cal-periods-match
(cal-periods-match `(,(make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f)
,(make-cal-period (make-cal-month 2022 12)
(make-cal-month 2023 2) #f #f))
(make-cal-month 2022 5)))
(test-equal? cal-periods-match
(cal-periods-match `(,(make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f)
,(make-cal-period (make-cal-month 2022 12)
(make-cal-month 2023 2) #f #f))
(make-cal-month 2022 2))
(make-cal-period (make-cal-month 2022 1)
(make-cal-month 2022 4) #f #f))
))
)