diff options
author | Michael Käppler <xmichael-k@web.de> | 2024-04-02 08:58:52 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2024-05-06 11:51:53 +0200 |
commit | 80d4055e4213763e2d3a0bfcc39d6b55c52f5415 (patch) | |
tree | eee3e23a22d33a3eed23e9f83814f0a600f59728 /module/ice-9 | |
parent | 57a889b7282dab303c4cdc49cccbbe22f961bd1c (diff) | |
download | guile-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.scm | 3 | ||||
-rw-r--r-- | module/ice-9/r6rs-libraries.scm | 17 |
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)))))))) |