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

add check for check-exn predicate

Browse Source 
closes PR 14165

original commit: 9b88a732ebebfdcb2229b79c1b5249295ff85c43
This commit is contained in:
Ryan Culpepper 2013-11-17 18:17:54 -05:00
parent f8b0732caf
commit 61748bc7fa
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/rackunit-pkgs/rackunit-lib/rackunit/private/check.rkt
View File

@ -211,10 +211,14 @@
(raise-arguments-error name "thunk must be a procedure that accepts 0 arguments" "thunk" thunk)))
(define-check (check-exn raw-pred thunk)
(raise-error-if-not-thunk 'check-exn thunk)
(let ([pred (if (regexp? raw-pred)
(λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x))))
raw-pred)])
(let ([pred
(cond [(regexp? raw-pred)
(λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x))))]
[(and (procedure? raw-pred) (procedure-arity-includes? raw-pred 1))
raw-pred]
[else
(raise-argument-error 'check-exn "(-> any/c any/c)" raw-pred)])])
(raise-error-if-not-thunk 'check-exn thunk)
(let/ec succeed
(with-handlers
(;; catch the exception we are looking for and