diff options
| author | Maxim Cournoyer <maxim@guixotic.coop> | 2026-03-19 22:17:16 +0900 |
|---|---|---|
| committer | Maxim Cournoyer <maxim@guixotic.coop> | 2026-03-19 23:40:12 +0900 |
| commit | c274b5c2b2b42cb10053973b1091fb7e431e81eb (patch) | |
| tree | 2ad2fcc620cbbe52e73f428f579c7a3a18bcc2ab /build-aux/test-driver.scm | |
| parent | 82f84f5e7fb34cc719ed6ea538a3d1ca7516f23d (diff) | |
build-aux: Streamline test-driver.scm a bit.
Guile 3.0.11 ships with a new SRFI 64.
* build-aux/test-driver.scm (%test-match-all): Delete procedure.
(main): Replace %test-match-all with test-match-all.
Change-Id: Ibcd7d98194694c1de679491be4f5a603a79f6e29
Diffstat (limited to 'build-aux/test-driver.scm')
| -rwxr-xr-x | build-aux/test-driver.scm | 16 |
1 files changed, 1 insertions, 15 deletions
diff --git a/build-aux/test-driver.scm b/build-aux/test-driver.scm index 7c0c403f7ab..612529db35d 100755 --- a/build-aux/test-driver.scm +++ b/build-aux/test-driver.scm | |||
| @@ -213,20 +213,6 @@ cases based on their names." | |||
| 213 | (lambda (runner) | 213 | (lambda (runner) |
| 214 | (not (string-match regexp (test-runner-test-name runner))))) | 214 | (not (string-match regexp (test-runner-test-name runner))))) |
| 215 | 215 | ||
| 216 | ;;; XXX: test-match-all is a syntax, which isn't convenient to use with a list | ||
| 217 | ;;; of test specifiers computed at run time. Copy this SRFI 64 internal | ||
| 218 | ;;; definition here, which is the procedural equivalent of 'test-match-all'. | ||
| 219 | (define (%test-match-all . pred-list) | ||
| 220 | (lambda (runner) | ||
| 221 | (let ((result #t)) | ||
| 222 | (let loop ((l pred-list)) | ||
| 223 | (if (null? l) | ||
| 224 | result | ||
| 225 | (begin | ||
| 226 | (if (not ((car l) runner)) | ||
| 227 | (set! result #f)) | ||
| 228 | (loop (cdr l)))))))) | ||
| 229 | |||
| 230 | 216 | ||
| 231 | ;;; | 217 | ;;; |
| 232 | ;;; Entry point. | 218 | ;;; Entry point. |
| @@ -249,7 +235,7 @@ cases based on their names." | |||
| 249 | identity | 235 | identity |
| 250 | (list (and=> select test-match-name*) | 236 | (list (and=> select test-match-name*) |
| 251 | (and=> exclude test-match-name*/negated)))) | 237 | (and=> exclude test-match-name*/negated)))) |
| 252 | (test-specifier (apply %test-match-all test-specifiers)) | 238 | (test-specifier (apply test-match-all test-specifiers)) |
| 253 | (color-tests (if (assoc 'color-tests opts) | 239 | (color-tests (if (assoc 'color-tests opts) |
| 254 | (option->boolean opts 'color-tests) | 240 | (option->boolean opts 'color-tests) |
| 255 | #t))) | 241 | #t))) |
