Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

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

Closed
wants to merge 1 commit into from

5 participants

@davidtpierson

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.

*** ADDITIONAL NOTE for pull request comment ***

This patch adds code within check-exn (and check-not-exn) to verify that
the given thunk is a procedure accepting 0 arguments.

My motivation was to remedy the problem of failing to specify a valid
thunk for the thunk argument of check-exn and yet not seeing any error
or test failure (because the application of the non-thunk raised an
exception matching the predicate.) The change to check-not-exn was to
be consistent in comparison with check-exn, and also it seemed to me to
be more "correct" to raise an error rather than a check failure.

I looked at changing the documentation but I believe my changes are
consistent with the current docs -- I couldn't find anything that needed
changing.

@davidtpierson davidtpierson rackunit: make check-exn/check-not-exn raise error if given a non-thunk
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.
b9eea8a
@rmculpepper
Collaborator

Merged, thanks!

@rfindler
Collaborator
@jeapostrophe
Collaborator
@rfindler
Collaborator
@samth
Collaborator

This was merged a while ago, closing.

@samth samth closed this
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Nov 7, 2013
  1. @davidtpierson

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

    davidtpierson authored
    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.
This page is out of date. Refresh to see the latest.
View
7 pkgs/rackunit-pkgs/rackunit-lib/rackunit/private/check.rkt
@@ -205,7 +205,13 @@
#t
(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)
+ (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)])
@@ -236,6 +242,7 @@
(lambda () (fail-check))))))
(define-check (check-not-exn thunk)
+ (raise-error-if-not-thunk 'check-not-exn thunk)
(with-handlers
([exn:test:check?
(lambda (exn) (refail-check exn))]
View
26 pkgs/rackunit-pkgs/rackunit-test/tests/rackunit/check-test.rkt
@@ -318,6 +318,32 @@
found?))
#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
;; Uses of check (and derived forms) used to be un-compilable!
;; We check that (write (compile --code-using-check--)) works.
Something went wrong with that request. Please try again.