suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

made test accept keyword

Browse Source 
svn: r9371
This commit is contained in:
Eli Barzilay 2008-04-19 14:07:46 +00:00
parent 99943314d2
commit 4fea43c61f
1 changed files with 18 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/tests/mzscheme/testing.ss
View File

@ -101,18 +101,24 @@ transcript.
(set! number-of-exn-tests (+ number-of-exn-tests (list-ref l 2))) (set! number-of-exn-tests (+ number-of-exn-tests (list-ref l 2)))
(set! errs (append (list-ref l 3) errs))))) (set! errs (append (list-ref l 3) errs)))))
(define (test expect fun . args) (define test
(set! number-of-tests (add1 number-of-tests)) (let ()
(printf "~s ==> " (cons fun args)) (define (test* expect fun args kws kvs)
(flush-output) (set! number-of-tests (add1 number-of-tests))
(let ([res (if (procedure? fun) (apply fun args) (car args))]) (printf "~s ==> " (cons fun args))
(printf "~s\n" res) (flush-output)
(let ([ok? (equal? expect res)]) (let ([res (if (procedure? fun)
(unless ok? (if kws (keyword-apply fun kws kvs args) (apply fun args))
(record-error (list res expect (cons fun args))) (car args))])
(printf " BUT EXPECTED ~s\n" expect)) (printf "~s\n" res)
ok?))) (let ([ok? (equal? expect res)])
(unless ok?
(record-error (list res expect (cons fun args)))
(printf " BUT EXPECTED ~s\n" expect))
ok?)))
(define (test/kw kws kvs expect fun . args) (test* expect fun args kws kvs))
(define (test expect fun . args) (test* expect fun args #f #f))
(make-keyword-procedure test/kw test)))
(define (nonneg-exact? x) (define (nonneg-exact? x)
(and (exact? x) (and (exact? x)