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

Sync up to catch my fix.

Browse Source 
svn: r18270
This commit is contained in:
Stevie Strickland 2010-02-22 20:58:53 +00:00
commit 815dd80923
8 changed files with 49 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/drscheme/private/main.ss
View File

@ -89,6 +89,8 @@
(finder:default-filters)))
(application:current-app-name (string-constant drscheme))
(preferences:set-default 'drscheme:logger-gui-tab-panel-level 0 (λ (x) (and (exact-integer? x) (<= 0 x 5))))
(preferences:set-default 'drscheme:saved-bug-reports
'()
(λ (ll)

2
collects/drscheme/private/unit.ss
View File

@ -1523,7 +1523,9 @@ module browser threading seems wrong.
[parent logger-panel]
[callback
(λ (tp evt)
(preferences:set 'drscheme:logger-gui-tab-panel-level (send logger-gui-tab-panel get-selection))
(update-logger-window #f))]))
(send logger-gui-tab-panel set-selection (preferences:get 'drscheme:logger-gui-tab-panel-level))
(new-logger-text)
(set! logger-gui-canvas
(new editor-canvas% [parent logger-gui-tab-panel] [editor logger-gui-text]))

4
collects/scheme/private/class-internal.ss
View File

@ -2577,10 +2577,10 @@
(make-vector method-width))]
[field-pub-width (class-field-pub-width cls)]
[field-ht (class-field-ht cls)]
[int-field-refs (if (null? (class/c-inherits ctc))
[int-field-refs (if (null? (class/c-inherit-fields ctc))
(class-int-field-refs cls)
(make-vector field-pub-width))]
[int-field-sets (if (null? (class/c-inherits ctc))
[int-field-sets (if (null? (class/c-inherit-fields ctc))
(class-int-field-sets cls)
(make-vector field-pub-width))]
[ext-field-refs (if (null? (class/c-fields ctc))

15
collects/schemeunit/private/test-suite.ss
View File

@ -83,15 +83,22 @@
(let ([the-name name]
[the-tests
(lambda (fdown fup fhere seed)
(define (run/inner x)
(cond [(schemeunit-test-suite? x)
(current-seed
(apply-test-suite x fdown fup fhere (current-seed)))]
[(list? x)
(for-each run/inner x)]
[else
(void)]))
(parameterize
([current-seed seed]
[current-test-case-around (test-suite-test-case-around fhere)]
[current-check-around (test-suite-check-around fhere)])
(let ([t test])
(if (schemeunit-test-suite? t)
(current-seed (apply-test-suite t fdown fup fhere (current-seed)))
t))
... (current-seed)))])
(run/inner t))
...
(current-seed)))])
(cond
[(not (string? the-name))
(raise-type-error 'test-suite "test-suite name as string" the-name)]

33
collects/schemeunit/scribblings/compound-testing.scrbl
View File

@ -61,15 +61,19 @@ Unlike a check or test case, a test suite is not immediately
run. Instead use one of the functions described in
@secref["ui"] or @secref["running"].
@defform[(test-suite name [#:before before-thunk] [#:after after-thunk] test ...)]{
@defform/subs[(test-suite name-expr maybe-before maybe-after test ...)
([maybe-before (code:line)
(code:line #:before before-thunk)]
[maybe-after (code:line)
(code:line #:after after-thunk)])
#:contracts ([name-expr string?])]{
Constructs a test suite with the given name and tests. The
tests may be test cases, constructed using
@scheme[test-begin] or @scheme[test-case], or other test
suites.
tests may be test cases, constructed using @scheme[test-begin] or
@scheme[test-case], or other test suites.
The @scheme[before-thunk] and @scheme[after-thunk] are
optional thunks (functions are no argument). They are run
optional thunks (functions with no argument). They are run
before and after the tests are run, respectively.
Unlike a check or test case, a test suite is not immediately
@ -87,9 +91,23 @@ finished.
#:after (lambda () (display "After"))
(test-case
"An example test"
(check-eq? 1 1)))
(check-eq? 1 1))
(test-suite "A nested test suite"
(test-case "Another test"
(check-< 1 2))))
]
@defproc[(make-test-suite [name string?]
[tests (listof (or/c test-case? test-suite?))]
[#:before before-thunk (-> any) void]
[#:after after-thunk (-> any) void])
test-suite?]{
Constructs a test suite with the given @scheme[name] containing the
given @scheme[tests]. Unlike the @scheme[test-suite] form, the tests
are represented as a list of test values.
}
@defproc[(test-suite? (obj any)) boolean?]{ True if
@scheme[obj] is a test suite, and false otherwise}
@ -118,6 +136,7 @@ the name @scheme["example-suite"]:
for is just like @scheme[define-test-suite], and in addition
it @scheme[provide]s the test suite.}
@;{
Finally, there is the @scheme[test-suite*] macro, which
defines a test suite and test cases using a shorthand
syntax:
@ -129,7 +148,7 @@ body expressions.
As far I know no-one uses this macro, so it might disappear
in future versions of SchemeUnit.}
}
@section{Compound Testing Evaluation Context}

2
collects/schemeunit/scribblings/misc.scrbl
View File

@ -17,5 +17,5 @@ especially when mixed with compiled code. Use at your own risk!
This example gets @scheme[make-failure-test], which is defined in a SchemeUnit test:
@schemeblock[
(require/expose schemeunit/check-test (make-failure-test))
(require/expose schemeunit/private/check-test (make-failure-test))
]

4
collects/schemeunit/scribblings/ui.scrbl
View File

@ -13,13 +13,13 @@ The textual UI is in the @schememodname[schemeunit/text-ui] module.
It is run via the @scheme[run-tests] function.
@defproc[(run-tests (test (or/c test-case? test-suite?))
(verbosity (symbols 'quite 'normal 'verbose) 'normal))
(verbosity (symbols 'quiet 'normal 'verbose) 'normal))
natural-number/c]{
The given @scheme[test] is run and the result of running it
output to the @scheme[current-output-port]. The output is
compatable with the (X)Emacs next-error command (as used,
for example, by (X)Emac's compile function)
for example, by (X)Emacs's compile function)
The optional @scheme[verbosity] is one of @scheme['quiet],
@scheme['normal], or @scheme['verbose]. Quiet output

4
collects/typed-scheme/private/type-contract.ss
View File

@ -136,7 +136,9 @@
(parameterize ([vars (cons (list n #'n* #'n*) (vars))])
#`(flat-rec-contract n* #,(t->c b)))))]
[(Value: #f) #'false/c]
[(Instance: (Class: _ _ (list (list name fcn) ...)))
[(Instance: (Class: _ _ (list (list name fcn) ...)))
#'(is-a?/c object%)
#;
(with-syntax ([(fcn-cnts ...) (map t->c fcn)]
[(names ...) name])
#'(object-contract (names fcn-cnts) ...))]