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
