brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Month comparison.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-11 08:29:45 +01:00
parent fda45105d6
commit 3306a80b09
1 changed files with 12 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

16
brmsaptool.scm
View file

@ -147,8 +147,14 @@
(valid-month? n)
(equal? m n)))
;; Returns true if the first argument is a month in the past of the
;; second argument month
(define (month<? m n)
#f)
(and (month-valid? m)
(month-valid? n)
(or (< (car m) (car n))
(and (= (car m) (car n))
(< (cadr m) (cadr n))))))
(define (month-diff m n)
; Exclusive
@ -163,11 +169,13 @@
(unit-test 'month->string (equal? (month->string '(2023 1)) "2023-01"))
(unit-test 'month->string-bad-year (with-handler (lambda (x) #t) (month->string '(999 12)) #f))
(unit-test 'month->string-bad-month (with-handler (lambda (x) #t) (month->string '(2023 13)) #f))
;; Comparison less
(unit-test 'month<? (month<? '(2023 5) '(2023 6)))
(unit-test 'month<?-cross-year (month<? '(2022 12) '(2023 1)))
(unit-test 'month<?-equal (not (month<? '(2023 1) '(2023 1))))
(unit-test 'month<?-greater (not (month<? '(2023 1) '(2023 2))))
(unit-test 'month-equal? (month-equal? '(2023 4) '(2023 4)))
(unit-test 'month-equal? (not (month-equal? '(2023 4) '(2023 5))))
;; Comparison greater
;; Difference - TODO: inclusive both ends?
;; Difference - exclusive end
(print " ok."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;