01/05: build: test-driver.scm: Make output redirection optional.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit 13f299b2c98cce0ede3a8a37dd11832fdb3827bb
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Sat Jan 16 14:54:27 2021 -0500

    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.
---
 build-aux/test-driver.scm | 36 +++++++++++++++++++++---------------
 1 file changed, 21 insertions(+), 15 deletions(-)

diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 52af1e9..eee3f1e 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)))