build: test-driver.scm: Add test cases filtering options.

* build-aux/test-driver.scm (show-help): Add help text for the new --select
and --exclude options.
(%options): Add the new select and exclude options.
(test-runner-gnu): Pass them to the test runner.  Update doc.
(test-match-name*, test-match-name*/negated, %test-match-all): New variables.
(main): Compute the test specifier based on the values of the new options and
apply it to the current test runner when running the test file.
* doc/guix.texi (Running the Test Suite): Document the new options.
This commit is contained in:
Maxim Cournoyer 2021-01-17 09:03:07 -05:00
parent 346210b1b2
commit a1ea2acb37
No known key found for this signature in database
GPG key ID: 1260E46482E63562
2 changed files with 75 additions and 11 deletions

View file

@ -27,6 +27,8 @@ (define script-version "2021-01-26.20") ;UTC
(use-modules (ice-9 getopt-long) (use-modules (ice-9 getopt-long)
(ice-9 pretty-print) (ice-9 pretty-print)
(ice-9 regex)
(srfi srfi-1)
(srfi srfi-26) (srfi srfi-26)
(srfi srfi-64)) (srfi srfi-64))
@ -34,14 +36,19 @@ (define (show-help)
(display "Usage: (display "Usage:
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]
[--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--] [--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--]
TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS]
The '--test-name' option is mandatory.\n")) The '--test-name' option is mandatory. The '--select' and '--exclude' options
allow selecting or excluding individual test cases via a regexp,
respectively.\n"))
(define %options (define %options
'((test-name (value #t)) '((test-name (value #t))
(log-file (value #t)) (log-file (value #t))
(trs-file (value #t)) (trs-file (value #t))
(select (value #t))
(exclude (value #t))
(color-tests (value #t)) (color-tests (value #t))
(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
@ -76,14 +83,22 @@ (define* (result->string symbol #:key colorize?)
"") ;no color "") ;no color
result))) result)))
;;;
;;; SRFI 64 custom test runner.
;;;
(define* (test-runner-gnu test-name #:key color? brief? (define* (test-runner-gnu test-name #:key color? brief?
(out-port (current-output-port)) (out-port (current-output-port))
(trs-port (%make-void-port "w"))) (trs-port (%make-void-port "w"))
select exclude)
"Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the "Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the
file name of the current the test. COLOR? specifies whether to use colors, file name of the current the test. COLOR? specifies whether to use colors,
and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports.
OUT-PORT defaults to the current output port, while TRS-PORT defaults to a OUT-PORT defaults to the current output port, while TRS-PORT defaults to a
void port, which means no TRS output is logged." void port, which means no TRS output is logged. SELECT and EXCLUDE may take a
regular expression to select or exclude individual test cases based on their
names."
(define (test-on-test-begin-gnu runner) (define (test-on-test-begin-gnu runner)
;; Procedure called at the start of an individual test case, before the ;; Procedure called at the start of an individual test case, before the
@ -148,6 +163,34 @@ (define (test-on-group-end-gnu runner)
(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)
runner)) runner))
;;;
;;; SRFI 64 test specifiers.
;;;
(define (test-match-name* regexp)
"Return a test specifier that matches a test name against REGEXP."
(lambda (runner)
(string-match regexp (test-runner-test-name runner))))
(define (test-match-name*/negated regexp)
"Return a negated test specifier version of test-match-name*."
(lambda (runner)
(not (string-match regexp (test-runner-test-name runner)))))
;;; XXX: test-match-all is a syntax, which isn't convenient to use with a list
;;; of test specifiers computed at run time. Copy this SRFI 64 internal
;;; definition here, which is the procedural equivalent of 'test-match-all'.
(define (%test-match-all . pred-list)
(lambda (runner)
(let ((result #t))
(let loop ((l pred-list))
(if (null? l)
result
(begin
(if (not ((car l) runner))
(set! result #f))
(loop (cdr l))))))))
;;; ;;;
;;; Entry point. ;;; Entry point.
@ -160,13 +203,20 @@ (define (main . args)
((option 'help #f) (show-help)) ((option 'help #f) (show-help))
((option 'version #f) (format #t "test-driver.scm ~A" script-version)) ((option 'version #f) (format #t "test-driver.scm ~A" script-version))
(else (else
(let ((log (and=> (option 'log-file #f) (cut open-file <> "w0"))) (let* ((log (and=> (option 'log-file #f) (cut open-file <> "w0")))
(trs (and=> (option 'trs-file #f) (cut open-file <> "wl"))) (trs (and=> (option 'trs-file #f) (cut open-file <> "wl")))
(out (duplicate-port (current-output-port) "wl")) (out (duplicate-port (current-output-port) "wl"))
(test-name (option 'test-name #f)) (test-name (option 'test-name #f))
(color-tests (if (assoc 'color-tests opts) (select (option 'select #f))
(option->boolean opts 'color-tests) (exclude (option 'exclude #f))
#t))) (test-specifiers (filter-map
identity
(list (and=> select test-match-name*)
(and=> exclude test-match-name*/negated))))
(test-specifier (apply %test-match-all test-specifiers))
(color-tests (if (assoc 'color-tests opts)
(option->boolean opts 'color-tests)
#t)))
(when log (when log
(redirect-port log (current-output-port)) (redirect-port log (current-output-port))
(redirect-port log (current-warning-port)) (redirect-port log (current-warning-port))
@ -176,7 +226,9 @@ (define (main . args)
#:color? color-tests #:color? color-tests
#:brief? (option->boolean opts 'brief) #:brief? (option->boolean opts 'brief)
#:out-port out #:trs-port trs) #:out-port out #:trs-port trs)
(load-from-path test-name)) (test-apply test-specifier
(lambda _
(load-from-path test-name))))
(and=> log close-port) (and=> log close-port)
(and=> trs close-port) (and=> trs close-port)
(close-port out)))) (close-port out))))

View file

@ -921,6 +921,18 @@ the @code{SCM_LOG_DRIVER_FLAGS} makefile variable as in this example:
make check TESTS="tests/base64.scm" SCM_LOG_DRIVER_FLAGS="--brief=no" make check TESTS="tests/base64.scm" SCM_LOG_DRIVER_FLAGS="--brief=no"
@end example @end example
The underlying SRFI 64 custom Automake test driver used for the 'check'
test suite (located at @file{build-aux/test-driver.scm}) also allows
selecting which test cases to run at a finer level, via its
@option{--select} and @option{--exclude} options. Here's an example, to
run all the test cases from the @file{tests/packages.scm} test file
whose names start with ``transaction-upgrade-entry'':
@example
export SCM_LOG_DRIVER_FLAGS="--select=^transaction-upgrade-entry"
make check TESTS="tests/packages.scm"
@end example
Upon failure, please email @email{bug-guix@@gnu.org} and attach the Upon failure, please email @email{bug-guix@@gnu.org} and attach the
@file{test-suite.log} file. Please specify the Guix version being used @file{test-suite.log} file. Please specify the Guix version being used
as well as version numbers of the dependencies (@pxref{Requirements}) in as well as version numbers of the dependencies (@pxref{Requirements}) in