[Guile-commits] 06/26: (test-suite lib automake) reporter: handle 'fail arguments

[Daniel Llorens]

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))))