maint: Update files from upstream with "build-aux/gnu-fetch"

* build-aux/gitlog-to-changelog: Update.
* build-aux/test-driver.scm: Likewise.

1 files changed, 72 insertions, 52 deletions

diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 01edf93..5292c0a 100644
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -1,8 +1,8 @@
 ;;;; test-driver.scm - Guile test driver for Automake testsuite harness
 
-(define script-version "2016-05-09.22") ;UTC
+(define script-version "2018-03-24.22") ;UTC
 
-;;; Copyright (C) 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2015-2018 Free Software Foundation, Inc.
 ;;;
 ;;; 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
@@ -16,20 +16,40 @@
 ;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
-;;;
-;;; As a special exception to the GNU General Public License, if you
-;;; distribute this file as part of a program that contains a configuration
-;;; script generated by Autoconf, you may include it under the same
-;;; distribution terms that you use for the rest of that program.
 
 ;;;; Commentary:
 ;;;
 ;;; This script provides a Guile test driver using the SRFI-64 Scheme API for
 ;;; test suites.  SRFI-64 is distributed with Guile since version 2.0.9.
 ;;;
+;;; To use it, you have to manually copy this file in the ‘build-aux’
+;;; directory of your package, then adapt the following snippets to your
+;;; actual needs:
+;;;
+;;; configure.ac:
+;;;   AC_CONFIG_AUX_DIR([build-aux])
+;;;   AC_REQUIRE_AUX_FILE([test-driver.scm])
+;;;   AC_PATH_PROG([GUILE], [guile])
+;;;
+;;; Makefile.am
+;;;   TEST_LOG_DRIVER = $(GUILE) $(top_srcdir)/build-aux/test-driver.scm
+;;;   AM_TESTS_ENVIRONMENT = env GUILE_AUTO_COMPILE='0'
+;;;   TESTS = foo.test
+;;;   EXTRA_DIST = $(TESTS)
+;;;
+;;; foo.test
+;;;   (use-modules (srfi srfi-64))
+;;;   (test-begin "foo")
+;;;   (test-assert "assertion example" #t)
+;;;   (test-end "foo")
+;;;
+;;;  See <https://srfi.schemers.org/srfi-64/srfi-64.html> for general
+;;;  information about SRFI-64 usage.
+;;;
 ;;;; Code:
 
 (use-modules (ice-9 getopt-long)
+             (ice-9 match)
              (ice-9 pretty-print)
              (srfi srfi-26)
              (srfi srfi-64))
@@ -64,7 +84,7 @@ The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n"))
       (begin
         (format port "~A:~%" field)
         (pretty-print value port #:per-line-prefix "+ "))
-      (format port "~A: ~A~%" field value)))
+      (format port "~A: ~S~%" field value)))
 
 (define* (result->string symbol #:key colorize?)
   "Return SYMBOL as an upper case string.  Use colors when COLORIZE is #t."
@@ -90,10 +110,10 @@ current output port is supposed to be redirected to a '.log' file."
     ;; Procedure called at the start of an individual test case, before the
     ;; test expression (and expected value) are evaluated.
     (let ((result (cute assq-ref (test-result-alist runner) <>)))
-      (test-display "test-name" (result 'test-name))
-      (test-display "location"
-                    (string-append (result 'source-file) ":"
-                                   (number->string (result 'source-line))))
+      (format #t "test-name: ~A~%" (result 'test-name))
+      (format #t "location: ~A~%"
+              (string-append (result 'source-file) ":"
+                             (number->string (result 'source-line))))
       (test-display "source" (result 'source-form) #:pretty? #t)))
 
   (define (test-on-test-end-gnu runner)
@@ -104,10 +124,9 @@ current output port is supposed to be redirected to a '.log' file."
            (result  (cut assq-ref results <>)))
       (unless brief?
         ;; Display the result of each test case on the console.
-        (test-display
-         (result->string (test-result-kind runner) #:colorize? color?)
-         (string-append test-name " - " (test-runner-test-name runner))
-         out-port))
+        (format out-port "~A: ~A - ~A~%"
+                (result->string (test-result-kind runner) #:colorize? color?)
+                test-name (test-runner-test-name runner)))
       (when (result? 'expected-value)
         (test-display "expected-value" (result 'expected-value)))
       (when (result? 'expected-error)
@@ -116,12 +135,11 @@ current output port is supposed to be redirected to a '.log' file."
         (test-display "actual-value" (result 'actual-value)))
       (when (result? 'actual-error)
         (test-display "actual-error" (result 'actual-error) #:pretty? #t))
-      (test-display "result" (result->string (result 'result-kind)))
+      (format #t "result: ~a~%" (result->string (result 'result-kind)))
       (newline)
-      (test-display ":test-result"
-                    (string-append (result->string (test-result-kind runner))
-                                   " " (test-runner-test-name runner))
-                    trs-port)))
+      (format trs-port ":test-result: ~A ~A~%"
+              (result->string (test-result-kind runner))
+              (test-runner-test-name runner))))
 
   (define (test-on-group-end-gnu runner)
     ;; Procedure called by a 'test-end', including at the end of a test-group.
@@ -130,21 +148,18 @@ current output port is supposed to be redirected to a '.log' file."
           (skip (or (positive? (test-runner-skip-count runner))
                     (positive? (test-runner-xfail-count runner)))))
       ;; XXX: The global results need some refinements for XPASS.
-      (test-display ":global-test-result"
-                    (if fail "FAIL" (if skip "SKIP" "PASS"))
-                    trs-port)
-      (test-display ":recheck"
-                    (if fail "yes" "no")
-                    trs-port)
-      (test-display ":copy-in-global-log"
-                    (if (or fail skip) "yes" "no")
-                    trs-port)
+      (format trs-port ":global-test-result: ~A~%"
+              (if fail "FAIL" (if skip "SKIP" "PASS")))
+      (format trs-port ":recheck: ~A~%"
+              (if fail "yes" "no"))
+      (format trs-port ":copy-in-global-log: ~A~%"
+              (if (or fail skip) "yes" "no"))
       (when brief?
         ;; Display the global test group result on the console.
-        (test-display (result->string (if fail 'fail (if skip 'skip 'pass))
-                                      #:colorize? color?)
-                      test-name
-                      out-port))
+        (format out-port "~A: ~A~%"
+                (result->string (if fail 'fail (if skip 'skip 'pass))
+                                #:colorize? color?)
+                test-name))
       #f))
 
   (let ((runner (test-runner-null)))
@@ -163,30 +178,35 @@ current output port is supposed to be redirected to a '.log' file."
        (option (cut option-ref opts <> <>)))
   (cond
    ((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
-    (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))
-      (test-with-runner
-	  (test-runner-gnu (option 'test-name #f)
-			   #:color? (option->boolean opts 'color-tests)
-			   #:brief? (option->boolean opts 'brief)
-			   #:out-port out #:trs-port trs)
-	(load (string-append (getcwd) "/" (car (option '() '(""))))))
-      (close-port log)
-      (close-port trs)
-      (close-port out))))
+    (match (option '() '())
+      (()
+       (display "missing test script argument\n" (current-error-port))
+       (exit 1))
+      ((script . args)
+       (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))
+         (test-with-runner
+             (test-runner-gnu (option 'test-name #f)
+                              #:color? (option->boolean opts 'color-tests)
+                              #:brief? (option->boolean opts 'brief)
+                              #:out-port out #:trs-port trs)
+           (primitive-load script))
+         (close-port log)
+         (close-port trs)
+         (close-port out))))))
   (exit 0))
 
 ;;; Local Variables:
-;;; eval: (add-hook 'write-file-functions 'time-stamp)
+;;; eval: (add-hook 'before-save-hook 'time-stamp)
 ;;; time-stamp-start: "(define script-version \""
 ;;; time-stamp-format: "%:y-%02m-%02d.%02H"
-;;; time-stamp-time-zone: "UTC"
+;;; time-stamp-time-zone: "UTC0"
 ;;; time-stamp-end: "\") ;UTC"
 ;;; End: