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

Turning on exceptions in check-expect

Browse Source 
svn: r11385
This commit is contained in:
Kathy Gray 2008-08-22 14:25:53 +00:00
parent de74567f46
commit 0f01d3202d
4 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/lang/htdp-langs.ss
View File

@ -168,7 +168,6 @@
(namespace-attach-module drs-namespace scheme-test-module-name) (namespace-attach-module drs-namespace scheme-test-module-name)
(namespace-require scheme-test-module-name) (namespace-require scheme-test-module-name)
(scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%)) (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%))
(error-handler teaching-languages-error-display-handler)
(test-execute (get-preference 'tests:enable? (lambda () #t))) (test-execute (get-preference 'tests:enable? (lambda () #t)))
(test-format (make-formatter (lambda (v o) (render-value/format v settings o 40)))) (test-format (make-formatter (lambda (v o) (render-value/format v settings o 40))))
))) )))

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

@ -187,11 +187,14 @@
;; ( -> 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) (with-handlers ([exn? (lambda (e) (raise e)
#;((error-display-handler) (exn-message e) e) (let ([display (error-display-handler)])
(list (make-unexpected-error src expect #;((error-display-handler) (exn-message e) e)
(exn-message e) (list (make-unexpected-error src expect
e) 'error (lambda () (test))))]) (exn-message e)
e) 'error (lambda ()
(printf "~a~n" e)
(display (exn-message 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
@ -291,7 +294,6 @@
(define (insert-test test-info test) (send test-info add-test test)) (define (insert-test test-info test) (send test-info add-test test))
(define scheme-test-data (make-parameter (list #f #f #f))) (define scheme-test-data (make-parameter (list #f #f #f)))
#;(define scheme-error-handler (make-parameter (error-display-handler)))
(define scheme-test% (define scheme-test%
(class* test-engine% () (class* test-engine% ()

3
collects/test-engine/test-display.scm
View File

@ -160,8 +160,7 @@
(when (and src-editor current-rep) (when (and src-editor current-rep)
(send text set-clickback (send text set-clickback
start (send text get-end-position) start (send text get-end-position)
(lambda (t s e) (parameterize ([error-display-handler (error-handler)]) (lambda (t s e) ((error-handler) exn))
(exn)))
#f #f) #f #f)
(let ([end (send text get-end-position)] (let ([end (send text get-end-position)]
[c (new style-delta%)]) [c (new style-delta%)])

2
collects/test-engine/test-engine.scm
View File

@ -166,7 +166,7 @@
(define test-format (make-parameter (lambda (v) (format "~a" v)))) (define test-format (make-parameter (lambda (v) (format "~a" v))))
(define test-execute (make-parameter #t)) (define test-execute (make-parameter #t))
(define error-handler (make-parameter (error-display-handler))) (define error-handler (make-parameter (lambda (e) (e))))
(define test-silence (make-parameter #f)) (define test-silence (make-parameter #f))
(provide test-engine% test-display-textual% test-format error-handler test-execute test-silence) (provide test-engine% test-display-textual% test-format error-handler test-execute test-silence)