diff options
author | Mark H Weaver <mhw@netris.org> | 2011-03-22 11:11:53 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2011-03-22 11:45:53 -0400 |
commit | 8099352769c8b8ec8730f87f7fa6c8771b64efb9 (patch) | |
tree | 470bfa8217d0c8494927a22bf37ee5860851b72c | |
parent | 190d4b0d93599e5b58e773dc6375054c3a6e3dbf (diff) | |
download | guile-8099352769c8b8ec8730f87f7fa6c8771b64efb9.tar.gz |
Do not enter the debugger if the thrown key is in `pass-keys'
* module/system/repl/error-handling.scm (call-with-error-handling):
Do _not_ enter the debugger if the thrown key is in `pass-keys'.
Previously, for example, (throw 'quit) entered the debugger when run
from the REPL, despite the fact that 'quit is in `pass-keys'.
-rw-r--r-- | module/system/repl/error-handling.scm | 43 |
1 files changed, 22 insertions, 21 deletions
diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm index c94db24aa..c6c64cc73 100644 --- a/module/system/repl/error-handling.scm +++ b/module/system/repl/error-handling.scm @@ -122,27 +122,28 @@ (case on-error ((debug) (lambda (key . args) - (let* ((tag (and (pair? (fluid-ref %stacks)) - (cdar (fluid-ref %stacks)))) - (stack (narrow-stack->vector - (make-stack #t) - ;; Cut three frames from the top of the stack: - ;; make-stack, this one, and the throw handler. - 3 - ;; Narrow the end of the stack to the most recent - ;; start-stack. - tag - ;; And one more frame, because %start-stack invoking - ;; the start-stack thunk has its own frame too. - 0 (and tag 1))) - (error-msg (error-string stack key args)) - (debug (make-debug stack 0 error-msg #f))) - (with-saved-ports - (lambda () - (format #t "~a~%" error-msg) - (format #t "Entering a new prompt. ") - (format #t "Type `,bt' for a backtrace or `,q' to continue.\n") - ((@ (system repl repl) start-repl) #:debug debug)))))) + (if (not (memq key pass-keys)) + (let* ((tag (and (pair? (fluid-ref %stacks)) + (cdar (fluid-ref %stacks)))) + (stack (narrow-stack->vector + (make-stack #t) + ;; Cut three frames from the top of the stack: + ;; make-stack, this one, and the throw handler. + 3 + ;; Narrow the end of the stack to the most recent + ;; start-stack. + tag + ;; And one more frame, because %start-stack invoking + ;; the start-stack thunk has its own frame too. + 0 (and tag 1))) + (error-msg (error-string stack key args)) + (debug (make-debug stack 0 error-msg #f))) + (with-saved-ports + (lambda () + (format #t "~a~%" error-msg) + (format #t "Entering a new prompt. ") + (format #t "Type `,bt' for a backtrace or `,q' to continue.\n") + ((@ (system repl repl) start-repl) #:debug debug))))))) ((report) (lambda (key . args) (if (not (memq key pass-keys)) |