raco test: responsible-party and varying-party logging, lock names
The responsible party for a test defaults to the enclosing package's author. Also, add support for a `test-timeouts` fallback in "info.rkt".
This commit is contained in:
Matthew Flatt
parent
796f82e4ad
commit
59cbefe47a
|
|
@ -14,6 +14,7 @@
|
|||
racket/system
|
||||
rackunit/log
|
||||
pkg/lib
|
||||
pkg/path
|
||||
setup/collects
|
||||
setup/getinfo)
|
||||
|
||||
|
|
@ -37,6 +38,13 @@
|
|||
|
||||
(define single-file? #t)
|
||||
|
||||
(define lock-file-dir (or (getenv "PLTLOCKDIR")
|
||||
(find-system-path 'temp-dir)))
|
||||
(define max-lock-delay (or (let ([n (string->number (or (getenv "PLTLOCKTIME") ""))])
|
||||
(and (real? n)
|
||||
n))
|
||||
(* 4 60 60))) ; default: wait at most 4 hours
|
||||
|
||||
;; Stub for running a test in a process:
|
||||
(module process racket/base
|
||||
(require rackunit/log)
|
||||
|
|
@ -88,11 +96,15 @@
|
|||
;; Run each test in its own place or process, and collect both test
|
||||
;; results and whether any output went to stderr.
|
||||
(define (dynamic-require-elsewhere p d args
|
||||
#:id id
|
||||
#:mode [mode (or default-mode
|
||||
(if single-file?
|
||||
'direct
|
||||
'process))]
|
||||
#:timeout [timeout default-timeout])
|
||||
#:timeout timeout
|
||||
#:responsible responsible
|
||||
#:lock-name lock-name
|
||||
#:random? random?)
|
||||
(define c (make-custodian))
|
||||
(define timeout? #f)
|
||||
(with-handlers ([exn:fail? (lambda (exn)
|
||||
|
|
@ -102,111 +114,131 @@
|
|||
(extract-file-name p)
|
||||
(exn-message exn)))
|
||||
(summary 1 1 (current-label) #f (if timeout? 1 0)))])
|
||||
(define e (open-output-bytes))
|
||||
(define (go)
|
||||
(define e (open-output-bytes))
|
||||
|
||||
(define stdout (if quiet-program?
|
||||
(open-output-nowhere)
|
||||
(current-output-port)))
|
||||
(define stderr (if quiet-program?
|
||||
e
|
||||
(if check-stderr?
|
||||
(tee-output-port (current-error-port) e)
|
||||
(current-error-port))))
|
||||
(define stdout (if quiet-program?
|
||||
(open-output-nowhere)
|
||||
(current-output-port)))
|
||||
(define stderr (if quiet-program?
|
||||
e
|
||||
(if check-stderr?
|
||||
(tee-output-port (current-error-port) e)
|
||||
(current-error-port))))
|
||||
|
||||
(define-values (result-code test-results)
|
||||
(case mode
|
||||
[(direct)
|
||||
(define pre (test-log #:display? #f #:exit? #f))
|
||||
(define done? #f)
|
||||
(define t
|
||||
(parameterize ([current-output-port stdout]
|
||||
[current-error-port stderr]
|
||||
[current-command-line-arguments (list->vector args)])
|
||||
(thread
|
||||
(lambda ()
|
||||
(dynamic-require p d)
|
||||
((executable-yield-handler) 0)
|
||||
(set! done? #t)))))
|
||||
(unless (thread? (sync/timeout timeout t))
|
||||
(set! timeout? #t)
|
||||
(error 'test "timeout after ~a seconds" timeout))
|
||||
(unless done?
|
||||
(error 'test "test raised an exception"))
|
||||
(define post (test-log #:display? #f #:exit? #f))
|
||||
(values 0
|
||||
(cons (- (car post) (car pre))
|
||||
(- (cdr post) (cdr pre))))]
|
||||
[(place)
|
||||
;; Start the test place:
|
||||
(define-values (pl in out/f err/f)
|
||||
(parameterize ([current-custodian c])
|
||||
(dynamic-place* '(submod compiler/commands/test place)
|
||||
'go
|
||||
#:in (current-input-port)
|
||||
#:out stdout
|
||||
#:err stderr)))
|
||||
|
||||
;; Send the module path to test:
|
||||
(place-channel-put pl (list p d (current-directory) args))
|
||||
(unless quiet?
|
||||
(when responsible
|
||||
(fprintf stdout "raco test:~a @(test-responsible '~s)\n"
|
||||
id
|
||||
responsible))
|
||||
(when random?
|
||||
(fprintf stdout "raco test:~a @(test-random #t)\n"
|
||||
id)))
|
||||
|
||||
(define-values (result-code test-results)
|
||||
(case mode
|
||||
[(direct)
|
||||
(define pre (test-log #:display? #f #:exit? #f))
|
||||
(define done? #f)
|
||||
(define t
|
||||
(parameterize ([current-output-port stdout]
|
||||
[current-error-port stderr]
|
||||
[current-command-line-arguments (list->vector args)])
|
||||
(thread
|
||||
(lambda ()
|
||||
(dynamic-require p d)
|
||||
((executable-yield-handler) 0)
|
||||
(set! done? #t)))))
|
||||
(unless (thread? (sync/timeout timeout t))
|
||||
(set! timeout? #t)
|
||||
(error 'test "timeout after ~a seconds" timeout))
|
||||
(unless done?
|
||||
(error 'test "test raised an exception"))
|
||||
(define post (test-log #:display? #f #:exit? #f))
|
||||
(values 0
|
||||
(cons (- (car post) (car pre))
|
||||
(- (cdr post) (cdr pre))))]
|
||||
[(place)
|
||||
;; Start the test place:
|
||||
(define-values (pl in out/f err/f)
|
||||
(parameterize ([current-custodian c])
|
||||
(dynamic-place* '(submod compiler/commands/test place)
|
||||
'go
|
||||
#:in (current-input-port)
|
||||
#:out stdout
|
||||
#:err stderr)))
|
||||
|
||||
;; Send the module path to test:
|
||||
(place-channel-put pl (list p d (current-directory) args))
|
||||
|
||||
;; Wait for the place to finish:
|
||||
(unless (sync/timeout timeout (place-dead-evt pl))
|
||||
(set! timeout? #t)
|
||||
(error 'test "timeout after ~a seconds" timeout))
|
||||
;; Wait for the place to finish:
|
||||
(unless (sync/timeout timeout (place-dead-evt pl))
|
||||
(set! timeout? #t)
|
||||
(error 'test "timeout after ~a seconds" timeout))
|
||||
|
||||
;; Get result code and test results:
|
||||
(values (place-wait pl)
|
||||
(sync/timeout 0 pl))]
|
||||
[(process)
|
||||
(define tmp-file (make-temporary-file))
|
||||
(define ps
|
||||
(parameterize ([current-output-port stdout]
|
||||
[current-error-port stderr]
|
||||
[current-subprocess-custodian-mode 'kill]
|
||||
[current-custodian c])
|
||||
(apply process*/ports
|
||||
stdout
|
||||
(current-input-port)
|
||||
stderr
|
||||
(find-exe)
|
||||
"-l"
|
||||
"racket/base"
|
||||
"-e"
|
||||
"(dynamic-require '(submod compiler/commands/test process) #f)"
|
||||
tmp-file
|
||||
(format "~s" (normalize-module-path p))
|
||||
(format "~s" d)
|
||||
args)))
|
||||
(define proc (list-ref ps 4))
|
||||
|
||||
(unless (sync/timeout timeout (thread (lambda () (proc 'wait))))
|
||||
(set! timeout? #t)
|
||||
(error 'test "timeout after ~a seconds" timeout))
|
||||
;; Get result code and test results:
|
||||
(values (place-wait pl)
|
||||
(sync/timeout 0 pl))]
|
||||
[(process)
|
||||
(define tmp-file (make-temporary-file))
|
||||
(define ps
|
||||
(parameterize ([current-output-port stdout]
|
||||
[current-error-port stderr]
|
||||
[current-subprocess-custodian-mode 'kill]
|
||||
[current-custodian c])
|
||||
(apply process*/ports
|
||||
stdout
|
||||
(current-input-port)
|
||||
stderr
|
||||
(find-exe)
|
||||
"-l"
|
||||
"racket/base"
|
||||
"-e"
|
||||
"(dynamic-require '(submod compiler/commands/test process) #f)"
|
||||
tmp-file
|
||||
(format "~s" (normalize-module-path p))
|
||||
(format "~s" d)
|
||||
args)))
|
||||
(define proc (list-ref ps 4))
|
||||
|
||||
(unless (sync/timeout timeout (thread (lambda () (proc 'wait))))
|
||||
(set! timeout? #t)
|
||||
(error 'test "timeout after ~a seconds" timeout))
|
||||
|
||||
(define results
|
||||
(with-handlers ([exn:fail:read? (lambda () #f)])
|
||||
(call-with-input-file* tmp-file read)))
|
||||
|
||||
(values (proc 'exit-code)
|
||||
(and (pair? results)
|
||||
(exact-positive-integer? (car results))
|
||||
(exact-positive-integer? (cdr results))
|
||||
results))]))
|
||||
|
||||
;; Shut down the place/process (usually a no-op unless it timed out):
|
||||
(custodian-shutdown-all c)
|
||||
(define results
|
||||
(with-handlers ([exn:fail:read? (lambda () #f)])
|
||||
(call-with-input-file* tmp-file read)))
|
||||
|
||||
(values (proc 'exit-code)
|
||||
(and (pair? results)
|
||||
(exact-positive-integer? (car results))
|
||||
(exact-positive-integer? (cdr results))
|
||||
results))]))
|
||||
|
||||
;; Shut down the place/process (usually a no-op unless it timed out):
|
||||
(custodian-shutdown-all c)
|
||||
|
||||
;; Check results:
|
||||
(when check-stderr?
|
||||
(unless (equal? #"" (get-output-bytes e))
|
||||
(error 'test "non-empty stderr: ~e" (get-output-bytes e))))
|
||||
(unless (zero? result-code)
|
||||
(error 'test "non-zero exit: ~e" result-code))
|
||||
(cond
|
||||
[test-results
|
||||
(summary (car test-results) (cdr test-results) (current-label) #f 0)]
|
||||
[else
|
||||
(summary 0 1 (current-label) #f 0)])))
|
||||
;; Check results:
|
||||
(when check-stderr?
|
||||
(unless (equal? #"" (get-output-bytes e))
|
||||
(error 'test "non-empty stderr: ~e" (get-output-bytes e))))
|
||||
(unless (zero? result-code)
|
||||
(error 'test "non-zero exit: ~e" result-code))
|
||||
(cond
|
||||
[test-results
|
||||
(summary (car test-results) (cdr test-results) (current-label) #f 0)]
|
||||
[else
|
||||
(summary 0 1 (current-label) #f 0)]))
|
||||
|
||||
;; Serialize the above with a lock, if any:
|
||||
(if lock-name
|
||||
(call-with-file-lock/timeout
|
||||
#:max-delay max-lock-delay
|
||||
(build-path lock-file-dir lock-name)
|
||||
'exclusive
|
||||
go
|
||||
(lambda () (error 'test "could not obtain lock: ~s" lock-name)))
|
||||
(go))))
|
||||
|
||||
;; For recording stderr while also propagating to the original stderr:
|
||||
(define (tee-output-port p1 p2)
|
||||
|
|
@ -242,7 +274,14 @@
|
|||
(append mod '(config))
|
||||
(error 'test "cannot add test-config submodule to path: ~s" mod)))
|
||||
|
||||
(define (dynamic-require* p d args try-config?)
|
||||
(define (dynamic-require* p d
|
||||
#:id id
|
||||
#:try-config? try-config?
|
||||
#:args args
|
||||
#:timeout timeout
|
||||
#:responsible responsible
|
||||
#:lock-name lock-name
|
||||
#:random? random?)
|
||||
(define lookup
|
||||
(or (cond
|
||||
[(not try-config?) #f]
|
||||
|
|
@ -252,10 +291,17 @@
|
|||
(lambda (what get-default) (get-default))))
|
||||
(dynamic-require-elsewhere
|
||||
p d args
|
||||
#:id id
|
||||
#:responsible (lookup 'responsible
|
||||
(lambda () responsible))
|
||||
#:timeout (if default-timeout
|
||||
(lookup 'timeout
|
||||
(lambda () default-timeout))
|
||||
+inf.0)))
|
||||
(lambda () timeout))
|
||||
+inf.0)
|
||||
#:lock-name (lookup 'lock-name
|
||||
(lambda () lock-name))
|
||||
#:random? (lookup 'random?
|
||||
(lambda () random?))))
|
||||
|
||||
(define current-label (make-parameter "???"))
|
||||
(struct summary (failed total label body-res timeout))
|
||||
|
|
@ -370,7 +416,14 @@
|
|||
|
||||
;; Perform test of one module (in parallel, as allowed by
|
||||
;; `task-sema`):
|
||||
(define (test-module p mod args try-config? #:sema continue-sema)
|
||||
(define (test-module p mod
|
||||
#:sema continue-sema
|
||||
#:try-config? try-config?
|
||||
#:args [args '()]
|
||||
#:timeout [timeout +inf.0]
|
||||
#:responsible [responsible #f]
|
||||
#:lock-name [lock-name #f]
|
||||
#:random? [random? #f])
|
||||
(call-with-semaphore
|
||||
task-sema ; limits parallelism
|
||||
(lambda ()
|
||||
|
|
@ -397,7 +450,16 @@
|
|||
(flush-output))
|
||||
id)))
|
||||
(begin0
|
||||
(dynamic-require* mod 0 args try-config?)
|
||||
(dynamic-require* mod 0
|
||||
#:id (if (jobs . <= . 1)
|
||||
""
|
||||
(format " ~a" id))
|
||||
#:try-config? try-config?
|
||||
#:args args
|
||||
#:timeout timeout
|
||||
#:responsible responsible
|
||||
#:lock-name lock-name
|
||||
#:random? random?)
|
||||
(call-with-semaphore
|
||||
ids-lock
|
||||
(lambda ()
|
||||
|
|
@ -416,7 +478,9 @@
|
|||
(cond
|
||||
[(directory-exists? p)
|
||||
(set! single-file? #f)
|
||||
(if (omit-path? (path->directory-path p))
|
||||
(define dir-p (path->directory-path p))
|
||||
(check-info dir-p)
|
||||
(if (omit-path? dir-p)
|
||||
(summary 0 0 #f null 0)
|
||||
(with-summary
|
||||
`(directory ,p)
|
||||
|
|
@ -431,13 +495,29 @@
|
|||
(or (not check-suffix?)
|
||||
(regexp-match rx:default-suffixes p)
|
||||
(get-cmdline p #f))
|
||||
(not (omit-path? p)))
|
||||
(define args (get-cmdline p))
|
||||
(begin (check-info p)
|
||||
(not (omit-path? p))))
|
||||
;; The above `omit-path?` loads "info.rkt" files
|
||||
(define norm-p (normalize-info-path p))
|
||||
(define args (get-cmdline norm-p))
|
||||
(define timeout (get-timeout norm-p))
|
||||
(define lock-name (get-lock-name norm-p))
|
||||
(define responsible (get-responsible norm-p))
|
||||
(define random? (get-random norm-p))
|
||||
(parameterize ([current-directory (let-values ([(base name dir?) (split-path p)])
|
||||
(if (path? base)
|
||||
base
|
||||
(current-directory)))])
|
||||
(define file-name (file-name-from-path p))
|
||||
(define (test-this-module mod try-config?)
|
||||
(test-module p mod
|
||||
#:try-config? try-config?
|
||||
#:sema continue-sema
|
||||
#:args args
|
||||
#:timeout timeout
|
||||
#:responsible responsible
|
||||
#:lock-name lock-name
|
||||
#:random? random?))
|
||||
(with-summary
|
||||
`(file ,p)
|
||||
(let ([something-wasnt-declared? #f]
|
||||
|
|
@ -454,13 +534,13 @@
|
|||
#f]
|
||||
[(module-declared? mod #t)
|
||||
(set! did-one? #t)
|
||||
(test-module p mod args #t #:sema continue-sema)]
|
||||
(test-this-module mod #t)]
|
||||
[else
|
||||
(set! something-wasnt-declared? #t)
|
||||
#f]))
|
||||
(list
|
||||
(and (and run-anyways? something-wasnt-declared?)
|
||||
(test-module p file-name args #f #:sema continue-sema))))))))]
|
||||
(test-this-module file-name #f))))))))]
|
||||
[(not (file-exists? p))
|
||||
(error 'test "given path ~e does not exist" p)]
|
||||
[else (summary 0 0 #f null 0)])]))
|
||||
|
|
@ -559,11 +639,16 @@
|
|||
|
||||
(define omit-paths (make-hash))
|
||||
(define command-line-arguments (make-hash))
|
||||
(define timeouts (make-hash))
|
||||
(define lock-names (make-hash))
|
||||
(define responsibles (make-hash))
|
||||
(define randoms (make-hash))
|
||||
|
||||
(define pkg-cache (make-hash))
|
||||
(define collects-cache (make-hash))
|
||||
(define info-done (make-hash))
|
||||
|
||||
(define (check-info p check-up?)
|
||||
(define (check-dir-info p)
|
||||
(define-values (base name dir?) (split-path p))
|
||||
(define dir (normalize-info-path
|
||||
(if dir?
|
||||
|
|
@ -572,60 +657,91 @@
|
|||
(path->complete-path base)
|
||||
(current-directory)))))
|
||||
|
||||
(when (and check-up? (not dir?))
|
||||
;; Check enclosing collection
|
||||
(define c (path->collects-relative p #:cache collects-cache))
|
||||
(when (list? c)
|
||||
(check-info/parents dir
|
||||
(apply build-path (map bytes->path (reverse (cdr (reverse (cdr c)))))))))
|
||||
|
||||
(unless (hash-ref info-done dir #f)
|
||||
(hash-set! info-done dir #t)
|
||||
(define info (get-info/full dir))
|
||||
(when info
|
||||
(define v (info 'test-omit-paths (lambda () '())))
|
||||
(define (bad what v)
|
||||
(log-error "bad `~a' in \"info.rkt\": ~e" what v))
|
||||
(cond
|
||||
[(eq? v 'all)
|
||||
(hash-set! omit-paths dir #t)]
|
||||
[(list? v)
|
||||
(for ([i (in-list v)])
|
||||
(unless (path-string? i) (bad 'test-omit-paths v))
|
||||
(define p (normalize-info-path (path->complete-path i dir)))
|
||||
(define dp (if (directory-exists? p)
|
||||
(path->directory-path p)
|
||||
p))
|
||||
(hash-set! omit-paths dp #t))]
|
||||
[else (bad 'test-omit-paths v)])
|
||||
|
||||
(define a (info 'test-command-line-arguments (lambda () '())))
|
||||
(unless (list? a) (bad 'test-command-line-arguments a))
|
||||
(for ([arg (in-list a)])
|
||||
(unless (and (list? arg)
|
||||
(= 2 (length arg))
|
||||
(path-string? (car arg))
|
||||
(list? (cadr arg))
|
||||
(andmap path-string? (cadr arg)))
|
||||
(bad 'test-command-line-arguments a))
|
||||
(hash-set! command-line-arguments
|
||||
(normalize-info-path (path->complete-path (car arg) dir))
|
||||
(cadr arg))))))
|
||||
(define (get-members table what all-ok?)
|
||||
(define v (info what (lambda () '())))
|
||||
(cond
|
||||
[(and all-ok? (eq? v 'all))
|
||||
(hash-set! table dir #t)]
|
||||
[(list? v)
|
||||
(for ([i (in-list v)])
|
||||
(unless (path-string? i) (bad what v))
|
||||
(define p (normalize-info-path (path->complete-path i dir)))
|
||||
(define dp (if (directory-exists? p)
|
||||
(path->directory-path p)
|
||||
p))
|
||||
(hash-set! table dp #t))]
|
||||
[else (bad what v)]))
|
||||
(get-members omit-paths 'test-omit-paths #t)
|
||||
(get-members randoms 'test-randoms #t)
|
||||
|
||||
(define (get-keyed table what check? #:ok-all? [ok-all? #f])
|
||||
(define a (info what (lambda () '())))
|
||||
(if (list? a)
|
||||
(for ([arg (in-list a)])
|
||||
(unless (and (list? arg)
|
||||
(= 2 (length arg))
|
||||
(or (path-string? (car arg))
|
||||
(and ok-all?
|
||||
(eq? (car arg) 'all)))
|
||||
(check? (cadr arg)))
|
||||
(bad what a))
|
||||
(hash-set! table
|
||||
(normalize-info-path (if (eq? (car arg) 'all)
|
||||
dir
|
||||
(path->complete-path (car arg) dir)))
|
||||
(cadr arg)))
|
||||
(bad what a)))
|
||||
|
||||
(get-keyed command-line-arguments
|
||||
'test-command-line-arguments
|
||||
(lambda (v) (and (list? v)
|
||||
(andmap path-string? v))))
|
||||
(get-keyed timeouts
|
||||
'test-timeouts
|
||||
(lambda (v) (real? v)))
|
||||
(get-keyed lock-names
|
||||
'test-lock-names
|
||||
(lambda (v) (or (not v)
|
||||
(and (string? v)
|
||||
(path-string? v)))))
|
||||
(get-keyed responsibles
|
||||
'test-responsibles
|
||||
ok-responsible?
|
||||
#:ok-all? #t)
|
||||
(get-keyed randoms
|
||||
'test-random
|
||||
(lambda (v) (string? v))))))
|
||||
|
||||
(define (check-info/parents dir subpath)
|
||||
(let loop ([dir dir] [subpath subpath])
|
||||
(unless (hash-ref info-done dir #f)
|
||||
(check-info dir #f)
|
||||
(define-values (next-subpath subpath-name subpath-dir?) (split-path subpath))
|
||||
(define-values (next-dir dir-name dir-dir?) (split-path dir))
|
||||
(when (path? next-subpath)
|
||||
(loop next-dir next-subpath)))))
|
||||
(check-dir-info dir)
|
||||
(define-values (next-subpath subpath-name subpath-dir?) (split-path subpath))
|
||||
(define-values (next-dir dir-name dir-dir?) (split-path dir))
|
||||
(when (path? next-subpath)
|
||||
(loop next-dir next-subpath))))
|
||||
|
||||
(define (check-info p)
|
||||
(check-dir-info p)
|
||||
;; Check enclosing collection
|
||||
(define-values (base name dir?) (split-path p))
|
||||
(define c (if dir?
|
||||
#f
|
||||
(path->collects-relative p #:cache collects-cache)))
|
||||
(when (list? c)
|
||||
(check-info/parents base
|
||||
(apply build-path (map bytes->path (reverse (cdr (reverse (cdr c)))))))))
|
||||
|
||||
(define (normalize-info-path p)
|
||||
(simplify-path (path->complete-path p) #f))
|
||||
|
||||
(define (omit-path? p)
|
||||
(check-info p #t)
|
||||
(let ([p (normalize-info-path p)])
|
||||
(or (hash-ref omit-paths p #f)
|
||||
(let-values ([(base name dir?) (split-path p)])
|
||||
|
|
@ -633,8 +749,40 @@
|
|||
(omit-path? base))))))
|
||||
|
||||
(define (get-cmdline p [default null])
|
||||
(let ([p (normalize-info-path p)])
|
||||
(hash-ref command-line-arguments p default)))
|
||||
(hash-ref command-line-arguments p default))
|
||||
|
||||
(define (get-timeout p) (hash-ref timeouts p +inf.0))
|
||||
|
||||
(define (get-lock-name p) (hash-ref lock-names p #f))
|
||||
|
||||
(define (get-responsible p)
|
||||
(or (let loop ([p p])
|
||||
(or (hash-ref responsibles p #f)
|
||||
(let-values ([(base name dir?) (split-path p)])
|
||||
(and (path? base)
|
||||
(loop base)))))
|
||||
;; Check package authors:
|
||||
(let-values ([(pkg subpath) (path->pkg+subpath p #:cache pkg-cache)])
|
||||
(and pkg
|
||||
(let ([pkg-dir (if (path? subpath)
|
||||
(apply build-path
|
||||
(drop-right (explode-path p)
|
||||
(length (explode-path subpath))))
|
||||
pkg)])
|
||||
(define info (get-info/full pkg-dir))
|
||||
(and info
|
||||
(let ([v (info 'pkg-authors (lambda () #f))])
|
||||
(and (ok-responsible? v)
|
||||
v))))))))
|
||||
|
||||
(define (get-random p) (hash-ref randoms p #f))
|
||||
|
||||
(define (ok-responsible? v)
|
||||
(or (string? v)
|
||||
(symbol? v)
|
||||
(and (list? v)
|
||||
(andmap (lambda (v) (or (symbol? v) (string? v)))
|
||||
v))))
|
||||
|
||||
;; --------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -3,17 +3,19 @@
|
|||
scribble/bnf
|
||||
"common.rkt"
|
||||
(for-label racket/runtime-path
|
||||
racket/base
|
||||
launcher/launcher
|
||||
rackunit/log))
|
||||
|
||||
@title[#:tag "test"]{@exec{raco test}: Run tests}
|
||||
|
||||
The @exec{raco test} command requires and (by default) runs the
|
||||
@racket[test] submodule (if any) associated with each path given on
|
||||
the command line. By default, each test is run in a separate Racket
|
||||
process. Command-line flag can control which submodule is run, whether
|
||||
to run the main module if no submodule is found, and whether to run
|
||||
tests as processes or places.
|
||||
The @exec{raco test} command requires and runs the (by default)
|
||||
@racket[test] submodule associated with each path given on the command
|
||||
line. Command-line flag can control which submodule is run, whether to
|
||||
run the main module if no submodule is found, and whether to run tests
|
||||
directly, in separate processes (the default), or in separate places.
|
||||
The current directory is set to a test file's directory before running
|
||||
the file.
|
||||
|
||||
When an argument path refers to a directory, the tool recursively
|
||||
discovers and runs all files within the directory that end in
|
||||
|
|
@ -24,8 +26,7 @@ discovers and runs all files within the directory that end in
|
|||
A test is counted as failing if it logs a failing test code via
|
||||
@racket[test-log!], causes Racket to exit with a non-zero exit code, or
|
||||
(when @Flag{e} or @DFlag{check-stderr} is specified) if it produces
|
||||
output on the error port. The current directory is set to a test
|
||||
file's directory before running the file.
|
||||
output on the error port.
|
||||
|
||||
The @exec{raco test} command accepts several flags:
|
||||
|
||||
|
|
@ -104,7 +105,8 @@ The @exec{raco test} command accepts several flags:
|
|||
--- count any stderr output as a test failure.}
|
||||
|
||||
@item{@Flag{q} or @DFlag{quiet}
|
||||
--- suppresses output of progress information.}
|
||||
--- suppresses output of progress information, responsible
|
||||
parties, and varying output (see @secref["test-responsible"]).}
|
||||
|
||||
@item{@DFlag{table} or @Flag{t}
|
||||
--- Print a summary table after all tests. If a test uses
|
||||
|
|
@ -115,6 +117,8 @@ The @exec{raco test} command accepts several flags:
|
|||
|
||||
]
|
||||
|
||||
@section[#:tag "test-config"]{Test Configuration by Submodule}
|
||||
|
||||
When @exec{raco test} runs a test in a submodule, a @racket[config]
|
||||
sub-submodule can provide additional configuration for running the
|
||||
test. The @racket[config] sub-submodule should use the
|
||||
|
|
@ -123,32 +127,104 @@ identifiers:
|
|||
|
||||
@itemlist[
|
||||
|
||||
@item{@racket[timeout] --- override the default timeout for the test,
|
||||
when timeouts are enabled.}
|
||||
@item{@racket[timeout] --- a real number to override the default
|
||||
timeout for the test, which applies only when timeouts are
|
||||
enabled.}
|
||||
|
||||
@item{@racket[responsible] --- a string, symbol, or list of symbols
|
||||
and strings identifying a responsible party that should be
|
||||
notified when the test fails. See @secref["test-responsible"].}
|
||||
|
||||
@item{@racket[lock-name] --- a string that names a lock file that is
|
||||
used to serialize tests (i.e., tests that have the same lock
|
||||
name do not run concurrently). The lock file's location is
|
||||
determined by the @envvar{PLTLOCKDIR} enviornment varible or
|
||||
defaults to @racket[(find-system-path 'temp-dir)]. The maximum
|
||||
time to wait on the lock file is determined by the
|
||||
@envvar{PLTLOCKTIME} environment variable or defaults to 4
|
||||
hours.}
|
||||
|
||||
@item{@racket[random?] --- if true, indicates that the test's output
|
||||
is expected to vary. See @secref["test-responsible"].}
|
||||
|
||||
]
|
||||
|
||||
To prevent @exec{raco test} from running a particular file, normally
|
||||
the file should contain a submodule that takes no action. In some
|
||||
cases, however, adding a submodule is inconvenient or impossible
|
||||
(e.g., because the file will not always compile). Thus, @exec{raco
|
||||
test} also consults any @filepath{info.rkt} file in the candidate test
|
||||
file's directory; in the case of a file within a collection,
|
||||
@filepath{info.rkt} files from any enclosing collection directories
|
||||
are also consulted. The following @filepath{info.rkt} fields are
|
||||
recognized:
|
||||
|
||||
@section[#:tag "test-config-info"]{Test Configuration by @filepath{info.rkt}}
|
||||
|
||||
Submodule-based test configuration is preferred (see
|
||||
@secref["test-config"]). In particular, to prevent @exec{raco test}
|
||||
from running a particular file, normally the file should contain a
|
||||
submodule that takes no action.
|
||||
|
||||
In some cases, however, adding a submodule is inconvenient or
|
||||
impossible (e.g., because the file will not always compile). Thus,
|
||||
@exec{raco test} also consults any @filepath{info.rkt} file in the
|
||||
candidate test file's directory. In the case of a file within a
|
||||
collection, @filepath{info.rkt} files from any enclosing collection
|
||||
directories are also consulted for @racket[test-omit-paths]. Finally,
|
||||
for a file within a package, the package's @filepath{info.rkt} is
|
||||
consulted for @racket[pkg-authors] to set the default responsible
|
||||
parties (see @secref["test-responsible"]) for all files in the
|
||||
package.
|
||||
|
||||
The following @filepath{info.rkt} fields are recognized:
|
||||
|
||||
@itemlist[
|
||||
|
||||
@item{@racket[test-omit-paths] --- a list of path strings (relative
|
||||
to the enclosing directory) or @racket['all] to omit all files within
|
||||
the enclosing directory. When a path string refers to a directory,
|
||||
all files within the directory are omitted.}
|
||||
to the enclosing directory) or @racket['all] to omit all files
|
||||
within the enclosing directory. When a path string refers to a
|
||||
directory, all files within the directory are omitted.}
|
||||
|
||||
@item{@racket[test-command-line-arguments] --- a list of
|
||||
@racket[(list _module-path-string (list _argument-path-string ...))],
|
||||
where @racket[current-command-line-arguments] is set to a vector that
|
||||
contains the @racket[_argument-path-string] when running
|
||||
@racket[_module-path-string].}
|
||||
@racket[(list _module-path-string (list _argument-path-string
|
||||
...))], where @racket[current-command-line-arguments] is set to
|
||||
a vector that contains the @racket[_argument-path-string] when
|
||||
running @racket[_module-path-string].}
|
||||
|
||||
@item{@racket[test-timeouts] --- a list of @racket[(list
|
||||
_module-path-string _real-number)] to override the default
|
||||
timeout for @racket[_module-path-string].}
|
||||
|
||||
@item{@racket[test-responsibles] --- a list of @racket[(list
|
||||
_module-path-string _party)] or @racket[(list 'all _party)] to
|
||||
override the default responsible party for
|
||||
@racket[_module-path-string] or all files within the directory
|
||||
(except as overridden), respectively. Each @racket[_party] is a
|
||||
string, symbol, or list of symbols and strings. See
|
||||
@secref["test-responsible"].}
|
||||
|
||||
@item{@racket[test-lock-names] --- a list of @racket[(list
|
||||
_module-path-string _lock-string)] to declare a lock file name
|
||||
for @racket[_module-path-string]. See @racket[lock-name] in
|
||||
@secref["test-config"].}
|
||||
|
||||
@item{@racket[test-randoms] --- a list of path strings (relative to
|
||||
the enclosing directory) for modules whose output varies.
|
||||
See @secref["test-responsible"].}
|
||||
|
||||
]
|
||||
|
||||
@section[#:tag "test-responsible"]{Responsible-Party and Varying-Output Logging}
|
||||
|
||||
When a test has a declared responsible party, then the test's output
|
||||
is prefixed with a
|
||||
|
||||
@verbatim[#:indent 2]{raco test:@nonterm{which} @"@"(test-responsible '@nonterm{responsible})}
|
||||
|
||||
line, where @nonterm{which} is a space followed by an exact
|
||||
non-negative number indicating a parallel task when parallelism is
|
||||
enabled (or empty otherwise), and @nonterm{responsible} is a string,
|
||||
symbol, or list datum.
|
||||
|
||||
When a test's output (as written to stdout) is expected to vary across
|
||||
runs---aside from varying output that has the same form as produced by
|
||||
@racket[time]---then it should be declared as varying. In that case,
|
||||
the test's output is prefixed with a
|
||||
|
||||
@verbatim[#:indent 2]{raco test:@nonterm{which} @"@"(test-random #t)}
|
||||
|
||||
line.
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user