summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ccwl/ui.scm15
-rw-r--r--tests/ui.scm12
2 files changed, 23 insertions, 4 deletions
diff --git a/ccwl/ui.scm b/ccwl/ui.scm
index 7f5c76a..3b46a23 100644
--- a/ccwl/ui.scm
+++ b/ccwl/ui.scm
@@ -20,6 +20,7 @@
#:use-module (rnrs io ports)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-28)
+ #:use-module (ice-9 string-fun)
#:use-module (term ansi-color)
#:use-module (ccwl conditions)
#:export (report-formatted-message
@@ -29,9 +30,17 @@
"Report @var{exception}, a @code{&formatted-message} condition to the
user."
(display (apply format
- (formatted-message-format exception)
- (map (cut colorize-string <> 'BOLD 'MAGENTA)
- (formatted-message-arguments exception)))
+ ;; We colorize the format specifiers instead of the
+ ;; arguments because we cannot always be sure that
+ ;; the arguments are strings.
+ (string-replace-substring
+ (string-replace-substring
+ (formatted-message-format exception)
+ "~a"
+ (colorize-string "~a" 'BOLD 'MAGENTA))
+ "~s"
+ (colorize-string "~s" 'BOLD 'MAGENTA))
+ (formatted-message-arguments exception))
(current-error-port))
(newline (current-error-port)))
diff --git a/tests/ui.scm b/tests/ui.scm
index 4189e6c..a5741c0 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -17,7 +17,9 @@
;;; along with ccwl. If not, see <https://www.gnu.org/licenses/>.
(use-modules (srfi srfi-64)
- (term ansi-color))
+ (term ansi-color)
+ (ccwl ui)
+ (ccwl conditions))
(define source-in-context
(@@ (ccwl ui) source-in-context))
@@ -43,4 +45,12 @@
(call-with-input-string "(foo (bar))"
(cut source-in-context <> 0 5)))
+(test-assert "report-formatted-message must not fail on arguments that are not strings"
+ (call-with-output-string
+ (lambda (port)
+ (with-error-to-port port
+ (lambda ()
+ (report-formatted-message
+ (formatted-message "Foo ~a" 'bar)))))))
+
(test-end "ui")