From 2e43467322349e956633a49d7667c964d0e0afc6 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 14 Aug 2010 21:32:40 -0500 Subject: [PATCH 01/15] a hack to work around what appears to be just a wrong way of doing things, but will ask Noel later. The basic problem is that (with-check-info* '() (lambda () ...whatever...)) can, in some cases, double the information that is recorded in a failed test case. Probably the right thing is to use a parameter or something instead of using continuation marks directly. original commit: 8ece97219a4e204af9459e27b676e62bd67fd52d --- collects/rackunit/private/check-info.rkt | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/collects/rackunit/private/check-info.rkt b/collects/rackunit/private/check-info.rkt index 127c2cb..de601b6 100644 --- a/collects/rackunit/private/check-info.rkt +++ b/collects/rackunit/private/check-info.rkt @@ -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) From 924dacc5ec5454189aa5b5b99eebb4adbdfc9995 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 26 Aug 2010 08:03:06 -0500 Subject: [PATCH 02/15] fixed out-of-date docs original commit: dd47006c3d26d95122d2e6ceff98b0b8be692362 --- collects/rackunit/scribblings/quick-start.scrbl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/collects/rackunit/scribblings/quick-start.scrbl b/collects/rackunit/scribblings/quick-start.scrbl index ed4c80f..75e9803 100644 --- a/collects/rackunit/scribblings/quick-start.scrbl +++ b/collects/rackunit/scribblings/quick-start.scrbl @@ -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 From 9d86dd48815d054e0b87c5a4f6fe4f8dd2eca334 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 26 Aug 2010 11:43:41 -0400 Subject: [PATCH 03/15] A bunch of typo fixes. Fixes PR11131. original commit: 28530203690a0a67a20e39bfce4677112c029302 --- collects/rackunit/scribblings/check.scrbl | 11 ++++++----- collects/rackunit/scribblings/philosophy.scrbl | 4 ++-- collects/rackunit/scribblings/quick-start.scrbl | 2 +- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/collects/rackunit/scribblings/check.scrbl b/collects/rackunit/scribblings/check.scrbl index 7ff509e..919406c 100644 --- a/collects/rackunit/scribblings/check.scrbl +++ b/collects/rackunit/scribblings/check.scrbl @@ -111,7 +111,8 @@ 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: +Here are two examples, one showing a test that succeeds, and one showing +a common error: @racketblock[ (check-exn exn:fail? @@ -129,7 +130,7 @@ Checks that @racket[thunk] does not raise any exceptions. The optional @racket[message] is included in the output if 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[(fail (message string? "")) #t]{This checks fails unconditionally. Good for creating test stubs that you intend 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?)) #t]{Checks that @racket[regexp] matches the @racket[string].} @@ -146,7 +147,7 @@ This check will fail: @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 @@ -156,7 +157,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 @@ -231,7 +232,7 @@ 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. diff --git a/collects/rackunit/scribblings/philosophy.scrbl b/collects/rackunit/scribblings/philosophy.scrbl index 4d0434c..5b439a0 100644 --- a/collects/rackunit/scribblings/philosophy.scrbl +++ b/collects/rackunit/scribblings/philosophy.scrbl @@ -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: diff --git a/collects/rackunit/scribblings/quick-start.scrbl b/collects/rackunit/scribblings/quick-start.scrbl index 75e9803..28f7ed5 100644 --- a/collects/rackunit/scribblings/quick-start.scrbl +++ b/collects/rackunit/scribblings/quick-start.scrbl @@ -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[ From 2d76bc1a24d9bbbaa65fd59abb1f7a2654355a24 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 27 Aug 2010 11:27:29 -0500 Subject: [PATCH 04/15] updated the docs to reflect that the various checks return void. Also added in some tests to that effect. original commit: c8e68e5e312d4dfc0e9ee12b378ed95396958650 --- collects/rackunit/scribblings/check.scrbl | 66 +++++++++++------------ collects/tests/rackunit/tl.rkt | 28 ++++++++++ 2 files changed, 60 insertions(+), 34 deletions(-) create mode 100644 collects/tests/rackunit/tl.rkt diff --git a/collects/rackunit/scribblings/check.scrbl b/collects/rackunit/scribblings/check.scrbl index 919406c..331d6e3 100644 --- a/collects/rackunit/scribblings/check.scrbl +++ b/collects/rackunit/scribblings/check.scrbl @@ -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,26 +19,12 @@ 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]{ - -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])]{ +@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?])]{ Checks that @racket[v1] is (not) @racket[eq?], @racket[eqv?], or @racket[equal?] to @racket[v2]. The @@ -49,7 +35,7 @@ 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?") @@ -57,7 +43,7 @@ For example, the following checks all fail: ] @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?]{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].} Here's an example that passes and an example that fails: @@ -67,7 +53,7 @@ Here's an example that passes and an example that fails: ] -@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 @@ -81,9 +67,9 @@ Here's an example that passes and an example that fails: (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] @@ -98,8 +84,8 @@ For example, the following checks all fail: ] -@defproc[(check-exn (exn-predicate (or/c (-> any (or/c #t #f)) regexp?)) (thunk (-> any)) (message string? "")) - #t]{ +@defproc[(check-exn (exn-predicate (or/c (-> any boolean?) regexp?)) (thunk (-> any)) (message string? "")) + void?]{ 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] @@ -124,16 +110,13 @@ a common error: (error 'hi "there")) ] -@defproc[(check-not-exn (thunk (-> any)) (message string? "")) #t]{ +@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.} -@defproc[(fail (message string? "")) #t]{This checks fails unconditionally. Good for creating test stubs that you intend 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?)) #t]{Checks that @racket[regexp] matches the @racket[string].} +@defproc[(check-regexp-match (regexp regexp?) (string string?)) void?]{Checks that @racket[regexp] matches the @racket[string].} The following check will succeed: @@ -143,7 +126,22 @@ This check will fail: @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) +] +} + +@defproc[(fail (message string? "")) void?]{This checks 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} diff --git a/collects/tests/rackunit/tl.rkt b/collects/tests/rackunit/tl.rkt new file mode 100644 index 0000000..5a88d0d --- /dev/null +++ b/collects/tests/rackunit/tl.rkt @@ -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)) From ac0f31b0b8e001ba864472099b1e876abde5803b Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Wed, 1 Sep 2010 09:54:38 -0600 Subject: [PATCH 05/15] added test-* shortcuts to docs, other edits original commit: c5e6580f025a902383d607d79ef3cf9367b27993 --- collects/rackunit/scribblings/check.scrbl | 162 ++++++++++++------ .../scribblings/compound-testing.scrbl | 30 +++- collects/rackunit/scribblings/overview.scrbl | 12 +- collects/rackunit/scribblings/rackunit.scrbl | 2 +- 4 files changed, 145 insertions(+), 61 deletions(-) diff --git a/collects/rackunit/scribblings/check.scrbl b/collects/rackunit/scribblings/check.scrbl index 331d6e3..accc865 100644 --- a/collects/rackunit/scribblings/check.scrbl +++ b/collects/rackunit/scribblings/check.scrbl @@ -26,10 +26,10 @@ can create your own checks using @racket[define-check]. [(check-equal? (v1 any) (v2 any) (message string? "")) void?] [(check-not-equal? (v1 any) (v2 any) (message string? "")) void?])]{ -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: @@ -41,39 +41,52 @@ For example, the following checks all fail: (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? "")) - void?]{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? "")) void?]{ +@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? "")) 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: @@ -82,49 +95,76 @@ 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? "")) +@defproc[(check-exn (exn-predicate (or/c (-> any boolean?) regexp?)) + (thunk (-> any)) (message string? "")) void?]{ -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.} -Here are two examples, one showing a test that succeeds, and one showing -a common error: +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. + +For example, the following check succeeds: @racketblock[ (check-exn exn:fail? (lambda () (raise (make-exn "Hi there" (current-continuation-marks))))) +] + +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[(check-regexp-match (regexp regexp?) (string string?)) void?]{Checks that @racket[regexp] matches the @racket[string].} +@defproc[(check-regexp-match (regexp regexp?) + (string string?)) + void?]{ -The following check will succeed: +Checks that @racket[regexp] matches the @racket[string]. -@racketblock[(check-regexp-match "a+bba" "aaaaaabba")] -This check will fail: +For example, the following check succeeds: + +@racketblock[ + (check-regexp-match "a+bba" "aaaaaabba") +] + +The following check fails: + +@racketblock[ + (check-regexp-match "a+bba" "aaaabbba") +] +} -@racketblock[(check-regexp-match "a+bba" "aaaabbba")] @defproc[(check (op (-> any any any)) (v1 any) @@ -132,16 +172,31 @@ This check will fail: (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. +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 checks fails unconditionally. Good for creating test stubs that you intend to fill out later. The optional @racket[message] is included in the output.} +@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} @@ -189,8 +244,7 @@ When this check fails the message @verbatim{time: } -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 ...)]{ @@ -214,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. @@ -235,18 +288,16 @@ 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 ...)]{ @@ -258,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) @@ -309,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 @@ -318,8 +366,12 @@ 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} diff --git a/collects/rackunit/scribblings/compound-testing.scrbl b/collects/rackunit/scribblings/compound-testing.scrbl index 8b5016e..084059d 100644 --- a/collects/rackunit/scribblings/compound-testing.scrbl +++ b/collects/rackunit/scribblings/compound-testing.scrbl @@ -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} diff --git a/collects/rackunit/scribblings/overview.scrbl b/collects/rackunit/scribblings/overview.scrbl index bc3aec4..6c05a19 100644 --- a/collects/rackunit/scribblings/overview.scrbl +++ b/collects/rackunit/scribblings/overview.scrbl @@ -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.} ] diff --git a/collects/rackunit/scribblings/rackunit.scrbl b/collects/rackunit/scribblings/rackunit.scrbl index c8bdc2b..fb81a8a 100644 --- a/collects/rackunit/scribblings/rackunit.scrbl +++ b/collects/rackunit/scribblings/rackunit.scrbl @@ -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, From 329b70c143a72e38b5c0b08f616bba25cf1fca74 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Wed, 1 Sep 2010 15:47:52 -0600 Subject: [PATCH 06/15] separated "internals & extension API" from main "RackUnit API" original commit: 3097bb85b76ee3741bd4c51f713ce90fe799f2ca --- collects/rackunit/scribblings/api.scrbl | 3 - collects/rackunit/scribblings/check.scrbl | 24 -- .../scribblings/compound-testing.scrbl | 35 --- collects/rackunit/scribblings/internals.scrbl | 271 ++++++++++++++++++ collects/rackunit/scribblings/misc.scrbl | 5 +- collects/rackunit/scribblings/rackunit.scrbl | 1 + 6 files changed, 276 insertions(+), 63 deletions(-) create mode 100644 collects/rackunit/scribblings/internals.scrbl diff --git a/collects/rackunit/scribblings/api.scrbl b/collects/rackunit/scribblings/api.scrbl index 75dee08..32665de 100644 --- a/collects/rackunit/scribblings/api.scrbl +++ b/collects/rackunit/scribblings/api.scrbl @@ -12,6 +12,3 @@ @include-section["control-flow.scrbl"] @include-section["misc.scrbl"] @include-section["ui.scrbl"] -@include-section["running-tests.scrbl"] - - diff --git a/collects/rackunit/scribblings/check.scrbl b/collects/rackunit/scribblings/check.scrbl index accc865..18895d8 100644 --- a/collects/rackunit/scribblings/check.scrbl +++ b/collects/rackunit/scribblings/check.scrbl @@ -372,27 +372,3 @@ 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)]. -} diff --git a/collects/rackunit/scribblings/compound-testing.scrbl b/collects/rackunit/scribblings/compound-testing.scrbl index 084059d..6618454 100644 --- a/collects/rackunit/scribblings/compound-testing.scrbl +++ b/collects/rackunit/scribblings/compound-testing.scrbl @@ -178,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.} diff --git a/collects/rackunit/scribblings/internals.scrbl b/collects/rackunit/scribblings/internals.scrbl new file mode 100644 index 0000000..0e58bcd --- /dev/null +++ b/collects/rackunit/scribblings/internals.scrbl @@ -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. diff --git a/collects/rackunit/scribblings/misc.scrbl b/collects/rackunit/scribblings/misc.scrbl index 2b0c3f3..dcd1803 100644 --- a/collects/rackunit/scribblings/misc.scrbl +++ b/collects/rackunit/scribblings/misc.scrbl @@ -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! diff --git a/collects/rackunit/scribblings/rackunit.scrbl b/collects/rackunit/scribblings/rackunit.scrbl index fb81a8a..16da247 100644 --- a/collects/rackunit/scribblings/rackunit.scrbl +++ b/collects/rackunit/scribblings/rackunit.scrbl @@ -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"] From 96265f3a3280225f8ae201320af3dadca8d5ea76 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Fri, 3 Sep 2010 05:39:27 -0600 Subject: [PATCH 07/15] removed useless requires original commit: fff692309edd4752c82cf4adab4c45a930d525ef --- collects/rackunit/private/gui/gui.rkt | 2 +- collects/rackunit/private/gui/model2rml.rkt | 3 ++- collects/rackunit/private/gui/rml.rkt | 2 +- collects/rackunit/private/gui/view.rkt | 2 +- collects/rackunit/tool.rkt | 2 +- 5 files changed, 6 insertions(+), 5 deletions(-) diff --git a/collects/rackunit/private/gui/gui.rkt b/collects/rackunit/private/gui/gui.rkt index 61050b2..2904ac8 100644 --- a/collects/rackunit/private/gui/gui.rkt +++ b/collects/rackunit/private/gui/gui.rkt @@ -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" diff --git a/collects/rackunit/private/gui/model2rml.rkt b/collects/rackunit/private/gui/model2rml.rkt index fb10840..f874cf3 100644 --- a/collects/rackunit/private/gui/model2rml.rkt +++ b/collects/rackunit/private/gui/model2rml.rkt @@ -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" diff --git a/collects/rackunit/private/gui/rml.rkt b/collects/rackunit/private/gui/rml.rkt index 596f028..eea40bf 100644 --- a/collects/rackunit/private/gui/rml.rkt +++ b/collects/rackunit/private/gui/rml.rkt @@ -1,7 +1,7 @@ #lang racket/base (require racket/class unstable/class-iop - racket/gui + racket/gui/base framework "interfaces.rkt") diff --git a/collects/rackunit/private/gui/view.rkt b/collects/rackunit/private/gui/view.rkt index 0372b99..79315f5 100644 --- a/collects/rackunit/private/gui/view.rkt +++ b/collects/rackunit/private/gui/view.rkt @@ -3,7 +3,7 @@ unstable/class-iop unstable/gui/notify racket/list - racket/gui + racket/gui/base framework mrlib/hierlist "interfaces.rkt" diff --git a/collects/rackunit/tool.rkt b/collects/rackunit/tool.rkt index 20bfd5e..ba75e1a 100644 --- a/collects/rackunit/tool.rkt +++ b/collects/rackunit/tool.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/class - racket/gui + racket/gui/base framework drscheme/tool racket/unit From 9f083e5d522291caff2f1ef9d15cd1461a9d7091 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Fri, 3 Sep 2010 16:24:03 -0600 Subject: [PATCH 08/15] added data/gvector, docs (need tests) original commit: 5a8d2f010e9e7858ff8c32ffadf73adac11cd98a --- collects/rackunit/private/gui/model.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/rackunit/private/gui/model.rkt b/collects/rackunit/private/gui/model.rkt index 110efad..74e25cc 100644 --- a/collects/rackunit/private/gui/model.rkt +++ b/collects/rackunit/private/gui/model.rkt @@ -2,7 +2,7 @@ (require racket/class unstable/class-iop racket/list - "gvector.rkt" + data/gvector "../base.rkt" "interfaces.rkt" "cache-box.rkt") From a23ed343534cedc243cbd15b2780718944d122e9 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Mon, 25 Oct 2010 14:40:52 -0600 Subject: [PATCH 09/15] Changed rackunit top-level test output to stderr Made test-begin accept zero expressions Closes PR 11331 original commit: f17d0001c48307c81d2057b0a9bd214130bbe6c8 --- collects/rackunit/private/check.rkt | 56 +++++++++++++---------- collects/rackunit/private/test-case.rkt | 61 +++++++++++++------------ 2 files changed, 65 insertions(+), 52 deletions(-) diff --git a/collects/rackunit/private/check.rkt b/collects/rackunit/private/check.rkt index 148d33f..f4bb83d 100644 --- a/collects/rackunit/private/check.rkt +++ b/collects/rackunit/private/check.rkt @@ -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 diff --git a/collects/rackunit/private/test-case.rkt b/collects/rackunit/private/test-case.rkt index ff1f578..36f18b2 100644 --- a/collects/rackunit/private/test-case.rkt +++ b/collects/rackunit/private/test-case.rkt @@ -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 ...))))) - From 093592d371d4d09f374aacb8d0262b20ea0daef1 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 29 Oct 2010 22:35:20 -0600 Subject: [PATCH 10/15] Wrapping standalone tests so that no stderr is produced original commit: 690ed259adca4d58e958370078d25524f3037748 --- collects/tests/rackunit/standalone.rkt | 35 ++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 collects/tests/rackunit/standalone.rkt diff --git a/collects/tests/rackunit/standalone.rkt b/collects/tests/rackunit/standalone.rkt new file mode 100644 index 0000000..e645595 --- /dev/null +++ b/collects/tests/rackunit/standalone.rkt @@ -0,0 +1,35 @@ +#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)) + (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/rackunit/private/check.rkt:144:29\nPLTHOME/collects/rackunit/private/check.rkt:77:0: top-level-check-around\nPLTHOME/collects/tests/rackunit/standalone-check-test.rkt: [running body]\nPLTHOME/collects/tests/rackunit/standalone.rkt: [running body]\n\n\n--------------------\n--------------------\nFAILURE\nname: check\nlocation: (# 44 0 1344 17)\nexpression: (check = 1 2)\nparams: (# 1 2)\nmessage: 0.0\n\n--------------------\n") + +(test-file "standalone-test-case-test.rkt" + #"#t\n#t\n" + #"--------------------\nUnnamed test \nERROR\nOutta here!\n\n === context ===\nPLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt: [running body]\n\n\n--------------------\n--------------------\nerror\nERROR\nOutta here!\n\n--------------------\n--------------------\nUnnamed test \nFAILURE\nname: check-eq?\nlocation: (# 19 12 507 15)\nexpression: (check-eq? 1 2)\nparams: (1 2)\nactual: 1\nexpected: 2\n\n--------------------\n--------------------\nfailure\nFAILURE\nname: check-eq?\nlocation: (# 20 21 545 15)\nexpression: (check-eq? 1 2)\nparams: (1 2)\nactual: 1\nexpected: 2\n\n--------------------\n") + From 213dd90d4a3f844e170ce67a7f1583d29b8f09ce Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Mon, 1 Nov 2010 10:20:31 -0600 Subject: [PATCH 11/15] Maybe the DrDr error is related to flushing? original commit: 7c452ad7ea29348159f8076099a7d985f5e6d901 --- collects/tests/rackunit/standalone.rkt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/collects/tests/rackunit/standalone.rkt b/collects/tests/rackunit/standalone.rkt index e645595..689b87e 100644 --- a/collects/tests/rackunit/standalone.rkt +++ b/collects/tests/rackunit/standalone.rkt @@ -15,6 +15,8 @@ (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)))) From 166c31f324dc09383218b760afa7187921e07d1d Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 2 Nov 2010 15:44:00 -0600 Subject: [PATCH 12/15] The stacks appear to be different, so maybe the JIT is different on Linux and disabling it will get stable output? original commit: 6d2042fbd9bacd5acf4946afaec50bf0ba8b7f6b --- collects/tests/rackunit/standalone-test-case-test.rkt | 4 ++-- collects/tests/rackunit/standalone.rkt | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/collects/tests/rackunit/standalone-test-case-test.rkt b/collects/tests/rackunit/standalone-test-case-test.rkt index 3398469..78f9abc 100644 --- a/collects/tests/rackunit/standalone-test-case-test.rkt +++ b/collects/tests/rackunit/standalone-test-case-test.rkt @@ -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)) diff --git a/collects/tests/rackunit/standalone.rkt b/collects/tests/rackunit/standalone.rkt index 689b87e..78d4a1a 100644 --- a/collects/tests/rackunit/standalone.rkt +++ b/collects/tests/rackunit/standalone.rkt @@ -29,9 +29,9 @@ (test-file "standalone-check-test.rkt" #"Oh HAI!\nI didn't run\n" - #"--------------------\nERROR\nOutta here!\n\n === context ===\nPLTHOME/collects/rackunit/private/check.rkt:144:29\nPLTHOME/collects/rackunit/private/check.rkt:77:0: top-level-check-around\nPLTHOME/collects/tests/rackunit/standalone-check-test.rkt: [running body]\nPLTHOME/collects/tests/rackunit/standalone.rkt: [running body]\n\n\n--------------------\n--------------------\nFAILURE\nname: check\nlocation: (# 44 0 1344 17)\nexpression: (check = 1 2)\nparams: (# 1 2)\nmessage: 0.0\n\n--------------------\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: (# 44 0 1344 17)\nexpression: (check = 1 2)\nparams: (# 1 2)\nmessage: 0.0\n\n--------------------\n") (test-file "standalone-test-case-test.rkt" #"#t\n#t\n" - #"--------------------\nUnnamed test \nERROR\nOutta here!\n\n === context ===\nPLTHOME/collects/tests/rackunit/standalone-test-case-test.rkt: [running body]\n\n\n--------------------\n--------------------\nerror\nERROR\nOutta here!\n\n--------------------\n--------------------\nUnnamed test \nFAILURE\nname: check-eq?\nlocation: (# 19 12 507 15)\nexpression: (check-eq? 1 2)\nparams: (1 2)\nactual: 1\nexpected: 2\n\n--------------------\n--------------------\nfailure\nFAILURE\nname: check-eq?\nlocation: (# 20 21 545 15)\nexpression: (check-eq? 1 2)\nparams: (1 2)\nactual: 1\nexpected: 2\n\n--------------------\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: (# 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: (# 20 21 558 15)\nexpression: (check-eq? 1 2)\nparams: (1 2)\nactual: 1\nexpected: 2\n\n--------------------\n") From 7604a3aa388de7ef69e694837f357c599153cc8d Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 23 Nov 2010 12:34:26 -0600 Subject: [PATCH 13/15] rackunit: bring back source locations for check-equal? used in 'ho' position original commit: fd53321823d54733d6d5e4ff93893c406000dfe0 --- collects/rackunit/private/check.rkt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/collects/rackunit/private/check.rkt b/collects/rackunit/private/check.rkt index f4bb83d..7574904 100644 --- a/collects/rackunit/private/check.rkt +++ b/collects/rackunit/private/check.rkt @@ -171,7 +171,9 @@ (name (identifier? #'name) (syntax/loc stx - check-secret-name))))) + (λ (formal ...) (check-secret-name formal ... + #:location (quote loc) + #:expression (quote (name actual ...))))))))) )))))) (define-syntax define-simple-check From 7bffe12841ce9ff7dcd38c278499859c6e958214 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 25 Nov 2010 11:11:27 -0500 Subject: [PATCH 14/15] Fixing error introduce by Robby in fd53321 original commit: 267d2293c0d8e4b9037c6116ef59331e511b2e72 --- collects/rackunit/private/check.rkt | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/collects/rackunit/private/check.rkt b/collects/rackunit/private/check.rkt index 7574904..3a059a4 100644 --- a/collects/rackunit/private/check.rkt +++ b/collects/rackunit/private/check.rkt @@ -171,9 +171,15 @@ (name (identifier? #'name) (syntax/loc stx - (λ (formal ...) (check-secret-name formal ... - #:location (quote loc) - #:expression (quote (name actual ...))))))))) + (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 From 8dedfd28f398e085d76e70e580e9a2632a25246c Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Thu, 25 Nov 2010 11:38:43 -0500 Subject: [PATCH 15/15] This test relied on the old source location losing behavior of Rackunit original commit: e081af2aef7e2b98c6c8671f38810bfbcc88a079 --- collects/tests/rackunit/pr10950.rkt | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/collects/tests/rackunit/pr10950.rkt b/collects/tests/rackunit/pr10950.rkt index 1663aaa..c99dd9d 100644 --- a/collects/tests/rackunit/pr10950.rkt +++ b/collects/tests/rackunit/pr10950.rkt @@ -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") \ No newline at end of file + (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)) \ No newline at end of file