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

Re-raise check-expect exception after registering the failure, not

Browse Source 
before. (PR10402)

svn: r15745
This commit is contained in:
Mike Sperber 2009-08-15 12:19:39 +00:00
parent 2de19a243b
commit e7e65bd4d1
1 changed files with 8 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/test-engine/scheme-tests.ss
View File

@ -201,22 +201,21 @@
;; (src format scheme-val scheme-val scheme-val -> check-fail) ;; (src format scheme-val scheme-val scheme-val -> check-fail)
;; ( -> scheme-val) scheme-val scheme-val object symbol? -> void ;; ( -> scheme-val) scheme-val scheme-val object symbol? -> void
(define (run-and-check check maker test expect range src test-info kind) (define (run-and-check check maker test expect range src test-info kind)
(match-let ([(list result result-val exn?) (match-let ([(list result result-val exn)
(with-handlers ([exn? (lambda (e) (raise e) (with-handlers ([exn? (lambda (e)
(let ([display (error-display-handler)]) (let ([display (error-display-handler)])
#;((error-display-handler) (exn-message e) e)
(list (make-unexpected-error src (test-format) expect (list (make-unexpected-error src (test-format) expect
(exn-message e) (exn-message e)
e) 'error (lambda () e)
(printf "~a~n" e) 'error
(display (exn-message e) e)))))]) e)))])
(let ([test-val (test)]) (let ([test-val (test)])
(cond [(check expect test-val range) (list #t test-val #f)] (cond [(check expect test-val range) (list #t test-val #f)]
[else [else
(list (maker src (test-format) test-val expect range) test-val #f)])))]) (list (maker src (test-format) test-val expect range) test-val #f)])))])
(cond [(check-fail? result) (cond [(check-fail? result)
(send (send test-info get-info) check-failed result (check-fail-src result) exn?) (send (send test-info get-info) check-failed result (check-fail-src result) exn)
#f] (raise exn)]
[else [else
#t]))) #t])))