summary refs log tree commit diff
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2021-01-16 14:54:27 -0500
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2021-01-31 22:23:41 -0500
commit13f299b2c98cce0ede3a8a37dd11832fdb3827bb (patch)
tree169726e5722696ba38c16ae4c38f1ebd3d25dd3d
parent85243d0d63e2219d0d376a541fa67efc24e6e2c8 (diff)
downloadguix-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.scm36
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"))
                        "")          ;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)))