conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #299 from omasanori/extend-test 

Extend test
This commit is contained in:
OGINO Masanori 2015-07-21 15:25:46 +09:00
parent c44e3edd57 f345832b44
commit 643d86c709
1 changed files with 25 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
contrib/30.test/test.scm
View File

@ -36,33 +36,34 @@
(define-syntax test (define-syntax test
(syntax-rules () (syntax-rules ()
((test expected expr) ((test expected expr)
(test expected expr equal?))
((test expected expr =)
(let ((res expr)) (let ((res expr))
(display "case ") (display "case ")
(write counter) (write counter)
(cond (if (= res expected)
((equal? res expected) (begin
(display " PASS: ") (display " PASS: ")
(write 'expr) (write 'expr)
(display " equals ") (display " equals ")
(write expected) (write expected)
(display "") (display "")
(newline) (newline))
) (begin
((not (equal? res expected)) (set! failure-counter (+ failure-counter 1))
(set! failure-counter (+ failure-counter 1)) (let ((out (open-output-string)))
(let ((out (open-output-string))) (display " FAIL: " out)
(display " FAIL: " out) (write 'expr out)
(write 'expr out) (newline out)
(newline out) (display " expected " out)
(display " expected " out) (write expected out)
(write expected out) (display " but got " out)
(display " but got " out) (write res out)
(write res out) (display "" out)
(display "" out) (newline out)
(newline out) (let ((str (get-output-string out)))
(let ((str (get-output-string out))) (set! fails (cons str fails))
(set! fails (cons str fails)) (display str)))))
(display str)))))
(set! counter (+ counter 1)))))) (set! counter (+ counter 1))))))
(define-syntax test-values (define-syntax test-values