lloda pushed a commit to branch main
in repository guile.
commit b1f828bd1af18b93d39937bca762dd5886268b58
Author: Rob Browning <r...@defaultvalue.org>
AuthorDate: Sun Sep 7 11:45:52 2025 -0500
(test-suite lib automake) reporter: handle 'fail arguments
As with 'error and 'xfail, (test-suite lib) run-test may report 'fail
cases with arguments, so adjust the reporter to handle that.
Thanks to Dale P. Smith for reporting the problem and checking the fix.
* test-suite/test-suite/lib/automake.scm (reporter): handle 'fail
arguments.
---
test-suite/test-suite/lib/automake.scm | 23 ++++++++++++-----------
1 file changed, 12 insertions(+), 11 deletions(-)
diff --git a/test-suite/test-suite/lib/automake.scm
b/test-suite/test-suite/lib/automake.scm
index 237a89d65..abd4b6b25 100644
--- a/test-suite/test-suite/lib/automake.scm
+++ b/test-suite/test-suite/lib/automake.scm
@@ -40,15 +40,16 @@
": "))
(define (reporter trs-port)
+ (define (report-case outcome name args)
+ (show trs-port ":test-result: " outcome " " (render-name name))
+ (unless (null? args) (write-char #\space trs-port) (write args trs-port))
+ (newline trs-port))
(match-lambda*
- (('pass name) (show trs-port ":test-result: PASS " (render-name name)
"\n"))
- (('upass name) (show trs-port ":test-result: XPASS " (render-name name)
"\n"))
- (('fail name) (show trs-port ":test-result: FAIL " (render-name name)
"\n"))
- (('xfail name . args) (show trs-port ":test-result: XFAIL " (render-name
name) "\n"))
- (('untested name) (show trs-port ":test-result: SKIP " (render-name name)
"\n"))
- (('unsupported name) (show trs-port ":test-result: SKIP " (render-name
name) "\n"))
- (('unresolved name) (show trs-port ":test-result: SKIP " (render-name
name) "\n"))
- (('error name . args)
- (show trs-port ":test-result: ERROR " (render-name name) " ")
- (write args trs-port)
- (newline trs-port))))
+ (('pass name) (report-case "PASS" name '()))
+ (('upass name) (report-case "XPASS" name '()))
+ (('fail name . args) (report-case "FAIL" name args))
+ (('xfail name . args) (report-case "XFAIL" name args))
+ (('untested name) (report-case "SKIP" name '()))
+ (('unsupported name) (report-case "SKIP" name '()))
+ (('unresolved name) (report-case "SKIP" name '()))
+ (('error name . args) (report-case "ERROR" name args))))
