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

print out check's input on exceptions

Browse Source
This commit is contained in:
Burke Fetscher 2014-04-02 10:27:24 -05:00
parent b87ebbfe8f
commit f4ce391fab
1 changed files with 6 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt
View File

@ -68,7 +68,7 @@
(last (regexp-split #rx"/" filename)))) (last (regexp-split #rx"/" filename))))
"-results.rktd"))) "-results.rktd")))
(define (with-timeout time thunk fail-thunk) (define (with-timeout time thunk fail-thunk [on-exn raise])
(define res-chan (make-channel)) (define res-chan (make-channel))
(define exn-chan (make-channel)) (define exn-chan (make-channel))
(define thd (thread (λ () (define thd (thread (λ ()
@ -80,7 +80,7 @@
(break-thread thd) (break-thread thd)
(fail-thunk))) (fail-thunk)))
(handle-evt exn-chan (handle-evt exn-chan
(λ (exn) (raise exn))) (λ (exn) (on-exn exn)))
(handle-evt res-chan (handle-evt res-chan
(λ (result-of-thunk) result-of-thunk)))) (λ (result-of-thunk) result-of-thunk))))
@ -158,7 +158,10 @@
(define ok? (with-timeout (* 5 1000) (λ () (check term)) (define ok? (with-timeout (* 5 1000) (λ () (check term))
(λ () (printf "\nIn ~a, ~a, timed out checking the term: ~s\n" (λ () (printf "\nIn ~a, ~a, timed out checking the term: ~s\n"
fname type term) fname type term)
(break (timeout))))) (break (timeout)))
(λ (exn)
(printf "\nException when calling check with:\n~s\n" term)
(raise exn))))
(cond (cond
[(not ok?) [(not ok?)
(list tries term)] (list tries term)]