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

rackunit: make check-exn/check-not-exn raise error if given a non-thunk

Browse Source 
Previously, (check-exn exn? 'foo) would pass even though 'foo is not a
thunk.  Now it raises an exn:fail:contract? exception.

Previously, (check-not-exn 'foo) would produce a check failure.  Now it
raises an exn:fail:contract? exception.

original commit: bea7c852d773e442212528fafaccd6206df903b6
This commit is contained in:
David T. Pierson 2013-11-06 00:52:32 -05:00 committed by Ryan Culpepper
parent 9083e022e4
commit f8b0732caf
2 changed files with 33 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -205,7 +205,13 @@
#t #t
(fail-check)))))])) (fail-check)))))]))
(define (raise-error-if-not-thunk name thunk)
(unless (and (procedure? thunk)
(procedure-arity-includes? thunk 0))
(raise-arguments-error name "thunk must be a procedure that accepts 0 arguments" "thunk" thunk)))
(define-check (check-exn raw-pred thunk) (define-check (check-exn raw-pred thunk)
(raise-error-if-not-thunk 'check-exn thunk)
(let ([pred (if (regexp? raw-pred) (let ([pred (if (regexp? raw-pred)
(λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x)))) (λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x))))
raw-pred)]) raw-pred)])
@ -236,6 +242,7 @@
(lambda () (fail-check)))))) (lambda () (fail-check))))))
(define-check (check-not-exn thunk) (define-check (check-not-exn thunk)
(raise-error-if-not-thunk 'check-not-exn thunk)
(with-handlers (with-handlers
([exn:test:check? ([exn:test:check?
(lambda (exn) (refail-check exn))] (lambda (exn) (refail-check exn))]

26
pkgs/rackunit-pkgs/rackunit-test/tests/rackunit/check-test.rkt
View File

@ -318,6 +318,32 @@
found?)) found?))
#f names)))) #f names))))
;; Verify that check-exn and check-not-exn raise errors (not check
;; failures) if not given thunks.
(test-case
"check-exn raises contract exception if not given a procedure"
(check-exn exn:fail:contract?
(lambda ()
(check-exn exn:fail? 'not-a-procedure))))
(test-case
"check-exn raises contract exception if given a procedure with incorrect arity"
(check-exn exn:fail:contract?
(lambda ()
(check-exn exn:fail? (lambda (x) x)))))
(test-case
"check-not-exn raises contract exception if not given a procedure"
(check-exn exn:fail:contract?
(lambda ()
(check-not-exn 'not-a-procedure))))
(test-case
"check-not-exn raises contract exception if given a procedure with incorrect arity"
(check-exn exn:fail:contract?
(lambda ()
(check-not-exn (lambda (x) x)))))
;; Regression test ;; Regression test
;; Uses of check (and derived forms) used to be un-compilable! ;; Uses of check (and derived forms) used to be un-compilable!
;; We check that (write (compile --code-using-check--)) works. ;; We check that (write (compile --code-using-check--)) works.