build: Add a --show-duration option to the SCM test-driver.

* build-aux/test-driver.scm (script-version): Update.
(show-help): Document it.
(%options): Add the 'show-duration' option.
(test-runner-gnu): Pass as a new argument.
[test-cases-start-time]: New inner variable.
[test-on-test-begin-gnu]: New hook, used to record the start time.
[test-on-test-end-gnu]: Conditionally print elapsed time.  Record it as the
optional metadata in the test result file (.trs).
* doc/guix.texi (Running the Test Suite): Document it.
This commit is contained in:
Maxim Cournoyer 2021-02-02 00:28:49 -05:00
parent 5b5915560e
commit 5e652e94a9
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
2 changed files with 43 additions and 10 deletions

View File

@ -3,7 +3,7 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
!# !#
;;;; test-driver.scm - Guile test driver for Automake testsuite harness ;;;; test-driver.scm - Guile test driver for Automake testsuite harness
(define script-version "2021-01-26.20") ;UTC (define script-version "2021-02-02.05") ;UTC
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@ -28,10 +28,12 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
;;; ;;;
;;;; Code: ;;;; Code:
(use-modules (ice-9 getopt-long) (use-modules (ice-9 format)
(ice-9 getopt-long)
(ice-9 pretty-print) (ice-9 pretty-print)
(ice-9 regex) (ice-9 regex)
(srfi srfi-1) (srfi srfi-1)
(srfi srfi-19)
(srfi srfi-26) (srfi srfi-26)
(srfi srfi-64)) (srfi srfi-64))
@ -40,14 +42,16 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
test-driver --test-name=NAME --log-file=PATH --trs-file=PATH test-driver --test-name=NAME --log-file=PATH --trs-file=PATH
[--expect-failure={yes|no}] [--color-tests={yes|no}] [--expect-failure={yes|no}] [--color-tests={yes|no}]
[--select=REGEXP] [--exclude=REGEXP] [--errors-only={yes|no}] [--select=REGEXP] [--exclude=REGEXP] [--errors-only={yes|no}]
[--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--] [--enable-hard-errors={yes|no}] [--brief={yes|no}}]
[--show-duration={yes|no}] [--]
TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS]
The '--test-name' option is mandatory. The '--select' and '--exclude' options The '--test-name' option is mandatory. The '--select' and '--exclude' options
allow selecting or excluding individual test cases via a regexp, respectively. allow selecting or excluding individual test cases via a regexp, respectively.
The '--errors-only' option can be set to \"yes\" to limit the logged test case The '--errors-only' option can be set to \"yes\" to limit the logged test case
metadata to only those test cases that failed. When set to \"yes\", the metadata to only those test cases that failed. When set to \"yes\", the
'--brief' option disables printing the individual test case result to the '--brief' option disables printing the individual test case result to the
console.\n")) console. When '--show-duration' is set to \"yes\", the time elapsed per test
case is shown.\n"))
(define %options (define %options
'((test-name (value #t)) '((test-name (value #t))
@ -60,6 +64,7 @@ console.\n"))
(expect-failure (value #t)) ;XXX: not implemented yet (expect-failure (value #t)) ;XXX: not implemented yet
(enable-hard-errors (value #t)) ;not implemented in SRFI-64 (enable-hard-errors (value #t)) ;not implemented in SRFI-64
(brief (value #t)) (brief (value #t))
(show-duration (value #t))
(help (single-char #\h) (value #f)) (help (single-char #\h) (value #f))
(version (single-char #\V) (value #f)))) (version (single-char #\V) (value #f))))
@ -96,6 +101,7 @@ console.\n"))
;;; ;;;
(define* (test-runner-gnu test-name #:key color? brief? errors-only? (define* (test-runner-gnu test-name #:key color? brief? errors-only?
show-duration?
(out-port (current-output-port)) (out-port (current-output-port))
(trs-port (%make-void-port "w")) (trs-port (%make-void-port "w"))
select exclude) select exclude)
@ -109,6 +115,15 @@ defaults to a void port, which means no TRS output is logged. SELECT and
EXCLUDE may take a regular expression to select or exclude individual test EXCLUDE may take a regular expression to select or exclude individual test
cases based on their names." cases based on their names."
(define test-cases-start-time (make-hash-table))
(define (test-on-test-begin-gnu runner)
;; Procedure called at the start of an individual test case, before the
;; test expression (and expected value) are evaluated.
(let ((test-case-name (test-runner-test-name runner))
(start-time (current-time time-monotonic)))
(hash-set! test-cases-start-time test-case-name start-time)))
(define (test-skipped? runner) (define (test-skipped? runner)
(eq? 'skip (test-result-kind runner))) (eq? 'skip (test-result-kind runner)))
@ -121,12 +136,19 @@ cases based on their names."
;; of the test is available. ;; of the test is available.
(let* ((results (test-result-alist runner)) (let* ((results (test-result-alist runner))
(result? (cut assq <> results)) (result? (cut assq <> results))
(result (cut assq-ref results <>))) (result (cut assq-ref results <>))
(test-case-name (test-runner-test-name runner))
(start (hash-ref test-cases-start-time test-case-name))
(end (current-time time-monotonic))
(time-elapsed (time-difference end start))
(time-elapsed-seconds (+ (time-second time-elapsed)
(* 1e-9 (time-nanosecond time-elapsed)))))
(unless (or brief? (and errors-only? (test-skipped? runner))) (unless (or brief? (and errors-only? (test-skipped? runner)))
;; Display the result of each test case on the console. ;; Display the result of each test case on the console.
(format out-port "~A: ~A - ~A~%" (format out-port "~a: ~a - ~a ~@[[~,3fs]~]~%"
(result->string (test-result-kind runner) #:colorize? color?) (result->string (test-result-kind runner) #:colorize? color?)
test-name (test-runner-test-name runner))) test-name test-case-name
(and show-duration? time-elapsed-seconds)))
(unless (and errors-only? (not (test-failed? runner))) (unless (and errors-only? (not (test-failed? runner)))
(format #t "test-name: ~A~%" (result 'test-name)) (format #t "test-name: ~A~%" (result 'test-name))
@ -145,9 +167,9 @@ cases based on their names."
(format #t "result: ~a~%" (result->string (result 'result-kind))) (format #t "result: ~a~%" (result->string (result 'result-kind)))
(newline)) (newline))
(format trs-port ":test-result: ~A ~A~%" (format trs-port ":test-result: ~A ~A [~,3fs]~%"
(result->string (test-result-kind runner)) (result->string (test-result-kind runner))
(test-runner-test-name runner)))) (test-runner-test-name runner) time-elapsed-seconds)))
(define (test-on-group-end-gnu runner) (define (test-on-group-end-gnu runner)
;; Procedure called by a 'test-end', including at the end of a test-group. ;; Procedure called by a 'test-end', including at the end of a test-group.
@ -171,6 +193,7 @@ cases based on their names."
#f)) #f))
(let ((runner (test-runner-null))) (let ((runner (test-runner-null)))
(test-runner-on-test-begin! runner test-on-test-begin-gnu)
(test-runner-on-test-end! runner test-on-test-end-gnu) (test-runner-on-test-end! runner test-on-test-end-gnu)
(test-runner-on-group-end! runner test-on-group-end-gnu) (test-runner-on-group-end! runner test-on-group-end-gnu)
(test-runner-on-bad-end-name! runner test-on-bad-end-name-simple) (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple)
@ -239,6 +262,8 @@ cases based on their names."
#:color? color-tests #:color? color-tests
#:brief? (option->boolean opts 'brief) #:brief? (option->boolean opts 'brief)
#:errors-only? (option->boolean opts 'errors-only) #:errors-only? (option->boolean opts 'errors-only)
#:show-duration? (option->boolean
opts 'show-duration)
#:out-port out #:trs-port trs) #:out-port out #:trs-port trs)
(test-apply test-specifier (test-apply test-specifier
(lambda _ (lambda _

View File

@ -48,7 +48,7 @@ Copyright @copyright{} 2017 humanitiesNerd@*
Copyright @copyright{} 2017 Christopher Allan Webber@* Copyright @copyright{} 2017 Christopher Allan Webber@*
Copyright @copyright{} 2017, 2018, 2019, 2020 Marius Bakke@* Copyright @copyright{} 2017, 2018, 2019, 2020 Marius Bakke@*
Copyright @copyright{} 2017, 2019, 2020 Hartmut Goebel@* Copyright @copyright{} 2017, 2019, 2020 Hartmut Goebel@*
Copyright @copyright{} 2017, 2019, 2020 Maxim Cournoyer@* Copyright @copyright{} 2017, 2019, 2020, 2021 Maxim Cournoyer@*
Copyright @copyright{} 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice@* Copyright @copyright{} 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice@*
Copyright @copyright{} 2017 George Clemmer@* Copyright @copyright{} 2017 George Clemmer@*
Copyright @copyright{} 2017 Andy Wingo@* Copyright @copyright{} 2017 Andy Wingo@*
@ -942,6 +942,14 @@ Automake makefile variable, as in:
make check SCM_LOG_DRIVER_FLAGS="--brief=no --errors-only=yes" VERBOSE=1 make check SCM_LOG_DRIVER_FLAGS="--brief=no --errors-only=yes" VERBOSE=1
@end example @end example
The @option{--show-duration=yes} option can be used to print the
duration of the individual test cases, when used in combination with
@option{--brief=no}:
@example
make check SCM_LOG_DRIVER_FLAGS="--brief=no --show-duration=yes"
@end example
@xref{Parallel Test Harness,,,automake,GNU Automake} for more @xref{Parallel Test Harness,,,automake,GNU Automake} for more
information about the Automake Parallel Test Harness. information about the Automake Parallel Test Harness.