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

Fix all self-tests.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-11 08:58:20 +01:00
parent dd2716c1c7
commit e5045f893d
1 changed files with 34 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

58
brmsaptool.scm
View file

@ -26,6 +26,7 @@
(chicken file posix)
(chicken io)
(chicken string)
(chicken format)
(chicken process-context))
@ -50,7 +51,7 @@
(syntax-rules ()
((_ name condition)
(if (with-handler (lambda (x) #f)
(lambda () condition))
condition)
(display ".")
(error 'unit-test name)))))
@ -131,28 +132,28 @@
(car m)
(cdr m)
(cadr m)
(nil? (cddr m))
(null? (cddr m))
(integer? (car m))
(integer? (cadr m))
(>= (car m 1000))
(<= (car m 9999))
(>= (cadr m 1))
(<= (cadr m 12))))
(>= (car m) 1000)
(<= (car m) 9999)
(>= (cadr m) 1)
(<= (cadr m) 12)))
;; Converts string in a format YYYY-MM to valid month. Returns #f if
;; the conversion fails.
(define (string->month s)
(let ((l (string-split s "-")))
(if (or (not l)
(nil? l)
(nil? (cdr l))
(not (nil? (cddr l))))
(null? l)
(null? (cdr l))
(not (null? (cddr l))))
#f
(let ((y (string->number (car l)))
(m (string->number (cadr l))))
(if (and y m)
(let ((M (list y m)))
(if (valid-month? M)
(if (month-valid? M)
M
#f))
#f)))))
@ -160,18 +161,18 @@
;; Formats (valid) month as YYYY-MM string
(define (month->string M)
(if (month-valid? M)
(let ((y (car s))
(m (cadr s)))
(let ((y (car M))
(m (cadr M)))
(sprintf "~A-~A~A"
y
(if (< m 10) " " "")
(if (< m 10) "0" "")
m))
(error 'string->month "Invalid month" M)))
;; Returns true if both arguments are a valid month and are equal
(define (month=? m n)
(and (valid-month? m)
(valid-month? n)
(and (month-valid? m)
(month-valid? n)
(equal? m n)))
;; Returns true if the first argument is a month in the past of the
@ -183,16 +184,23 @@
(and (= (car m) (car n))
(< (cadr m) (cadr n))))))
(define (month-diff m n)
; Exclusive
1)
;; Returns the number of months between from f and to t. The first
;; month is included in the count, the last month is not.
(define (month-diff f t)
(if (month-valid? f)
(if (month-valid? t)
(let ((F (+ (* (car f) 12) (cadr f)))
(T (+ (* (car t) 12) (cadr t))))
(- T F))
(error 'month-diff "Second argument is not a valid month" t))
(error 'month-diff "First argument is not a valid month" f)))
(define (month-tests!)
(display "[test] month ")
(unit-test 'month-valid? (month-valid? '(2023 5)))
(unit-test 'month-valid?-bad-year (not (month-valid? '(999 8))))
(unit-test 'month-valid?-bad-month (not (month-valid? '(2023 -5))))
(unit-test 'string->month (equal? (string->month "2023-01" '(2023 1))))
(unit-test 'string->month (equal? (string->month "2023-01") '(2023 1)))
(unit-test 'string->month-bad-month (not (string->month "2023-13")))
(unit-test 'string->month-nonumber-year (not (string->month "YYYY-01")))
(unit-test 'string->month-nonumber-month (not (string->month "2023-MMM")))
@ -201,11 +209,13 @@
(unit-test 'month->string-bad-month (with-handler (lambda (x) #t) (month->string '(2023 13)) #f))
(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))))
;; Difference - exclusive end
(unit-test 'month<?-is-equal (not (month<? '(2023 1) '(2023 1))))
(unit-test 'month<?-greater (not (month<? '(2023 1) '(2023 1))))
(unit-test 'month-equal? (month=? '(2023 4) '(2023 4)))
(unit-test 'month-equal?-not (not (month=? '(2023 4) '(2023 5))))
(unit-test 'month-diff-1 (= (month-diff '(2023 1) '(2023 2)) 1))
(unit-test 'month-diff-11 (eq? (month-diff '(2023 1) '(2023 12)) 11))
(unit-test 'month-diff (= (month-diff '(2023 1) '(2022 2)) -11))
(print " ok."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;