diff options
author | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2021-01-16 14:54:27 -0500 |
---|---|---|
committer | Maxim Cournoyer <maxim.cournoyer@gmail.com> | 2021-01-31 22:23:41 -0500 |
commit | 13f299b2c98cce0ede3a8a37dd11832fdb3827bb (patch) | |
tree | 169726e5722696ba38c16ae4c38f1ebd3d25dd3d | |
parent | 85243d0d63e2219d0d376a541fa67efc24e6e2c8 (diff) | |
download | guix-13f299b2c98cce0ede3a8a37dd11832fdb3827bb.tar.gz |
build: test-driver.scm: Make output redirection optional.
This makes it easier (and less surprising) for users to experiment with the custom Scheme test driver directly. The behavior is unchanged from Automake's point of view. * build-aux/test-driver.scm (main): Make the --log-file and --trs-file arguments optional and update doc. Only open, redirect and close a port to a log file when the --log-file option is provided. Only open and close a port to a trs file when the --trs-file option is provided. (test-runner-gnu): Set OUT-PORT parameter default value to the current output port. Set the TRS-PORT parameter default value to a void port. Update doc.
-rw-r--r-- | build-aux/test-driver.scm | 36 |
1 files changed, 21 insertions, 15 deletions
diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm index 52af1e9be7..eee3f1e08c 100644 --- a/build-aux/test-driver.scm +++ b/build-aux/test-driver.scm @@ -1,8 +1,9 @@ ;;;; test-driver.scm - Guile test driver for Automake testsuite harness -(define script-version "2017-03-22.13") ;UTC +(define script-version "2021-01-26.20") ;UTC ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This program is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by @@ -35,7 +36,7 @@ [--expect-failure={yes|no}] [--color-tests={yes|no}] [--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--] TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] -The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n")) +The '--test-name' option is mandatory.\n")) (define %options '((test-name (value #t)) @@ -75,11 +76,14 @@ The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n")) "[m") ;no color result))) -(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port) +(define* (test-runner-gnu test-name #:key color? brief? + (out-port (current-output-port)) + (trs-port (%make-void-port "w"))) "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, -and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The -current output port is supposed to be redirected to a '.log' file." +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 +void port, which means no TRS output is logged." (define (test-on-test-begin-gnu runner) ;; Procedure called at the start of an individual test case, before the @@ -156,20 +160,22 @@ current output port is supposed to be redirected to a '.log' file." ((option 'help #f) (show-help)) ((option 'version #f) (format #t "test-driver.scm ~A" script-version)) (else - (let ((log (open-file (option 'log-file "") "w0")) - (trs (open-file (option 'trs-file "") "wl")) - (out (duplicate-port (current-output-port) "wl"))) - (redirect-port log (current-output-port)) - (redirect-port log (current-warning-port)) - (redirect-port log (current-error-port)) + (let ((log (and=> (option 'log-file #f) (cut open-file <> "w0"))) + (trs (and=> (option 'trs-file #f) (cut open-file <> "wl"))) + (out (duplicate-port (current-output-port) "wl")) + (test-name (option 'test-name #f))) + (when log + (redirect-port log (current-output-port)) + (redirect-port log (current-warning-port)) + (redirect-port log (current-error-port))) (test-with-runner - (test-runner-gnu (option 'test-name #f) + (test-runner-gnu test-name #:color? (option->boolean opts 'color-tests) #:brief? (option->boolean opts 'brief) #:out-port out #:trs-port trs) - (load-from-path (option 'test-name #f))) - (close-port log) - (close-port trs) + (load-from-path test-name)) + (and=> log close-port) + (and=> trs close-port) (close-port out)))) (exit 0))) |