diff --git a/pkgs/compiler-pkgs/compiler-lib/compiler/commands/test.rkt b/pkgs/compiler-pkgs/compiler-lib/compiler/commands/test.rkt index d828bfa479..58de9608bc 100644 --- a/pkgs/compiler-pkgs/compiler-lib/compiler/commands/test.rkt +++ b/pkgs/compiler-pkgs/compiler-lib/compiler/commands/test.rkt @@ -31,6 +31,7 @@ (define table? #f) (define fresh-user? #f) (define empty-input? #f) +(define heartbeat-secs #f) (define ignore-stderr-patterns null) (define jobs 0) ; 0 mean "default" @@ -490,6 +491,24 @@ (format " ~s" (format "~a" a))))) (flush-output)) 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 (dynamic-require* mod 0 #:id (if (jobs . <= . 1) @@ -501,6 +520,9 @@ #:responsible responsible #:lock-name lock-name #:random? random?) + (when heartbeat-t + (semaphore-post heartbeat-sema) + (sync heartbeat-t)) (call-with-semaphore ids-lock (lambda () @@ -972,6 +994,9 @@ [("--quiet" "-q") "Suppress `raco test: ...' message" (set! quiet? #t)] + [("--heartbeat") + "Periodically report that a test is still running" + (set! heartbeat-secs 5)] [("--table" "-t") "Print a summary table" (set! table? #t)] diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/raco/test.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/raco/test.scrbl index 03ba7f6109..d057a0ee9d 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/raco/test.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/raco/test.scrbl @@ -120,24 +120,28 @@ The @exec{raco test} command accepts several flags: example) does @emph{not} change for each test process.} @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} - --- suppresses output from each test program.} + --- Suppresses output from each test program.} @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} - --- 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 stderr output is treated as success as long as it matches any one @nonterm{pattern}.} @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"]).} + @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} --- Print a summary table after all tests. If a test uses @racketmodname[rackunit], or if a test at least uses