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/system | |
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/system')
-rw-r--r-- | module/system/base/compile.scm | 2 | ||||
-rw-r--r-- | module/system/repl/command.scm | 4 | ||||
-rw-r--r-- | module/system/repl/common.scm | 7 | ||||
-rw-r--r-- | module/system/vm/traps.scm | 7 |
4 files changed, 13 insertions, 7 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index a33d012bd..f7e82404e 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -53,7 +53,7 @@ (dynamic-wind (lambda () (when entered - (error "thunk may only be entered once: ~a" thunk)) + (error (format #f "thunk may only be entered once: ~a" thunk))) (set! entered #t)) thunk (lambda () #t)))) diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index e5a4d672b..ca7450610 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -672,7 +672,7 @@ Break on calls to PROCEDURE. Starts a recursive prompt when PROCEDURE is called." (let ((proc (repl-eval repl (repl-parse repl form)))) (if (not (procedure? proc)) - (error "Not a procedure: ~a" proc) + (error (format #f "Not a procedure: ~a" proc)) (let ((idx (add-trap-at-procedure-call! proc))) (format #t "Trap ~a: ~a.~%" idx (trap-name idx)))))) @@ -783,7 +783,7 @@ A tracepoint will print out the procedure and its arguments, when it is called, and its return value(s) when it returns." (let ((proc (repl-eval repl (repl-parse repl form)))) (if (not (procedure? proc)) - (error "Not a procedure: ~a" proc) + (error (format #f "Not a procedure: ~a" proc)) (let ((idx (add-trace-at-procedure-call! proc))) (format #t "Trap ~a: ~a.~%" idx (trap-name idx)))))) diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm index 88ef93d3e..a3f2032ba 100644 --- a/module/system/repl/common.scm +++ b/module/system/repl/common.scm @@ -142,7 +142,12 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.") (lambda (x) (if (memq x vals) x - (error "Bad on-error value ~a; expected one of ~a" x vals)))))))) + (error + (format + #f + "Bad on-error value ~a; expected one of ~a" + x + vals))))))))) (define %make-repl make-repl) (define* (make-repl lang #:optional debug) diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm index cd0e13cc9..6c5d1e788 100644 --- a/module/system/vm/traps.scm +++ b/module/system/vm/traps.scm @@ -76,10 +76,10 @@ (syntax-rules () ((_ arg predicate? message) (if (not (predicate? arg)) - (error "bad argument ~a: ~a" 'arg message))) + (error (format #f "bad argument ~a: ~a" 'arg message)))) ((_ arg predicate?) (if (not (predicate? arg)) - (error "bad argument ~a: expected ~a" 'arg 'predicate?))))) + (error (format #f "bad argument ~a: expected ~a" 'arg 'predicate?)))))) (define (new-disabled-trap enable disable) (let ((enabled? #f)) @@ -378,7 +378,8 @@ current-frame))) procs)) (if (null? traps) - (error "No procedures found at ~a:~a." file user-line))) + (error + (format #f "No procedures found at ~a:~a." file user-line)))) (lambda (frame) (for-each (lambda (trap) (trap frame)) traps) (set! traps #f))))))) |