1 files changed, 33 insertions, 27 deletions

diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 7c211f51ef9..20bd8f095ed 100755
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -3,10 +3,11 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
 !#
 ;;;; test-driver.scm - Guile test driver for Automake testsuite harness
 
-(define script-version "2026-03-19.13") ;UTC
+(define script-version "2026-03-19.14") ;UTC
 
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim@guixotic.coop>
+;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
 ;;;
 ;;; 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,8 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
              (srfi srfi-1)
              (srfi srfi-19)
              (srfi srfi-26)
-             (srfi srfi-64))
+             (srfi srfi-64)
+             (srfi srfi-71))
 
 (define (show-help)
   (display "Usage:
@@ -114,15 +116,18 @@ case is shown.\n"))
                           (out-port (current-output-port))
                           (trs-port (%make-void-port "w"))
                           select exclude)
-  "Return a 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.
-When BRIEF? is true, the individual test cases results are masked and only the
-summary is shown.  ERRORS-ONLY? reduces the amount of test case metadata
-logged to only that of the failed test cases.  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.  SELECT and
-EXCLUDE may take a regular expression to select or exclude individual test
-cases based on their names."
+  "Return a custom SRFI-64 test runner and a `finalize' procedure as multiple
+values.  TEST-NAME is a string specifying the file name of the current the
+test.  COLOR?  specifies whether to use colors.  When BRIEF? is true, the
+individual test cases results are masked and only the summary is shown.
+ERRORS-ONLY?  reduces the amount of test case metadata logged to only that of
+the failed test cases.  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.  SELECT and EXCLUDE may take a regular
+expression to select or exclude individual test cases based on their names.
+
+After the tests are finished running, the `finalize' procedure should be
+called to do the final reporting."
 
   (define test-cases-start-time (make-hash-table))
 
@@ -180,8 +185,8 @@ cases based on their names."
               (result->string (test-result-kind* runner))
               (test-runner-test-name runner) time-elapsed-seconds)))
 
-  (define (test-on-group-end-gnu runner)
-    ;; Procedure called by a 'test-end', including at the end of a test-group.
+  (define (finalize runner)
+    "Procedure to call after all tests finish to do the final reporting."
     (let ((fail (or (positive? (test-runner-fail-count runner))
                     (positive? (test-runner-xpass-count runner))))
           (skip (or (positive? (test-runner-skip-count runner))
@@ -198,15 +203,14 @@ cases based on their names."
         (format out-port "~A: ~A~%"
                 (result->string (if fail 'fail (if skip 'skip 'pass))
                                 #:colorize? color?)
-                test-name))
-      #f))
+                test-name))))
 
   (let ((runner (test-runner-null)))
     (test-runner-on-test-begin! runner test-on-test-begin-gnu)
     (test-runner-on-test-end! runner test-on-test-end-gnu)
-    (test-runner-on-group-end! runner test-on-group-end-gnu)
     (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple)
-    runner))
+    (values runner
+            (λ () (finalize runner)))))
 
 
 ;;;
@@ -252,17 +256,19 @@ cases based on their names."
           (redirect-port log (current-output-port))
           (redirect-port log (current-warning-port))
           (redirect-port log (current-error-port)))
-        (test-with-runner
-            (test-runner-gnu test-name
-                             #:color? color-tests
-                             #:brief? (option->boolean opts 'brief)
-                             #:errors-only? (option->boolean opts 'errors-only)
-                             #:show-duration? (option->boolean
-                                               opts 'show-duration)
-                             #:out-port out #:trs-port trs)
-          (test-apply test-specifier
+        (let ((runner
+               finalize (test-runner-gnu
+                         test-name
+                         #:color? color-tests
+                         #:brief? (option->boolean opts 'brief)
+                         #:errors-only? (option->boolean opts 'errors-only)
+                         #:show-duration? (option->boolean
+                                           opts 'show-duration)
+                         #:out-port out #:trs-port trs)))
+          (test-apply runner test-specifier
                       (lambda _
-                        (load-from-path test-name))))
+                        (load-from-path test-name)))
+          (finalize))
         (and=> log close-port)
         (and=> trs close-port)
         (close-port out))))