summaryrefslogtreecommitdiff
path: root/module/system
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/system
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/system')
-rw-r--r--module/system/base/compile.scm2
-rw-r--r--module/system/repl/command.scm4
-rw-r--r--module/system/repl/common.scm7
-rw-r--r--module/system/vm/traps.scm7
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)))))))