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

fixed race in rackunit gui

Browse Source 
Merge to release branch

original commit: 9d42ef9235e40de846fc480d6fcd13fa0f00a929
This commit is contained in:
Ryan Culpepper 2011-02-03 16:42:05 -07:00
commit ae629a0545
22 changed files with 683 additions and 280 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/rackunit/private/check-info.rkt
View File

@ -24,7 +24,11 @@
;; (continuation-mark-set -> (listof check-info))
(define (check-info-stack marks)
(apply append (continuation-mark-set->list marks check-info-mark)))
(let ([ht (make-hash)])
(for ([x (in-list (apply append (continuation-mark-set->list marks check-info-mark)))]
[i (in-naturals)])
(hash-set! ht (check-info-name x) (cons i x)))
(map cdr (sort (hash-map ht (λ (k v) v)) < #:key car))))
;; with-check-info* : (list-of check-info) thunk -> any
(define (with-check-info* info thunk)

121
collects/rackunit/private/check.rkt
View File

@ -2,7 +2,6 @@
(require (for-syntax racket/base
"location.rkt")
srfi/1
"base.rkt"
"check-info.rkt"
"format.rkt"
@ -34,39 +33,50 @@
check-not-equal?
fail)
(define USE-ERROR-HANDLER? #f)
;; default-check-handler : exn -> any
(define (default-check-handler e)
(let ([out (open-output-string)])
;;(display "check failed\n" out)
(parameterize ((current-output-port out))
(display-delimiter)
(cond [(exn:test:check? e)
(display-failure)
(newline)
(display-check-info-stack
(exn:test:check-stack e))]
[(exn? e)
(display-error)
(newline)
(display-exn e)])
(display-delimiter))
(cond [USE-ERROR-HANDLER?
((error-display-handler) (get-output-string out)
;; So that DrRacket won't recognize exn:fail:syntax, etc
(make-exn (exn-message exn) (exn-continuation-marks exn)))]
[else
(display (get-output-string out) (current-error-port))])))
;; parameter current-check-handler : (-> exn any)
(define current-check-handler
(make-parameter
(lambda (e)
(cond
[(exn:test:check? e)
(display-delimiter)
(display-failure)(newline)
(display-check-info-stack
(exn:test:check-stack e))
(display-delimiter)]
[(exn? e)
(display-delimiter)
(display-error)(newline)
(display-exn e)
(display-delimiter)]))
default-check-handler
(lambda (v)
(if (procedure? v)
v
(raise-type-error 'current-check-handler "procedure" v)))))
;; check-around : ( -> a) -> a
(define check-around
(lambda (thunk)
(with-handlers
([exn? (current-check-handler)])
(thunk))))
(define (check-around thunk)
(with-handlers ([exn? (current-check-handler)])
(thunk)))
;; top-level-check-around : ( -> a) -> a
(define top-level-check-around
(lambda (thunk)
(check-around thunk)
(void)))
(define (top-level-check-around thunk)
(check-around thunk)
(void))
;; parameter current-check-around : (( -> a) -> a)
(define current-check-around
@ -161,7 +171,15 @@
(name
(identifier? #'name)
(syntax/loc stx
check-secret-name)))))
(case-lambda
[(formal ...)
(check-secret-name formal ...
#:location (quote loc)
#:expression (quote (name actual ...)))]
[(formal ... msg)
(check-secret-name formal ... msg
#:location (quote loc)
#:expression (quote (name actual ...)))]))))))
))))))
(define-syntax define-simple-check
@ -195,32 +213,35 @@
#t
(fail-check)))))]))
(define-check (check-exn pred thunk)
(let/ec succeed
(with-handlers
(;; catch the exception we are looking for and
;; succeed
[pred
(lambda (exn) (succeed #t))]
;; rethrow check failures if we aren't looking
;; for them
[exn:test:check?
(lambda (exn)
(refail-check exn))]
;; catch any other exception and raise an check
;; failure
[exn:fail?
(lambda (exn)
(with-check-info*
(list
(make-check-message "Wrong exception raised")
(make-check-info 'exn-message (exn-message exn))
(make-check-info 'exn exn))
(lambda () (fail-check))))])
(thunk))
(with-check-info*
(list (make-check-message "No exception raised"))
(lambda () (fail-check)))))
(define-check (check-exn raw-pred thunk)
(let ([pred (if (regexp? raw-pred)
(λ (x) (and (exn:fail? x) (regexp-match raw-pred (exn-message x))))
raw-pred)])
(let/ec succeed
(with-handlers
(;; catch the exception we are looking for and
;; succeed
[pred
(lambda (exn) (succeed #t))]
;; rethrow check failures if we aren't looking
;; for them
[exn:test:check?
(lambda (exn)
(refail-check exn))]
;; catch any other exception and raise an check
;; failure
[exn:fail?
(lambda (exn)
(with-check-info*
(list
(make-check-message "Wrong exception raised")
(make-check-info 'exn-message (exn-message exn))
(make-check-info 'exn exn))
(lambda () (fail-check))))])
(thunk))
(with-check-info*
(list (make-check-message "No exception raised"))
(lambda () (fail-check))))))
(define-check (check-not-exn thunk)
(with-handlers

2
collects/rackunit/private/gui/gui.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(require racket/class
unstable/class-iop
racket/gui
racket/gui/base
"../base.rkt"
"../result.rkt"
"../check-info.rkt"

2
collects/rackunit/private/gui/model.rkt
View File

@ -2,7 +2,7 @@
(require racket/class
unstable/class-iop
racket/list
"gvector.rkt"
data/gvector
"../base.rkt"
"interfaces.rkt"
"cache-box.rkt")

3
collects/rackunit/private/gui/model2rml.rkt
View File

@ -2,9 +2,10 @@
(require racket/class
unstable/class-iop
racket/list
racket/gui
racket/gui/base
racket/match
racket/file
racket/path
mrlib/include-bitmap
(prefix-in drlink: "drracket-ui.rkt")
"interfaces.rkt"

2
collects/rackunit/private/gui/rml.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(require racket/class
unstable/class-iop
racket/gui
racket/gui/base
framework
"interfaces.rkt")

69
collects/rackunit/private/gui/view.rkt
View File

@ -3,7 +3,7 @@
unstable/class-iop
unstable/gui/notify
racket/list
racket/gui
racket/gui/base
framework
mrlib/hierlist
"interfaces.rkt"
@ -71,8 +71,16 @@ still be there, just not visible?
(view this)
(controller controller)))
;; for update management
(define update-queue (make-hasheq))
;; Update management
;; Do adds in order, then updates in any order (hash).
;; add-queue : (listof (-> void))
(define add-queue null)
;; update-queue : (imm-hashof model<%> #t)
(define update-queue '#hasheq())
;; update-lock : semaphore
(define update-lock (make-semaphore 1))
(send editor lock #t)
@ -83,12 +91,6 @@ still be there, just not visible?
;; View Links
(define/public (create-view-link model parent)
(parameterize ((current-eventspace eventspace))
(queue-callback
(lambda ()
(send tree-view create-view-link model parent)))))
(define/private (get-view-link model)
(send tree-view get-view-link model))
@ -108,10 +110,18 @@ still be there, just not visible?
;; Update Management
;; create-view-link : model suite-result<%>/#f -> void
(define/public (create-view-link model parent)
(let ([proc (lambda () (send tree-view create-view-link model parent))])
(semaphore-wait update-lock)
(set! add-queue (cons proc add-queue))
(semaphore-post update-lock)
(process-updates)))
;; queue-for-update : model -> void
(define/public (queue-for-update model)
(semaphore-wait update-lock)
(hash-set! update-queue model #t)
(set! update-queue (hash-set update-queue model #t))
(semaphore-post update-lock)
(process-updates))
@ -120,38 +130,33 @@ still be there, just not visible?
(parameterize ((current-eventspace eventspace))
(queue-callback
(lambda ()
(let ([models-to-update (grab+clear-update-queue)])
(for ([model models-to-update])
(let-values ([(adds updates) (grab+clear-update-queue)])
(for ([add (in-list adds)])
(add))
(for ([model (in-hash-keys updates)])
(do-model-update model)))))))
;; grab+clear-update-queue : -> void
;; grab+clear-update-queue : -> (values list hash)
;; ** Must be called from eventspace thread.
(define/private (grab+clear-update-queue)
(semaphore-wait update-lock)
(if (positive? (hash-count update-queue))
(let ([old-queue update-queue])
(set! update-queue (make-hasheq))
(semaphore-post update-lock)
(reverse
(hash-map old-queue (lambda (k v) k))))
(begin (semaphore-post update-lock)
null)))
(begin0
(values (reverse add-queue)
update-queue)
(set! add-queue null)
(set! update-queue '#hasheq())
(semaphore-post update-lock)))
;; do-model-update : model<%> -> void
;; ** Must be called from eventspace thread.
(define/private (do-model-update model)
(let ([view-link (get-view-link model)])
(cond [view-link
(send tree-view update-item view-link)
(when (eq? model (get-selected-model))
(show-model model))]
[(not view-link)
;; If the view-link has not been created,
;; yield until it is.
(unless (yield)
(error 'rackunit-gui
"internal error: no progress waiting for view-link"))
(do-model-update model)])))
(unless view-link
;; should not be possible
(error 'rackunit-gui "internal error: no view-link"))
(send tree-view update-item view-link)
(when (eq? model (get-selected-model))
(show-model model))))
;; Update display

61
collects/rackunit/private/test-case.rkt
View File

@ -16,47 +16,52 @@
after
around)
(define USE-ERROR-HANDLER? #f)
(define current-test-name
(make-parameter
#f
(lambda (v)
(if (string? v)
v
(raise-mismatch-error
'current-test-name
"string?"
v)))))
(raise-type-error 'current-test-name "string" v)))))
;; test-case-around : ( -> a) -> a
;;
;; Run a test-case immediately, printing information on failure
(define test-case-around
(lambda (thunk)
(with-handlers
([exn:test:check?
(lambda (e)
(display-delimiter)
(display-test-name (current-test-name))
(display-failure)(newline)
(display-check-info-stack (exn:test:check-stack e))
(display-delimiter))]
[exn?
(lambda (e)
(display-delimiter)
(display-test-name (current-test-name))
(display-error)(newline)
(display-exn e)
(display-delimiter))])
(thunk))))
(define (default-test-case-around thunk)
(with-handlers ([exn? default-test-case-handler])
(thunk)))
;; default-test-case-handler : exn -> any
(define (default-test-case-handler e)
(let ([out (open-output-string)])
;;(display "test case failed\n" out)
(parameterize ((current-output-port out))
(display-delimiter)
(display-test-name (current-test-name))
(cond [(exn:test:check? e)
(display-failure)(newline)
(display-check-info-stack (exn:test:check-stack e))]
[(exn? e)
(display-error)(newline)
(display-exn e)])
(display-delimiter))
(cond [USE-ERROR-HANDLER?
((error-display-handler) (get-output-string out)
;; So that DrRacket won't recognize exn:fail:syntax, etc
(make-exn (exn-message e) (exn-continuation-marks e)))]
[else
(display (get-output-string out) (current-error-port))])))
(define current-test-case-around
(make-parameter
test-case-around
default-test-case-around
(lambda (v)
(if (procedure? v)
v
(raise-type-error 'current-test-case-around "procedure" v)))))
(raise-type-error 'current-test-case-around "procedure" v)))))
(define-syntax (test-begin stx)
(syntax-case stx ()
[(_ expr ...)
@ -66,6 +71,7 @@
(parameterize
([current-check-handler raise]
[current-check-around check-around])
(void)
expr ...))))]
[_
(raise-syntax-error
@ -73,7 +79,6 @@
"Correct form is (test-begin expr ...)"
stx)]))
(define-syntax test-case
(syntax-rules ()
[(test-case name expr ...)
@ -81,7 +86,6 @@
([current-test-name name])
(test-begin expr ...))]))
(define-syntax before
(syntax-rules ()
((_ before-e expr1 expr2 ...)
@ -132,4 +136,3 @@
"Incorrect use of around macro. Correct format is (around before-expr expr1 expr2 ... after-expr)"
'around
'(error ...)))))

3
collects/rackunit/scribblings/api.scrbl
View File

@ -12,6 +12,3 @@
@include-section["control-flow.scrbl"]
@include-section["misc.scrbl"]
@include-section["ui.scrbl"]
@include-section["running-tests.scrbl"]

241
collects/rackunit/scribblings/check.scrbl
View File

@ -5,7 +5,7 @@
Checks are the basic building block of RackUnit. A check
checks some condition. If the condition holds the check
evaluates to @racket[#t]. If the condition doesn't hold the
evaluates to @racket[(void)]. If the condition doesn't hold the
check raises an instance of @racket[exn:test:check] with
information detailing the failure.
@ -19,75 +19,74 @@ source locations if you do so.
The following are the basic checks RackUnit provides. You
can create your own checks using @racket[define-check].
@defproc[(check (op (-> any any any))
(v1 any)
(v2 any)
(message string? ""))
any]{
@defproc*[([(check-eq? (v1 any) (v2 any) (message string? "")) void?]
[(check-not-eq? (v1 any) (v2 any) (message string? "")) void?]
[(check-eqv? (v1 any) (v2 any) (message string? "")) void?]
[(check-not-eqv? (v1 any) (v2 any) (message string? "")) void?]
[(check-equal? (v1 any) (v2 any) (message string? "")) void?]
[(check-not-equal? (v1 any) (v2 any) (message string? "")) void?])]{
The simplest check. Succeeds if @racket[op] applied to @racket[v1] and @racket[v2] is not @racket[#f], otherwise raises an exception of type @racket[exn:test:check]. The optional @racket[message] is included in the output if the check fails. If the check succeeds, the value returned by @racket[op] is the value returned by the check.}
For example, the following check succeeds:
@racketblock[
(check < 2 3)
]
@defproc*[([(check-eq? (v1 any) (v2 any) (message string? "")) #t]
[(check-not-eq? (v1 any) (v2 any) (message string? "")) #t]
[(check-eqv? (v1 any) (v2 any) (message string? "")) #t]
[(check-not-eqv? (v1 any) (v2 any) (message string? "")) #t]
[(check-equal? (v1 any) (v2 any) (message string? "")) #t]
[(check-not-equal? (v1 any) (v2 any) (message string? "")) #t])]{
Checks that @racket[v1] is (not) @racket[eq?],
@racket[eqv?], or @racket[equal?] to @racket[v2]. The
optional @racket[message] is included in the output if the
check fails.}
Checks that @racket[v1] is equal (or not equal) to @racket[v2], using
@racket[eq?], @racket[eqv?], or @racket[equal?], respectively. The
optional @racket[message] is included in the output if the check
fails.
For example, the following checks all fail:
@racketblock[
(check-eq? (list 1) (list 1) "allocated data not eq?")
(check-not-eq? 1 1 "integers are eq?")
(check-not-eq? 1 1 "fixnums are eq?")
(check-eqv? 1 1.0 "not eqv?")
(check-not-eqv? 1 1 "integers are eqv?")
(check-equal? 1 1.0 "not equal?")
(check-not-equal? (list 1) (list 1) "equal?")
]
}
@defproc[(check-pred (pred (-> any any)) (v any) (message string? ""))
#t]{Checks that @racket[pred] returns a value that is not @racket[#f] when applied to @racket[v]. The optional @racket[message] is included in the output if the check fails. The value returned by a successful check is the value returned by @racket[pred].}
void?]{
Here's an example that passes and an example that fails:
Checks that @racket[pred] returns a value that is not @racket[#f] when
applied to @racket[v]. The optional @racket[message] is included in
the output if the check fails. The value returned by a successful
check is the value returned by @racket[pred].
For example, the following check passes:
@racketblock[
(check-pred string? "I work")
]
The following check fails:
@racketblock[
(check-pred number? "I fail")
]
}
@defproc[(check-= (v1 any) (v2 any) (epsilon number?) (message string? "")) #t]{
@defproc[(check-= (v1 any) (v2 any) (epsilon number?) (message string? ""))
void?]{
Checks that @racket[v1] and @racket[v2] are within
@racket[epsilon] of one another. The optional
@racket[message] is included in the output if the check
fails.}
fails.
Here's an example that passes and an example that fails:
For example, the following check passes:
@racketblock[
(check-= 1.0 1.01 0.01 "I work")
]
The following check fails:
@racketblock[
(check-= 1.0 1.01 0.005 "I fail")
]
}
@defproc*[([(check-true (v any) (message string? "")) #t]
[(check-false (v any) (message string? "")) #t]
[(check-not-false (v any) (message string? "")) #t])]{
@defproc*[([(check-true (v any) (message string? "")) void?]
[(check-false (v any) (message string? "")) void?]
[(check-not-false (v any) (message string? "")) void?])]{
Checks that @racket[v] is @racket[#t], @racket[#f], or not
@racket[#f] as appropriate. The optional @racket[message]
is included in the output if the check fails.}
Checks that @racket[v] is @racket[#t], is @racket[#f], or is not
@racket[#f], respectively. The optional @racket[message] is included
in the output if the check fails.
For example, the following checks all fail:
@ -96,55 +95,112 @@ For example, the following checks all fail:
(check-false 1)
(check-not-false #f)
]
}
@defproc[(check-exn (exn-predicate (or/c (-> any boolean?) regexp?))
(thunk (-> any)) (message string? ""))
void?]{
@defproc[(check-exn (exn-predicate (-> any (or/c #t #f))) (thunk (-> any)) (message string? ""))
#t]{
Checks that @racket[thunk] raises an exception and that either
@racket[exn-predicate] returns @racket[#t] if it is a function, or
that it matches the message in the exception if @racket[exn-predicate]
is a regexp. In the latter case, the exception raised must be an
@racket[exn:fail?]. The optional @racket[message] is included in the
output if the check fails. A common error is to use an expression
instead of a function of no arguments for @racket[thunk]. Remember
that checks are conceptually functions.
Checks that @racket[thunk] raises an exception for which
@racket[exn-predicate] returns @racket[#t]. The optional
@racket[message] is included in the output if the check
fails. A common error is to use an expression instead of a
function of no arguments for @racket[thunk]. Remember that
checks are conceptually functions.}
Here are two example, one showing a test that succeeds, and one showing a common error:
For example, the following check succeeds:
@racketblock[
(check-exn exn?
(check-exn exn:fail?
(lambda ()
(raise (make-exn "Hi there"
(current-continuation-marks)))))
(code:comment "Forgot to wrap the expression in a thunk. Don't do this!")
(check-exn exn?
(raise (make-exn "Hi there"
(current-continuation-marks))))
]
@defproc[(check-not-exn (thunk (-> any)) (message string? "")) #t]{
The following check fails:
@racketblock[
(check-exn exn:fail?
(lambda ()
(break-thread (current-thread))))
]
The following example is a common mistake. The call to @racket[error]
is not within a @racket[lambda], so it bypasses @racket[check-exn]
entirely.
@racketblock[
(code:comment "Forgot to wrap the expression in a thunk. Don't do this!")
(check-exn exn:fail?
(error 'hi "there"))
]
}
@defproc[(check-not-exn (thunk (-> any)) (message string? "")) void?]{
Checks that @racket[thunk] does not raise any exceptions.
The optional @racket[message] is included in the output if
the check fails.}
the check fails.
}
@defproc[(fail (message string? "")) #t]{This checks fails unconditionally. Good for creating test stubs that youintend to fill out later. The optional @racket[message] is included in the output if the check fails.}
@defproc[(check-regexp-match (regexp regexp?)
(string string?))
void?]{
Checks that @racket[regexp] matches the @racket[string].
@defproc[(check-regexp-match (regexp regexp?) (string string?)) #t]{Checks that @racket[regexp] matches the @racket[string].}
For example, the following check succeeds:
The following check will succeed:
@racketblock[
(check-regexp-match "a+bba" "aaaaaabba")
]
@racketblock[(check-regexp-match "a+bba" "aaaaaabba")]
The following check fails:
This check will fail:
@racketblock[(check-regexp-match "a+bba" "aaaabbba")]
@racketblock[
(check-regexp-match "a+bba" "aaaabbba")
]
}
@defproc[(check (op (-> any any any))
(v1 any)
(v2 any)
(message string? ""))
void?]{
The most generic check. Succeeds if @racket[op] applied to
@racket[v1] and @racket[v2] is not @racket[#f], otherwise raises an
exception of type @racket[exn:test:check]. The optional
@racket[message] is included in the output if the check fails.
For example, the following check succeeds:
@racketblock[
(check < 2 3)
]
The following check fails:
@racketblock[
(check memq 'pine '(apple orange pear))
]
}
@defproc[(fail (message string? ""))
void?]{
This check fails unconditionally. Good for creating test stubs that
you intend to fill out later. The optional @racket[message] is
included in the output.
}
@section{Augmenting Information on Check Failure}
When an check fails it stores information including the name
When a check fails it stores information including the name
of the check, the location and message (if available), the
expression the check is called with, and the parameters to
the check. Additional information can be stored by using
@ -154,7 +210,7 @@ the @racket[with-check-info*] function, and the
@defstruct[check-info ([name symbol?] [value any])]{
A check-info structure stores information associated
with the context of execution of an check.}
with the context of execution of a check.}
The are several predefined functions that create check
information structures with predefined names. This avoids
@ -188,8 +244,7 @@ When this check fails the message
@verbatim{time: <current-seconds-at-time-of-running-check>}
will be printed along with the usual information on an
check failure.
is printed along with the usual information on an check failure.
@defform[(with-check-info ((name val) ...) body ...)]{
@ -213,8 +268,7 @@ When this test fails the message
@verbatim{current-element: 8}
will be displayed along with the usual information on an
check failure.
is displayed along with the usual information on an check failure.
@ -229,23 +283,21 @@ Firstly, a check should be considered a function, even
though most uses are actually macros. In particular, checks
always evaluate their arguments exactly once before
executing any expressions in the body of the checks. Hence
if you wish to write checks that evalute user defined code
if you wish to write checks that evaluate user defined code
that code must be wrapped in a thunk (a function of no
arguments) by the user. The predefined @racket[check-exn]
is an example of this type of check.
It is also useful to understand how the check information
stack operates. The stack is stored in a parameter and the
It is also useful to understand how the check information stack
operates. The stack is stored in a parameter and the
@racket[with-check-info] forms evaluate to calls to
@racket[parameterize]. Hence check information has lexical
scope. For this reason simple checks (see below) cannot
usefully contain calls to @racket[with-check-info] to report
@racket[parameterize]. For this reason simple checks (see below)
cannot usefully contain calls to @racket[with-check-info] to report
additional information. All checks created using
@racket[define-simple-check] or @racket[define-check] grab
some information by default: the name of the checks and the
values of the parameters. Additionally the macro forms of
checks grab location information and the expressions passed
as parameters.
@racket[define-simple-check] or @racket[define-check] grab some
information by default: the name of the checks and the values of the
parameters. Additionally the macro forms of checks grab location
information and the expressions passed as parameters.
@defform[(define-simple-check (name param ...) expr ...)]{
@ -257,9 +309,7 @@ check fails if the result of the @racket[expr]s is
simple checks cannot report extra information using
@racket[with-check-info].}
Example:
To define a check @racket[check-odd?]
For example, the following code defines a check @racket[check-odd?]
@racketblock[
(define-simple-check (check-odd? number)
@ -308,7 +358,6 @@ tests a number if within 0.01 of the expected value:
(< (abs (- actual expected)) 0.01))
]
@defform[(define-check (name param ...) expr ...)]{
The @racket[define-check] macro acts in exactly the same way
@ -317,29 +366,9 @@ if the macro @racket[fail-check] is called in the body of
the check. This allows more flexible checks, and in
particular more flexible reporting options.}
@defform[(fail-check)]{The @racket[fail-check] macro raises an @racket[exn:test:check] with
the contents of the check information stack.}
@defform[(fail-check)]{
The @racket[fail-check] macro raises an @racket[exn:test:check] with
the contents of the check information stack.
@section{The Check Evaluation Context}
The semantics of checks are determined by the parameters
@racket[current-check-around] and
@racket[current-check-handler]. Other testing form such as
@racket[test-begin] and @racket[test-suite] change the value
of these parameters.
@defparam[current-check-handler handler (-> any/c any/c)]{
Parameter containing the function that handles exceptions
raised by check failures. The default value is @racket[raise]. }
@defparam[current-check-around check (-> thunk any/c)]{
Parameter containing the function that handles the execution
of checks. The default value wraps the evaluation of
@racket[thunk] in a @racket[with-handlers] call that calls
@racket[current-check-handler] if an exception is raised and then
(when an exception is not raised) discards the result, returning
@racket[(void)].
}

65
collects/rackunit/scribblings/compound-testing.scrbl
View File

@ -48,9 +48,37 @@ so the test can be named.
@defproc[(test-case? (obj any)) boolean?]{
True if @racket[obj] is a test case, and false otherwise
True if @racket[obj] is a test case, and false otherwise.
}
@subsection{Shortcuts for Defining Test Cases}
@defproc*[([(test-check [name string?]
[operator (-> any/c any/c any/c)]
[v1 any/c]
[v2 any/c])
void?]
[(test-pred [name string?]
[pred (-> any/c any/c)]
[v any/c])
void?]
[(test-equal? [name string?] [v1 any/c] [v2 any/c]) (void?)]
[(test-eq? [name string?] [v1 any/c] [v2 any/c]) void?]
[(test-eqv? [name string?] [v1 any/c] [v2 any/c]) void?]
[(test-= [name string?] [v1 real?] [v2 real?] [epsilon real?]) void?]
[(test-true [name string?] [v any/c]) void?]
[(test-false [name string?] [v any/c]) void?]
[(test-not-false [name string?] [v any/c]) void?]
[(test-exn [name string?] [pred (-> exn? any/c)] [thunk (-> any)]) void?]
[(test-not-exn [name string?] [thunk (-> any)]) void?])]{
Creates a test case with the given @racket[name] that performs the
corresponding check. For example,
@racketblock[(test-equal? "Fruit test" "apple" "pear")]
is equivalent to
@racketblock[(test-case "Fruit test" (check-equal? "apple" "pear"))]
}
@section{Test Suites}
@ -150,38 +178,3 @@ As far I know no-one uses this macro, so it might disappear
in future versions of RackUnit.}
}
@section{Compound Testing Evaluation Context}
Just like with checks, there are several parameters that
control the semantics of compound testing forms.
@defparam[current-test-name name (or/c string? false/c)]{
This parameter stores the name of the current test case. A
value of @racket[#f] indicates a test case with no name,
such as one constructed by @racket[test-begin]. }
@defparam[current-test-case-around handler (-> (-> any/c) any/c)]{
This parameter handles evaluation of test cases. The value
of the parameter is a function that is passed a thunk (a
function of no arguments). The function, when applied,
evaluates the expressions within a test case. The default
value of the @racket[current-test-case-around] parameters
evaluates the thunk in a context that catches exceptions and
prints an appropriate message indicating test case failure.}
@defproc[(test-suite-test-case-around [thunk (-> any/c)]) any/c]{
The @racket[current-test-case-around] parameter is
parameterized to this value within the scope of a
@racket[test-suite]. This function creates a test case
structure instead of immediately evaluating the thunk.}
@defproc[(test-suite-check-around [thunk (-> any/c)]) any/c]{
The @racket[current-check-around] parameter is parameterized
to this value within the scope of a @racket[test-suite].
This function creates a test case structure instead of
immediately evaluating a check.}

271
collects/rackunit/scribblings/internals.scrbl Normal file
View File

@ -0,0 +1,271 @@
#lang scribble/doc
@(require "base.rkt")
@declare-exporting[rackunit #:use-sources (rackunit)]
@title[#:tag "internals"]{RackUnit Internals and Extension API}
This section describes RackUnit's facilities for customizing the
behavior of checks and tests and for creating new kinds of test
runners.
@section{Customizing Check Evaluation}
The semantics of checks are determined by the parameters
@racket[current-check-around] and
@racket[current-check-handler]. Other testing form such as
@racket[test-begin] and @racket[test-suite] change the value
of these parameters.
@defparam[current-check-handler handler (-> any/c any)]{
Parameter containing the function that handles exceptions
raised by check failures. The default value is @racket[raise].
}
@defparam[current-check-around check (-> (-> any) any)]{
Parameter containing the function that handles the execution
of checks. The default value wraps the evaluation of
@racket[thunk] in a @racket[with-handlers] call that calls
@racket[current-check-handler] if an exception is raised and then
(when an exception is not raised) discards the result, returning
@racket[(void)].
}
@section{Customizing Test Evaluation}
Just like with checks, there are several parameters that
control the semantics of compound testing forms.
@defparam[current-test-name name (or/c string? false/c)]{
This parameter stores the name of the current test case. A
value of @racket[#f] indicates a test case with no name,
such as one constructed by @racket[test-begin].
}
@defparam[current-test-case-around handler (-> (-> any) any)]{
This parameter handles evaluation of test cases. The value
of the parameter is a function that is passed a thunk (a
function of no arguments). The function, when applied,
evaluates the expressions within a test case. The default
value of the @racket[current-test-case-around] parameters
evaluates the thunk in a context that catches exceptions and
prints an appropriate message indicating test case failure.
}
@defproc[(test-suite-test-case-around [thunk (-> any)]) any]{
The @racket[current-test-case-around] parameter is
parameterized to this value within the scope of a
@racket[test-suite]. This function creates a test case
structure instead of immediately evaluating the thunk.
}
@defproc[(test-suite-check-around [thunk (-> any/c)]) any/c]{
The @racket[current-check-around] parameter is parameterized
to this value within the scope of a @racket[test-suite].
This function creates a test case structure instead of
immediately evaluating a check.
}
@;{--------}
@section[#:tag "running"]{Programmatically Running Tests and Inspecting Results}
RackUnit provides an API for running tests, from which
custom UIs can be created.
@subsection{Result Types}
@defstruct[(exn:test exn) ()]{
The base structure for RackUnit exceptions. You should
never catch instances of this type, only the subtypes
documented below.}
@defstruct[(exn:test:check exn:test) ([stack (listof check-info)])]{
A @racket[exn:test:check] is raised when an check fails, and
contains the contents of the check-info stack at the
time of failure.}
@defstruct[test-result ([test-case-name (or/c string #f)])]{
A test-result is the result of running the test with
the given name (with @racket[#f] indicating no name is available).}
@defstruct[(test-failure test-result) ([result any])]{
Subtype of test-result representing a test failure.}
@defstruct[(test-error test-result) ([result exn])]{
Subtype of test-result representing a test error.}
@defstruct[(test-success test-result) ([result any])]{
Subtype of test-result representing a test success.}
@subsection{Functions to Run Tests}
@defproc[(run-test-case (name (or/c string #f)) (action (-> any)))
test-result]{
Runs the given test case, returning a result representing success,
failure, or error.
}
@defproc[(run-test (test (or/c test-case? test-suite?)))
(flat-murec-contract ([R (listof (or/c test-result? R))]) R)]{
Runs the given test (test case or test suite) returning a
tree (list of lists) of results}
Example:
@racketblock[
(run-test
(test-suite
"Dummy"
(test-case "Dummy" (check-equal? 1 2))))
]
@defproc[(fold-test-results [result-fn ('b 'c ... 'a . -> . 'a)]
[seed 'a]
[test (or/c test-case? test-suite?)]
[#:run run (string (() -> any) . -> . 'b 'c ...)]
[#:fdown fdown (string 'a . -> . 'a)]
[#:fup fup (string 'a . -> . 'a)])
'a]{
Fold @racket[result-fn] pre-order left-to-right depth-first
over the results of @racket[run]. By default @racket[run]
is @racket[run-test-case] and @racket[fdown] and
@racket[fup] just return the seed, so @racket[result-fn] is
folded over the test results.
This function is useful for writing custom folds (and hence UIs) over
test results without you having to take care of all the expected setup
and teardown. For example, @racket[fold-test-results] will run test
suite before and after actions for you. However it is still flexible
enough, via its keyword arguments, to do almost anything that
@racket[foldts] can. Hence it should be used in preference to @racket[foldts].
The @racket[result-fn] argument is a function from the results of
@racket[run] (defaults to a @racket[test-result]) and the seed to a
new seed.
The @racket[seed] argument is any value.
The @racket[test] argument is a test case or test suite.
The @racket[run] argument is a function from a test case name (string)
and action (thunk) to any values. The values produced by @racket[run]
are fed into the @scheme[result-fn].
The @racket[fdown] argument is a function from a test suite name
(string) and the seed, to a new seed.
The @racket[fup] argument is a function from a test suite name
(string) and the seed, to a new seed.
}
Examples:
The following code counts the number of successes:
@racketblock[
(define (count-successes test)
(fold-test-results
(lambda (result seed)
(if (test-success? result)
(add1 seed)
seed))
0
test))]
The following code returns the symbol @racket['burp] instead
of running test cases. Note how the @racket[result-fn] receives the
value of @racket[run].
@racketblock[
(define (burp test)
(fold-test-results
(lambda (result seed) (cons result seed))
null
test
#:run (lambda (name action) 'burp)))]
@defproc[(foldts [fdown (test-suite string thunk thunk 'a -> 'a)]
[fup (test-suite string thunk thunk 'a 'a -> 'a)]
[fhere(test-case string thunk 'a -> 'a)]
[seed 'a]
[test (or/c test-case? test-suite?)])
'a]{
The @racket[foldts] function is a nifty tree fold (created by Oleg
Kiselyov) that folds over a test in a useful way
(@racket[fold-test-results] isn't that useful as you can't specify
actions around test cases).
The @racket[fdown] argument is a function of test suite, test suite
name, before action, after action, and the seed. It is run when a
test suite is encountered on the way down the tree (pre-order).
The @racket[fup] argument is a function of test suite, test suite
name, before action, after action, the seed at the current level, and
the seed returned by the children. It is run on the way up the tree
(post-order).
The @racket[fhere] argument is a function of the test case, test case
name, the test case action, and the seed. (Note that this might change
in the near future to just the test case. This change would be to
allow @racket[fhere] to discriminate subtypes of test-case, which in
turn would allow test cases that are, for example, ignored).
}
Example:
Here's the implementation of @racket[fold-test-results] in terms of
@racket[foldts]:
@racketblock[
(define (fold-test-results suite-fn case-fn seed test)
(foldts
(lambda (suite name before after seed)
(before)
(suite-fn name seed))
(lambda (suite name before after seed kid-seed)
(after)
kid-seed)
(lambda (case name action seed)
(case-fn
(run-test-case name action)
seed))
seed
test))
]
If you're used to folds you'll probably be a bit surprised that the
functions you pass to @racket[foldts] receive both the structure they
operate on, and the contents of that structure. This is indeed
unusual. It is done to allow subtypes of test-case and test-suite to
be run in customised ways. For example, you might define subtypes of
test case that are ignored (not run), or have their execution time
recorded, and so on. To do so the functions that run the test cases
need to know what type the test case has, and hence is is necessary to
provide this information.
If you've made it this far you truly are a master RackUnit hacker. As
a bonus prize we'll just mention that the code in
@racketfont{hash-monad.rkt} and @racketfont{monad.rkt} might be of
interest for constructing user interfaces. The API is still in flux,
so isn't documented here. However, do look at the implementation of
@racket[run-tests] for examples of use.

5
collects/rackunit/scribblings/misc.scrbl
View File

@ -8,7 +8,10 @@ bindings that a module does not provide. It is useful for
testing the private functions of modules.
@defform[(require/expose module (id ...))]{
Requires @racket[id] from @racket[module] into the current module. It doesn't matter if the source module provides the bindings or not; @racket[require/expose] can still get at them.
Requires @racket[id] from @racket[module] into the current module. It
doesn't matter if the source module provides the bindings or not;
@racket[require/expose] can still get at them.
Note that @racket[require/expose] can be a bit fragile,
especially when mixed with compiled code. Use at your own risk!

12
collects/rackunit/scribblings/overview.scrbl
View File

@ -3,13 +3,17 @@
@title{Overview of RackUnit}
There are three basic data types in RackUnit:
There are three basic concepts in RackUnit:
@itemize[
@item{A @italic{check} is the basic unit of a test. As the name suggests, it checks some condition is true.}
@item{A @italic{check} is the basic unit of a test. As the name
suggests, it checks some condition is true.}
@item{A @italic{test case} is a group of checks that form one conceptual unit. If any check within the case fails, the entire case fails.}
@item{A @italic{test case} is a group of checks that form one
conceptual unit. If any check within the case fails, the entire case
fails.}
@item{A @italic{test suite} is a group of test cases and test suites that has a name.}
@item{A @italic{test suite} is a group of test cases and test suites
that has a name.}
]

4
collects/rackunit/scribblings/philosophy.scrbl
View File

@ -5,7 +5,7 @@
RackUnit is designed to allow tests to evolve in step with
the evolution of the program under testing. RackUnit
scales from the unstructed checks suitable for simple
scales from the unstructured checks suitable for simple
programs to the complex structure necessary for large
projects.
@ -83,7 +83,7 @@ RackUnit manner (for example, test results may be logged
for the purpose of improving software quality, or they may
be displayed on a website to indicate service quality). For
these programmers it is necessary to delay the execution of
tests so they can processed in the programmer's chosen
tests so they can be processed in the programmer's chosen
manner. To do this, the programmer simply wraps a test-suite
around their tests:

6
collects/rackunit/scribblings/quick-start.scrbl
View File

@ -48,19 +48,19 @@ evaluate this file and see if the library is correct.
Here's the result I get:
@verbatim{
#t
--------------------
FAILURE
name: check-equal?
location: (file-test.rkt 7 0 117 27)
expression: (check-equal? (my-* 1 2) 2)
params: (4 2)
message: "Simple multiplication"
actual: 4
expected: 2
--------------------}
The first @racket[#t] indicates the first test passed. The
The first test passed and so prints nothing. The
second test failed, as shown by the message.
Requiring RackUnit and writing checks is all you need to
@ -119,7 +119,7 @@ we're testing. We can give a test case a name with the
lst)))
]
Now if we want to structure our tests are bit more we can
Now if we want to structure our tests a bit more we can
group them into a test suite:
@racketblock[

3
collects/rackunit/scribblings/rackunit.scrbl
View File

@ -4,7 +4,7 @@
@title{@bold{RackUnit}: Unit Testing for Racket}
@author[(author+email "Noel Welsh" "noelwelsh@gmail.com")
(author+email "Ryan Culpepper" "ryan_sml@yahoo.com")]
(author+email "Ryan Culpepper" "ryanc@racket-lang.org")]
RackUnit is a unit-testing framework for Racket. It
is designed to handle the needs of all Racket programmers,
@ -15,6 +15,7 @@ from novices to experts.
@include-section["quick-start.scrbl"]
@include-section["philosophy.scrbl"]
@include-section["api.scrbl"]
@include-section["internals.scrbl"]
@include-section["release-notes.scrbl"]
@include-section["acknowledgements.scrbl"]

2
collects/rackunit/tool.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base
(require racket/class
racket/gui
racket/gui/base
framework
drscheme/tool
racket/unit

16
collects/tests/rackunit/pr10950.rkt
View File

@ -4,13 +4,19 @@
racket/port
tests/eli-tester)
(test
(with-output-to-string
(define output
(with-output-to-string
(lambda ()
(parameterize ([current-error-port (current-output-port)])
(define-check (check3)
(fail-check))
(run-tests (test-suite "tests" (let ((foo check3)) (foo)))))))
=>
"--------------------\ntests > #f\nUnnamed test \nFAILURE\nname: check3\nlocation: unknown:?:?\nparams: \n--------------------\n0 success(es) 1 failure(s) 0 error(s) 1 test(s) run\n")
(run-tests (test-suite "tests" (let ((foo check3)) (foo))))))))
(test
(regexp-match
(regexp (format "~a.*~a"
(regexp-quote "--------------------\ntests > #f\nUnnamed test \nFAILURE\nname: check3\nlocation: ")
(regexp-quote "/collects/tests/rackunit/pr10950.rkt:14:51\nparams: \n--------------------\n0 success(es) 1 failure(s) 0 error(s) 1 test(s) run\n")))
output))

4
collects/tests/rackunit/standalone-test-case-test.rkt
View File

@ -12,8 +12,8 @@
(test-case "succeed" (check-eq? 1 1))
;; These should raise errors
(test-begin (error "Outta here!"))
(test-case "error" (error "Outta here!"))
(test-begin (error "First Outta here!"))
(test-case "error" (error "Second Outta here!"))
;; Thesse should raise failures
(test-begin (check-eq? 1 2))

37
collects/tests/rackunit/standalone.rkt Normal file
View File

@ -0,0 +1,37 @@
#lang racket/base
(require racket/runtime-path
rackunit
racket/path)
(define-runtime-path here ".")
(define collects
(normalize-path (build-path here ".." "..")))
(define (collect-trim bs)
(regexp-replace* (regexp-quote (path->bytes collects)) bs #"PLTHOME/collects"))
(define (require&catch path)
(define out-bs (open-output-bytes))
(define err-bs (open-output-bytes))
(parameterize ([current-output-port out-bs]
[current-error-port err-bs])
(dynamic-require path #f))
(close-output-port out-bs)
(close-output-port err-bs)
(values (collect-trim (get-output-bytes out-bs))
(collect-trim (get-output-bytes err-bs))))
(define-syntax-rule (test-file pth out err)
(begin
(define-runtime-module-path mod (file pth))
(define-values (cout cerr) (require&catch mod))
(check-equal? cout out)
(check-equal? cerr err)))
(test-file "standalone-check-test.rkt"
#"Oh HAI!\nI didn't run\n"
#"--------------------\nERROR\nOutta here!\n\n === context ===\nPLTHOME/collects/tests/rackunit/standalone-check-test.rkt:40:12: temp7\nPLTHOME/collects/rackunit/private/check.rkt:144:29\nPLTHOME/collects/racket/private/more-scheme.rkt:207:2: call-handled-body\nPLTHOME/collects/rackunit/private/check.rkt:77:0: top-level-check-around\n\n\n--------------------\n--------------------\nFAILURE\nname: check\nlocation: (#<path:PLTHOME/collects/tests/rackunit/standalone-check-test.rkt> 44 0 1344 17)\nexpression: (check = 1 2)\nparams: (#<procedure:=> 1 2)\nmessage: 0.0\n\n--------------------\n")
(test-file "standalone-test-case-test.rkt"
#"#t\n#t\n"
#"--------------------\nUnnamed test \nERROR\nFirst Outta here!\n\n === context ===\nPLTHOME/collects/racket/private/more-scheme.rkt:207:2: call-handled-body\n\n\n--------------------\n--------------------\nerror\nERROR\nSecond Outta here!\n\n === context ===\nPLTHOME/collects/racket/private/more-scheme.rkt:207:2: call-handled-body\n\n\n--------------------\n--------------------\nUnnamed test \nFAILURE\nname: check-eq?\nlocation: (#<path:PLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt> 19 12 520 15)\nexpression: (check-eq? 1 2)\nparams: (1 2)\nactual: 1\nexpected: 2\n\n--------------------\n--------------------\nfailure\nFAILURE\nname: check-eq?\nlocation: (#<path:PLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt> 20 21 558 15)\nexpression: (check-eq? 1 2)\nparams: (1 2)\nactual: 1\nexpected: 2\n\n--------------------\n")

28
collects/tests/rackunit/tl.rkt Normal file
View File

@ -0,0 +1,28 @@
#lang racket/base
(require rackunit)
;; test to make sure that the various check functions
;; return what they are promised to at the top-level
;; make drdr notice when a check prints something.
(current-output-port (current-error-port))
(check-equal? (check + 1 2) (void))
(check-equal? (check-eq? 1 1) (void))
(check-equal? (check-not-eq? #f #t) (void))
(check-equal? (check-eqv? (expt 2 100) (expt 2 100)) (void))
(check-equal? (check-not-eqv? (expt 2 100) 1) (void))
(check-equal? (check-equal? (list 1 2) (list 1 2)) (void))
(check-equal? (check-not-equal? (list 1 2) (list 2 1)) (void))
(check-equal? (check-pred not #f) (void))
(check-equal? (check-= 1.1 1.2 0.5) (void))
(check-equal? (check-true #t) (void))
(check-equal? (check-false #f) (void))
(check-equal? (check-not-false 3) (void))
(check-equal? (check-exn #rx"car" (λ () (car 1))) (void))
(check-equal? (check-not-exn (λ () 1)) (void))
(check-equal? (check-regexp-match #rx"a*b" "aaaaaaab") (void))