Skip to content

Commit

Permalink
Redesign check-fail to provide a tree-based API
Browse files Browse the repository at this point in the history
  • Loading branch information
@jackfirth
jackfirth committed Sep 3, 2017
1 parent 4c85b39 commit 4f365d9
Show file tree
Hide file tree
Showing 3 changed files with 144 additions and 266 deletions.
95 changes: 28 additions & 67 deletions rackunit-doc/rackunit/scribblings/check.scrbl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -462,84 +462,45 @@ message.}

Custom checks such as those created by @racket[define-check] can contain a fair
amount of logic. Consequently, custom checks can be buggy and should be tested.
RackUnit provides a handful of checks explicitly designed for testing the
behavior of other checks; they allow verifying checks pass and fail when
expected or that checks add certain information to the check information stack.
These bindings are provided by @racketmodname[rackunit/meta], not
@racketmodname[rackunit].

@defproc[(check-fail [fail-exn-predicate
(or/c (-> exn:test:check? any/c) regexp?)]
RackUnit provides a few checks explicitly designed for testing the behavior of
other checks; they allow verifying checks pass and fail when expected or that
checks add certain information to the check information stack. These bindings
are provided by @racketmodname[rackunit/meta], not @racketmodname[rackunit].

@defproc[(check-fail [assertion-tree
(treeof (or/c (-> exn:test:check? any/c)
regexp?
check-info?))]
[thunk (-> any)]
[message string? ""])
void?]{
Checks that @racket[thunk] evaluates a failing check and that
@racket[fail-exn-predicate], if it's a function, returns a true value when
given the check failure exception. If @racket[fail-exn-predicate] is a regexp,
instead checks that the regexp matches the check failure exception's message.
Note that a check failure exception's message is the message given to
@racket[fail-check], not the optional @racket[message] argument that all checks
accept. See also @racket[check-exn] and @racket[check-fail/error].
Checks that @racket[thunk] raises a check failure and that the failure
satisfies @racket[assertion-tree]. The tree is checked in the following manner:

@(itemlist
@item{If the tree is a predicate, it must return a true value when applied to
the raised check failure.}
@item{If the tree is a regexp, it must match the check failure's message (as
provided by @racket[fail-check]).}
@item{If the tree is a @racket[check-info] value, the check failure's
@racket[exn:test:check-stack] value must contain the expected info value.}
@item{If the tree is a list, every assertion in the list is checked.})

@(examples
#:eval rackunit-eval
(check-fail values (λ () (check-equal? 'foo 'bar)))
(check-fail '() (λ () (check-equal? 'foo 'bar)))
(check-fail number? (λ () (check-equal? 'foo 'bar)))
(check-fail values (λ () (check-equal? 'foo 'foo))))
(check-fail (list string? (check-info 'info 10))
(λ () (check-equal? 'foo 'foo))))

@history[#:added "1.8"]}

@defproc[(check-fail* [thunk (-> any)] [message string? ""]) void?]{
Like @racket[check-fail], but only checks that @racket[thunk] evaluates a
failing check without testing the failure against a predicate or regexp.

@(examples
#:eval rackunit-eval
(check-fail* (λ () (check-equal? 'foo 'bar)))
(check-fail* (λ () (check-equal? 'foo 'foo))))

@history[#:added "1.8"]}

@defproc[(check-fail/info [info check-info?]
[thunk (-> any)]
[message string? ""])
void?]{
Like @racket[check-fail], but instead of checking that the failure matches a
predicate or regexp checks that the failure contains a check info value equal
to @racket[info]. Note that the check info stack of the failure may contain
multiple infos with the same name as @racket[info] but different values; in
that case the check passes as long as at least one info is equal to the
expected info.

@(examples
#:eval rackunit-eval
(define foo-info (make-check-info 'foo 'foo))
(define-check (fail-foo) (with-heck-info* (list foo-info) fail-check))
(check-fail/info foo-info fail-foo)
(check-fail/info foo-info void)
(check-fail/info foo-info fail))

@history[#:added "1.8"]}

@defproc[(check-fail/error [fail-exn-predicate
(or/c (-> exn:test:check? any/c) regexp?)]
[thunk (-> any)]
[message string? ""])
void?]{
Checks that @racket[thunk] evaluates a check that raises an error value instead
of passing or failing, and checks that the raised value satisfies
@racket[fail-exn-predicate]. Satisfies means that @racket[fail-exn-predicate]
return true when given the raised value if @racket[fail-exn-predicate] is a
function. If it's a predicate, satisfies means that the raised value is an
exception whose message matches the regexp. See also @racket[check-fail] and
@racket[check-exn].
Additionally, a failure is reported if @racket[thunk] raises something other
than an @racket[exn:test:check] value. The optional @racket[message] argument
is included in the output if the check fails.

@(examples
#:eval rackunit-eval
(define-check (error-check)
(raise (make-exn:fail "Kaboom!!!" (current-continuation-marks)))
(fail-check "Doesn't get here"))
(check-fail/error #rx"boom" error-check))
(check-fail '() (λ () (raise 'foo)))
(check-fail number? (λ () (check-equal? 'foo 'bar)) "my message"))

@history[#:added "1.8"]}

Expand Down
181 changes: 85 additions & 96 deletions rackunit-lib/rackunit/meta.rkt
View file
Original file line number Diff line number Diff line change
@@ -1,105 +1,58 @@
#lang racket/base

(provide check-fail/error
check-fail
check-fail*
check-fail/info)
(provide check-fail)

(require (for-syntax racket/base)
racket/function
racket/list
rackunit/log
syntax/parse/define
rackunit
rackunit/private/check-info)
(only-in rackunit/private/check-info
current-check-info
pretty-info))


(define-check (check-fail pred-or-msg chk-thnk)
(contract-pred-or-msg! 'check-fail pred-or-msg)
(define-check (check-fail tree chk-thnk)
(contract-tree! 'check-fail tree)
(contract-thunk! 'check-fail chk-thnk)
(define failure (check-raise-value chk-thnk))
(with-expected pred-or-msg
(assert-failure failure)
(assert-check-failure failure)
(if (procedure? pred-or-msg)
(unless (pred-or-msg failure)
(with-actual failure
(fail-check "Wrong exception raised")))
(let ([msg (exn-message failure)])
(unless (regexp-match? pred-or-msg msg)
(with-actual failure
(with-check-info (['actual-msg msg])
(fail-check "Wrong exception raised"))))))))

(define-check (check-fail/info expected-info chk-thnk)
(contract-info! 'check-fail/info expected-info)
(contract-thunk! 'check-fail/info chk-thnk)
(define failure (check-raise-value chk-thnk))
(with-expected expected-info
(assert-failure failure)
(assert-check-failure failure)
(define (has-expected-name? info)
(equal? (check-info-name info) (check-info-name expected-info)))
(define infos (exn:test:check-stack failure))
(define info-names (map check-info-name infos))
(define matching-infos (filter has-expected-name? infos))
(when (empty? matching-infos)
(with-check-info (['actual-info-names info-names])
(fail-check "Check failure did not contain the expected info")))
(unless (member expected-info matching-infos)
(with-check-info* (map make-check-actual matching-infos)
(λ () (fail-check "Check failure contained info(s) with matching name but unexpected value"))))))

(define-check (check-fail* chk-thnk)
(contract-thunk! 'check-fail* chk-thnk)
(define failure (check-raise-value chk-thnk))
(assert-failure failure)
(assert-check-failure failure))

(define-check (check-fail/error pred-or-msg chk-thnk)
(contract-pred-or-msg! 'check-fail/error pred-or-msg)
(contract-thunk! 'check-fail/error chk-thnk)
(define failure (check-raise-value chk-thnk))
(with-expected pred-or-msg
(assert-failure failure)
(assert-not-check-failure failure)
(cond
[(procedure? pred-or-msg)
(unless (pred-or-msg failure)
(with-actual failure
(fail-check "Wrong error raised")))]
[(exn? failure)
(define msg (exn-message failure))
(unless (regexp-match? pred-or-msg msg)
(with-actual failure
(with-check-info (['actual-msg msg])
(fail-check "Wrong error raised"))))]
[else
(with-actual failure
(fail-check "Wrong error raised"))])))
(unless (exn:test:check? failure)
(with-actual failure
(fail-check "Check raised error instead of failing")))
(check-tree-assert tree failure))

;; Shorthands for adding infos

(define-simple-macro (with-actual act:expr body:expr ...)
(with-check-info* (list (make-check-actual act)) (λ () body ...)))
(with-check-info* (error-info act) (λ () body ...)))

(define-simple-macro (with-expected exp:expr body:expr ...)
(with-check-info* (list (make-check-expected exp)) (λ () body ...)))
(define (list/if . vs) (filter values vs))

;; Pseudo-contract helpers, to be replaced with real check contracts eventually
(define (error-info raised)
(list/if (make-check-actual raised)
(and (exn? raised)
(make-check-info 'actual-message (exn-message raised)))
(and (exn:test:check? raised)
(make-check-info 'actual-info
(nested-info
(exn:test:check-stack raised))))))

(define (contract-pred-or-msg! name pred-or-msg)
(unless (or (and (procedure? pred-or-msg)
(procedure-arity-includes? pred-or-msg 1))
(regexp? pred-or-msg))
(define ctrct "(or/c (-> any/c boolean?) regexp?)")
(raise-argument-error name ctrct pred-or-msg)))
;; Pseudo-contract helpers, to be replaced with real check contracts eventually

(define (contract-thunk! name thnk)
(unless (procedure? thnk) (raise-argument-error name "(-> any)" thnk)))

(define (contract-info! name info)
(unless (check-info? info) (raise-argument-error name "check-info?" info)))
(unless (and (procedure? thnk)
(procedure-arity-includes? thnk 0))
(raise-argument-error name "(-> any)" thnk)))

(define (contract-tree! name tree)
(for ([v (in-list (flatten tree))])
(unless (or (and (procedure? v)
(procedure-arity-includes? v 1))
(regexp? v)
(check-info? v))
(define ctrct "(or/c (-> any/c boolean?) regexp? check-info?)")
(raise-argument-error name ctrct v))))

;; Extracting raised values from checks

Expand All @@ -109,22 +62,58 @@
;; instead of writing to stdout / stderr, 2) the inner check doesn't log
;; any pass or fail information to rackunit/log, and 3) the inner check's info
;; stack is independent of the outer check's info stack.
(parameterize ([current-check-handler raise]
[test-log-enabled? #f]
[current-check-info (list)])
(with-handlers ([(negate exn:break?) values]) (chk-thnk) #f)))
(or (parameterize ([current-check-handler raise]
[test-log-enabled? #f]
[current-check-info (list)])
(with-handlers ([(negate exn:break?) values]) (chk-thnk) #f))
(fail-check "Check passed unexpectedly")))

;; Assertion helpers

(define (assert-failure maybe-failure)
(unless maybe-failure (fail-check "No check failure occurred")))

(define (assert-check-failure failure)
(unless (exn:test:check? failure)
(with-actual failure
(fail-check "A value other than a check failure was raised"))))

(define (assert-not-check-failure failure)
(when (exn:test:check? failure)
(with-actual failure
(fail-check "Wrong error raised"))))
(struct failure (type expected) #:transparent)

(define (assert-pred raised pred)
(and (not (pred raised))
(failure 'predicate pred)))

(define (assert-regexp exn rx)
(and (not (regexp-match? rx (exn-message exn)))
(failure 'message rx)))

(define (assert-info exn info)
(and (not (member info (exn:test:check-stack exn)))
(failure 'info info)))

(define (assert assertion raised)
((cond [(procedure? assertion) assert-pred]
[(regexp? assertion) assert-regexp]
[(check-info? assertion) assert-info])
raised assertion))

(define (assertions-adjust assertions raised)
(define is-exn? (exn? raised))
(define has-regexps? (ormap regexp? assertions))
(define adjust-regexps? (and has-regexps? (not is-exn?)))
(if adjust-regexps?
(cons exn? (filter-not regexp? assertions))
assertions))

(define (assertion-tree-apply tree raised)
(define assertions (assertions-adjust (flatten tree) raised))
(filter-map (λ (a) (assert a raised)) assertions))

(define (failure-list->info failures)
(define vs
(if (equal? (length failures) 1)
(pretty-info (failure-expected (first failures)))
(nested-info (for/list ([f (in-list failures)])
(make-check-info (failure-type f)
(pretty-info (failure-expected f)))))))
(make-check-info 'expected vs))

(define (check-tree-assert tree raised)
(with-actual raised
(define failures (assertion-tree-apply tree raised))
(unless (empty? failures)
(with-check-info* (list (failure-list->info failures))
fail-check))))
Loading

0 comments on commit 4f365d9

Please sign in to comment.