Port cal-period tests.
This commit is contained in:
parent
95640fbff7
commit
dc47cfe36b
1 changed files with 75 additions and 37 deletions
|
@ -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))
|
||||
))
|
||||
|
||||
)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue