mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-10 15:50:50 +02:00
Code Activity

Fixlets for REPL error handling.

Browse source 
* module/system/repl/error-handling.scm (error-string): Don't call
  `display-error' when STACK is empty.
  (call-with-error-handling): Display ERROR-MSG instead of using
  `format', since ERROR-MSG may contain `format' escapes.

* module/system/repl/repl.scm (run-repl): Add missing argument to
  `format'.
This commit is contained in:
Ludovic Courtès 2010-10-08 13:50:24 +02:00
parent 7f593bc7f9
commit 7390e4bd11
2 changed files with 3 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

3
module/system/repl/error-handling.scm
View file

@ -38,6 +38,7 @@
(lambda () (lambda ()
(pmatch args (pmatch args
((,subr ,msg ,args . ,rest) ((,subr ,msg ,args . ,rest)
(guard (> (vector-length stack) 0))
(display-error (vector-ref stack 0) (current-output-port) (display-error (vector-ref stack 0) (current-output-port)
subr msg args rest)) subr msg args rest))
(else (else
@ -147,7 +148,7 @@
(debug (make-debug stack 0 error-msg))) (debug (make-debug stack 0 error-msg)))
(with-saved-ports (with-saved-ports
(lambda () (lambda ()
(format #t error-msg) (display error-msg)
(format #t "Entering a new prompt. ") (format #t "Entering a new prompt. ")
(format #t "Type `,bt' for a backtrace or `,q' to continue.\n") (format #t "Type `,bt' for a backtrace or `,q' to continue.\n")
((@ (system repl repl) start-repl) #:debug debug)))))) ((@ (system repl repl) start-repl) #:debug debug))))))

2
module/system/repl/repl.scm
View file

@ -129,7 +129,7 @@
(if (eq? k 'quit) (if (eq? k 'quit)
(abort args) (abort args)
(begin (begin
(format #t "While executing meta-command:~%" string) (format #t "While executing meta-command `~A'~%" string)
(pmatch args (pmatch args
((,subr ,msg ,args . ,rest) ((,subr ,msg ,args . ,rest)
(display-error #f (current-output-port) subr msg args rest)) (display-error #f (current-output-port) subr msg args rest))