summaryrefslogtreecommitdiff
path: root/module/ice-9
diff options
context:
space:
mode:
authorMichael Käppler <xmichael-k@web.de>2024-04-02 08:58:52 +0200
committerLudovic Courtès <ludo@gnu.org>2024-05-06 11:51:53 +0200
commit80d4055e4213763e2d3a0bfcc39d6b55c52f5415 (patch)
treeeee3e23a22d33a3eed23e9f83814f0a600f59728 /module/ice-9
parent57a889b7282dab303c4cdc49cccbbe22f961bd1c (diff)
downloadguile-80d4055e4213763e2d3a0bfcc39d6b55c52f5415.tar.gz
Fix error messages containing format strings
The builtin primitive procedure `error` takes an optional message and a list of arguments to include into the error message. These args are formatted with `~S` and appended to the error message, so that an example call of `(error "Wrong argument: " 42)` results in the output "Wrong argument: 42" If format strings occur in the message itself, however, they are escaped. Thus a call like `(error "Wrong argument: ~a" 42)` is rendered as "Wrong argument: ~a 42" Some callers did not take this behavior into account, leading to confusing error messages. Changing the behavior of `error` to be both backwards-compatible and accept also format strings inside messages is not straightforward, because it would have to handle escaped `~` characters as well. Therefore, fix `error` call sites using format strings to use `format` before calling out to `error`. The following files are affected: * module/ice-9/format.scm (format) * module/ice-9/r6rs-libraries.scm (resolve-r6rs-interface) * module/oop/goops.scm (make) * module/srfi/srfi-37.scm (Comment at the beginning of file) * module/system/base/compile.scm (call-once) * module/system/repl/command.scm (break, tracepoint) * module/system/repl/common.scm (repl-default-options) * module/system/vm/traps.scm (arg-check, trap-at-source-location) There are a couple of further call sites that were left unchanged, either because they are using their own `error` procedure: * module/ice-9/read.scm * module/ice-9/command-line.scm or are not referenced from other modules: * module/system/base/lalr.upstream.scm: * module/sxml/upstream/assert.scm: * module/sxml/sxml-match.ss: Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'module/ice-9')
-rw-r--r--module/ice-9/format.scm3
-rw-r--r--module/ice-9/r6rs-libraries.scm17
2 files changed, 14 insertions, 6 deletions
diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index 01da71e90..e53649866 100644
--- a/module/ice-9/format.scm
+++ b/module/ice-9/format.scm
@@ -49,7 +49,8 @@
((boolean? destination) (current-output-port)) ; boolean but not false
((output-port? destination) destination)
(else
- (error "format: bad destination `~a'" destination)))))
+ (error
+ (simple-format #f "format: bad destination `~a'" destination))))))
(define %output-col (or (port-column port) 0))
(define %flush-output? #f)
diff --git a/module/ice-9/r6rs-libraries.scm b/module/ice-9/r6rs-libraries.scm
index f27b07841..90bfb5451 100644
--- a/module/ice-9/r6rs-libraries.scm
+++ b/module/ice-9/r6rs-libraries.scm
@@ -115,8 +115,10 @@
(for-each (lambda (sym)
(module-add! iface sym
(or (module-variable mod sym)
- (error "no binding `~A' in module ~A"
- sym mod)))
+ (error (format
+ #f
+ "no binding `~A' in module ~A"
+ sym mod))))
(when (hashq-ref (module-replacements mod) sym)
(hashq-set! (module-replacements iface) sym #t)))
(syntax->datum #'(identifier ...)))
@@ -131,7 +133,7 @@
mod)
(for-each (lambda (sym)
(unless (module-local-variable iface sym)
- (error "no binding `~A' in module ~A" sym mod))
+ (error (format #f "no binding `~A' in module ~A" sym mod)))
(module-remove! iface sym))
(syntax->datum #'(identifier ...)))
iface))
@@ -167,7 +169,11 @@
(replace? (vector-ref v 1))
(var (vector-ref v 2)))
(when (module-local-variable iface to)
- (error "duplicate binding for `~A' in module ~A" to mod))
+ (error (format
+ #f
+ "duplicate binding for `~A' in module ~A"
+ to
+ mod)))
(module-add! iface to var)
(when replace?
(hashq-set! replacements to #t))))
@@ -178,7 +184,8 @@
(to (cdar in))
(var (module-variable mod from))
(replace? (hashq-ref replacements from)))
- (unless var (error "no binding `~A' in module ~A" from mod))
+ (unless var (error
+ (format #f "no binding `~A' in module ~A" from mod)))
(module-remove! iface from)
(hashq-remove! replacements from)
(lp (cdr in) (cons (vector to replace? var) out))))))))