diff --git a/lib/chibi/test.scm b/lib/chibi/test.scm index 81bd627b..9c1b5108 100644 --- a/lib/chibi/test.scm +++ b/lib/chibi/test.scm @@ -526,6 +526,7 @@ (not (assq-ref info 'line-number))) `((file-name . ,(car (pair-source expr))) (line-number . ,(cdr (pair-source expr))) + (format . ,(current-test-value-formatter)) ,@info) info))) @@ -584,14 +585,20 @@ ((SKIP) "-") (else ".")))) -(define (display-expected/actual expected actual) - (let* ((e-str (write-to-string expected)) - (a-str (write-to-string actual)) - (diff (diff e-str a-str read-char))) - (write-string "expected ") - (write-string (edits->string/color (car diff) (car (cddr diff)) 1)) - (write-string " but got ") - (write-string (edits->string/color (cadr diff) (car (cddr diff)) 2)))) +(define (display-expected/actual expected actual format) + (let ((e-str (format expected)) + (a-str (format actual))) + (if (and (equal? e-str a-str) + (not (eqv? format write-to-string))) + ;; If the formatter can't display any difference, fall back to + ;; write-to-string. + (display-expected/actual expected actual write-to-string) + (let ((diff (diff e-str a-str read-char))) + (write-string "expected ") + (write-string (edits->string/color (car diff) (car (cddr diff)) 1)) + (write-string " but got ") + (write-string (edits->string/color (cadr diff) (car (cddr diff)) 2)) + )))) (define (test-print-explanation indent status info) (cond @@ -617,8 +624,9 @@ (write (assq-ref info 'result))))) ((eq? status 'FAIL) (display indent) - (display-expected/actual - (assq-ref info 'expected) (assq-ref info 'result)))) + (display-expected/actual (assq-ref info 'expected) + (assq-ref info 'result) + (or (assq-ref info 'format) write-to-string)))) ;; print variables (cond ((and (memq status '(FAIL ERROR)) (assq-ref info 'var-names)) @@ -863,6 +871,11 @@ ;;> \section{Parameters} +;;> If specified, takes a single object as input (the expected or +;;> actual value of a test) and returns the string representation +;;> (default \scheme{write-to-string}). +(define current-test-value-formatter (make-parameter #f)) + ;;> The current test group as started by \scheme{test-group} or ;;> \scheme{test-begin}. diff --git a/lib/chibi/test.sld b/lib/chibi/test.sld index 4aa039c3..b5eef726 100644 --- a/lib/chibi/test.sld +++ b/lib/chibi/test.sld @@ -10,7 +10,7 @@ test-get-name! test-group-name test-group-ref test-group-set! test-group-inc! test-group-push! ;; parameters - current-test-verbosity + current-test-value-formatter current-test-verbosity current-test-applier current-test-skipper current-test-reporter current-test-group-reporter test-failure-count current-test-epsilon current-test-comparator