Subject: bug#74385: [PATCH 2/4] srfi-64: Use ~s when printing some properties.

From: Tomas Volf <[email-masked]>
Date: Sat, 16 Nov 2024 18:42:05 +0100

This will help to properly debug failing tests like:

    (test-equal "some failing test" "a b " "a b")

Before there was no way to tell that one "a b" as extra trailing space, now
there is.

* module/srfi/srfi-64.scm (test-on-test-end-simple)['expected-value]
['expected-error, 'actual-value, 'actual-error]: Print using ~s.
[maybe-print-prop]: Take the code for format as a parameter.
---
 module/srfi/srfi-64.scm | 25 +++++++++----------------
 1 file changed, 9 insertions(+), 16 deletions(-)

diff --git a/module/srfi/srfi-64.scm b/module/srfi/srfi-64.scm
index 13ae26d48..7b3341bf0 100644
--- a/module/srfi/srfi-64.scm
+++ b/module/srfi/srfi-64.scm
@@ -27,7 +27,6 @@
   #:use-module (ice-9 exceptions)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 pretty-print)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
@@ -417,17 +416,11 @@ instead."
 
 (define (test-on-test-end-simple runner)
   "Log that test is done."
-  (define (maybe-print-prop prop pretty?)
+  (define (maybe-print-prop prop pretty? code)
     (let* ((default (list))
            (val (test-result-ref runner prop default)))
       (unless (eq? val default)
-        (let ((val (string-trim-both
-                    (with-output-to-string
-                      (λ ()
-                        (if pretty?
-                            (pretty-print val #:per-line-prefix "             ")
-                            (display val)))))))
-          (format #t "~a: ~a~%" prop val)))))
+        (format #t "~a: ~@?~&" prop code val))))
 
   (let ((result-kind (test-result-kind runner)))
     ;; Skip tests not executed due to run list.
@@ -436,13 +429,13 @@ instead."
               result-kind
               (test-runner-test-name runner))
       (unless (member result-kind '(pass xfail))
-        (maybe-print-prop 'source-file    #f)
-        (maybe-print-prop 'source-line    #f)
-        (maybe-print-prop 'source-form    #t)
-        (maybe-print-prop 'expected-value #f)
-        (maybe-print-prop 'expected-error #t)
-        (maybe-print-prop 'actual-value   #f)
-        (maybe-print-prop 'actual-error   #t)))))
+        (maybe-print-prop 'source-file    #f "~a")
+        (maybe-print-prop 'source-line    #f "~a")
+        (maybe-print-prop 'source-form    #t "~y")
+        (maybe-print-prop 'expected-value #f "~s")
+        (maybe-print-prop 'expected-error #t "~s")
+        (maybe-print-prop 'actual-value   #f "~s")
+        (maybe-print-prop 'actual-error   #t "~s")))))
 
 (define (test-runner-simple)
   "Creates a new simple test-runner, that prints errors and a summary on the
-- 
2.46.0