Improve testing output
This commit is contained in:
parent
224fcc425c
commit
7682d622a8
67
test.scm
67
test.scm
@ -2,59 +2,88 @@
|
|||||||
(rnrs base)
|
(rnrs base)
|
||||||
(srfi srfi-1))
|
(srfi srfi-1))
|
||||||
|
|
||||||
|
;; TODO eventually these will be cool prompt thingies
|
||||||
|
|
||||||
|
(define (assert-equal a b)
|
||||||
|
(display "... ")
|
||||||
|
(if (equal? a b)
|
||||||
|
(display "OK")
|
||||||
|
(begin
|
||||||
|
(display "expected ")
|
||||||
|
(display b)
|
||||||
|
(display " but instead got ")
|
||||||
|
(display a))))
|
||||||
|
|
||||||
|
(define (assert-unspecified a)
|
||||||
|
(display "... ")
|
||||||
|
(if (unspecified? a)
|
||||||
|
(display "OK")
|
||||||
|
(begin
|
||||||
|
(display "expected unspecifed but instead got ")
|
||||||
|
(display a))))
|
||||||
|
|
||||||
(define-syntax-rule (define-unit-test (test-name body ...))
|
(define-syntax-rule (define-unit-test (test-name body ...))
|
||||||
(let () body ...))
|
(let ()
|
||||||
|
(display "< ")
|
||||||
|
(display (symbol->string 'test-name))
|
||||||
|
body ...
|
||||||
|
(newline)))
|
||||||
|
|
||||||
(define-syntax-rule (define-test module-name tests ...)
|
(define-syntax-rule (define-test module-name tests ...)
|
||||||
(begin (define-unit-test tests) ...))
|
(begin
|
||||||
|
(display "> ")
|
||||||
|
(display (symbol->string 'module-name))
|
||||||
|
(newline)
|
||||||
|
(define-unit-test tests) ...))
|
||||||
|
|
||||||
(define-test ~>
|
(define-test ~>
|
||||||
(unwrapped
|
(unwrapped
|
||||||
(define value (~> 1 1+ 1+))
|
(define value (~> 1 1+ 1+))
|
||||||
(assert (= value 3)))
|
(assert-equal value 3))
|
||||||
(wrapped
|
(wrapped
|
||||||
(define value (~> 1 (/ 2) (/ 2)))
|
(define value (~> 1 (/ 2) (/ 2)))
|
||||||
(assert (= value 1/4))))
|
(assert-equal value 1/4)))
|
||||||
|
|
||||||
(define-test ~>>
|
(define-test ~>>
|
||||||
(unwrapped
|
(unwrapped
|
||||||
(define value (~>> 1 1+ 1+))
|
(define value (~>> 1 1+ 1+))
|
||||||
(assert (= value 3)))
|
(assert-equal value 3))
|
||||||
(wrapped
|
(wrapped
|
||||||
(define value (~>> 1 (/ 2) (/ 2)))
|
(define value (~>> 1 (/ 2) (/ 2)))
|
||||||
(assert (= value 1))))
|
(assert-equal value 1)))
|
||||||
|
|
||||||
(define-test if-not
|
(define-test if-not
|
||||||
(assert (eq? (if-not #f 'a 'b) 'a)))
|
(test
|
||||||
|
(assert-equal (if-not #f 'a 'b) 'a)))
|
||||||
|
|
||||||
(define-test when-not
|
(define-test when-not
|
||||||
(positive-case
|
(positive-case
|
||||||
(assert (eq? (when-not #f 'do-some-stuff 'return) 'return)))
|
(assert-equal (when-not #f 'do-some-stuff 'return) 'return))
|
||||||
(negative-case
|
(negative-case
|
||||||
(assert (unspecified? (when-not #t 'do-some-stuff 'return)))))
|
(assert-unspecified (when-not #t 'do-some-stuff 'return))))
|
||||||
|
|
||||||
(define-test for
|
(define-test for
|
||||||
(permutation
|
(permutation
|
||||||
(define value (for ([i (iota 2)]
|
(define value (for ([i (iota 2)]
|
||||||
[j (iota 2)])
|
[j (iota 2)])
|
||||||
(cons i j)))
|
(cons i j)))
|
||||||
(assert (equal? value '((0 . 0) (0 . 1) (1 . 0) (1 . 1))))))
|
(assert-equal value '((0 . 0) (0 . 1) (1 . 0) (1 . 1)))))
|
||||||
|
|
||||||
(define-test if-let
|
(define-test if-let
|
||||||
(positive-case
|
(positive-case
|
||||||
(assert (= (if-let ([v (or #f 1)]) (+ v 1)) 2)))
|
(assert-equal (if-let ([v (or #f 1)]) (+ v 1)) 2))
|
||||||
(negative-case
|
(negative-case
|
||||||
(assert (not (if-let ([v (and #f 1)]) (+ v 1))))))
|
(assert-equal (if-let ([v (and #f 1)]) (+ v 1)) #f)))
|
||||||
|
|
||||||
(define-test partial
|
(define-test partial
|
||||||
(test
|
(test
|
||||||
(define value (partial / 2))
|
(define value (partial / 2))
|
||||||
(assert (= (value 4) 1/2))
|
(assert-equal (value 4) 1/2)
|
||||||
(assert (= (value 1) 2))))
|
(assert-equal (value 1) 2)))
|
||||||
|
|
||||||
(define-test argmin
|
(define-test argmin
|
||||||
(test
|
(test
|
||||||
(assert (equal? (argmin cdr < '(a . 5) '(b . 2) '(c . 3)) '(b . 2)))))
|
(assert-equal (argmin cdr < '(a . 5) '(b . 2) '(c . 3)) '(b . 2))))
|
||||||
|
|
||||||
(define-test make-generator
|
(define-test make-generator
|
||||||
(test
|
(test
|
||||||
@ -63,7 +92,7 @@
|
|||||||
(let loop ([i 1])
|
(let loop ([i 1])
|
||||||
(yield i)
|
(yield i)
|
||||||
(loop (1+ i))))))
|
(loop (1+ i))))))
|
||||||
(assert (= (number-generator) 1))
|
(assert-equal (number-generator) 1)
|
||||||
(assert (= (number-generator) 2))
|
(assert-equal (number-generator) 2)
|
||||||
(assert (= (number-generator) 3))
|
(assert-equal (number-generator) 3)
|
||||||
(assert (= (number-generator) 4))))
|
(assert-equal (number-generator) 4)))
|
||||||
|
Loading…
Reference in New Issue
Block a user