raco test: add --heartbeat flag

Useful when running many tests in parallel to keep track of a test
that is running especially long (and maybe stuck).
This commit is contained in:
Matthew Flatt 2014-06-16 15:23:42 +01:00
parent 034acfa514
commit f3c8638366
2 changed files with 34 additions and 5 deletions

View File

@ -31,6 +31,7 @@
(define table? #f) (define table? #f)
(define fresh-user? #f) (define fresh-user? #f)
(define empty-input? #f) (define empty-input? #f)
(define heartbeat-secs #f)
(define ignore-stderr-patterns null) (define ignore-stderr-patterns null)
(define jobs 0) ; 0 mean "default" (define jobs 0) ; 0 mean "default"
@ -490,6 +491,24 @@
(format " ~s" (format "~a" a))))) (format " ~s" (format "~a" a)))))
(flush-output)) (flush-output))
id))) id)))
(define heartbeat-sema (make-semaphore))
(define heartbeat-t
(and heartbeat-secs
(thread (lambda ()
(let loop ()
(unless (sync/timeout heartbeat-secs heartbeat-sema)
(call-with-semaphore
ids-lock
(lambda ()
(printf "raco test: ~a[still on ~s]\n"
(if (jobs . <= . 1)
""
(format "~a " id))
(let ([m (normalize-module-path p)])
(if (and (pair? mod) (eq? 'submod (car mod)))
(list* 'submod m (cddr mod))
m)))))
(loop)))))))
(begin0 (begin0
(dynamic-require* mod 0 (dynamic-require* mod 0
#:id (if (jobs . <= . 1) #:id (if (jobs . <= . 1)
@ -501,6 +520,9 @@
#:responsible responsible #:responsible responsible
#:lock-name lock-name #:lock-name lock-name
#:random? random?) #:random? random?)
(when heartbeat-t
(semaphore-post heartbeat-sema)
(sync heartbeat-t))
(call-with-semaphore (call-with-semaphore
ids-lock ids-lock
(lambda () (lambda ()
@ -972,6 +994,9 @@
[("--quiet" "-q") [("--quiet" "-q")
"Suppress `raco test: ...' message" "Suppress `raco test: ...' message"
(set! quiet? #t)] (set! quiet? #t)]
[("--heartbeat")
"Periodically report that a test is still running"
(set! heartbeat-secs 5)]
[("--table" "-t") [("--table" "-t")
"Print a summary table" "Print a summary table"
(set! table? #t)] (set! table? #t)]

View File

@ -120,24 +120,28 @@ The @exec{raco test} command accepts several flags:
example) does @emph{not} change for each test process.} example) does @emph{not} change for each test process.}
@item{@DFlag{empty-stdin} @item{@DFlag{empty-stdin}
--- provide an empty stdin to each test program.} --- Provide an empty stdin to each test program.}
@item{@Flag{Q} or @DFlag{quiet-program} @item{@Flag{Q} or @DFlag{quiet-program}
--- suppresses output from each test program.} --- Suppresses output from each test program.}
@item{@Flag{e} or @DFlag{check-stderr} @item{@Flag{e} or @DFlag{check-stderr}
--- count any stderr output as a test failure.} --- Count any stderr output as a test failure.}
@item{@DPFlag{ignore-stderr} @nonterm{pattern} @item{@DPFlag{ignore-stderr} @nonterm{pattern}
--- don't count stderr output as a test failure if it matches --- Don't count stderr output as a test failure if it matches
@nonterm{pattern}. This flag can be used multiple times, and @nonterm{pattern}. This flag can be used multiple times, and
stderr output is treated as success as long as it matches any stderr output is treated as success as long as it matches any
one @nonterm{pattern}.} one @nonterm{pattern}.}
@item{@Flag{q} or @DFlag{quiet} @item{@Flag{q} or @DFlag{quiet}
--- suppresses output of progress information, responsible --- Suppresses output of progress information, responsible
parties, and varying output (see @secref["test-responsible"]).} parties, and varying output (see @secref["test-responsible"]).}
@item{@DFlag{heartbeat}
--- Periodically report that a test is still running after
the test has been running at least 5 seconds.}
@item{@DFlag{table} or @Flag{t} @item{@DFlag{table} or @Flag{t}
--- Print a summary table after all tests. If a test uses --- Print a summary table after all tests. If a test uses
@racketmodname[rackunit], or if a test at least uses @racketmodname[rackunit], or if a test at least uses