summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbuild-aux/test-driver.scm17
1 files changed, 13 insertions, 4 deletions
diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm
index 25b4613bbc9..7c211f51ef9 100755
--- a/build-aux/test-driver.scm
+++ b/build-aux/test-driver.scm
@@ -3,7 +3,7 @@ exec guile --no-auto-compile -e main -s "$0" "$@"
3!# 3!#
4;;;; test-driver.scm - Guile test driver for Automake testsuite harness 4;;;; test-driver.scm - Guile test driver for Automake testsuite harness
5 5
6(define script-version "2026-01-23.07") ;UTC 6(define script-version "2026-03-19.13") ;UTC
7 7
8;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> 8;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
9;;; Copyright © 2021 Maxim Cournoyer <maxim@guixotic.coop> 9;;; Copyright © 2021 Maxim Cournoyer <maxim@guixotic.coop>
@@ -95,6 +95,15 @@ case is shown.\n"))
95 "") ;no color 95 "") ;no color
96 result))) 96 result)))
97 97
98(define* (test-result-kind* #:optional (runner (test-runner-current)))
99 ;; TODO: Since Guile 3.0.11, the test-result-kind value of tests not
100 ;; selected by specifiers is #f instead of 'skip, which seems like a bug.
101 ;; Revert to use 'test-result-kind' after
102 ;; <https://codeberg.org/guile/guile/issues/133> is resolved and made and
103 ;; available in Guix.
104 (or (test-result-ref runner 'result-kind)
105 'skip))
106
98 107
99;;; 108;;;
100;;; SRFI 64 custom test runner. 109;;; SRFI 64 custom test runner.
@@ -125,7 +134,7 @@ cases based on their names."
125 (hash-set! test-cases-start-time test-case-name start-time))) 134 (hash-set! test-cases-start-time test-case-name start-time)))
126 135
127 (define (test-skipped? runner) 136 (define (test-skipped? runner)
128 (eq? 'skip (test-result-kind runner))) 137 (eq? 'skip (test-result-kind* runner)))
129 138
130 (define (test-failed? runner) 139 (define (test-failed? runner)
131 (not (or (test-passed? runner) 140 (not (or (test-passed? runner)
@@ -146,7 +155,7 @@ cases based on their names."
146 (unless (or brief? (and errors-only? (test-skipped? runner))) 155 (unless (or brief? (and errors-only? (test-skipped? runner)))
147 ;; Display the result of each test case on the console. 156 ;; Display the result of each test case on the console.
148 (format out-port "~a: ~a - ~a ~@[[~,3fs]~]~%" 157 (format out-port "~a: ~a - ~a ~@[[~,3fs]~]~%"
149 (result->string (test-result-kind runner) #:colorize? color?) 158 (result->string (test-result-kind* runner) #:colorize? color?)
150 test-name test-case-name 159 test-name test-case-name
151 (and show-duration? time-elapsed-seconds))) 160 (and show-duration? time-elapsed-seconds)))
152 161
@@ -168,7 +177,7 @@ cases based on their names."
168 (newline)) 177 (newline))
169 178
170 (format trs-port ":test-result: ~A ~A [~,3fs]~%" 179 (format trs-port ":test-result: ~A ~A [~,3fs]~%"
171 (result->string (test-result-kind runner)) 180 (result->string (test-result-kind* runner))
172 (test-runner-test-name runner) time-elapsed-seconds))) 181 (test-runner-test-name runner) time-elapsed-seconds)))
173 182
174 (define (test-on-group-end-gnu runner) 183 (define (test-on-group-end-gnu runner)