summaryrefslogtreecommitdiff
path: root/module/system/repl/error-handling.scm
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2011-03-22 11:11:53 -0400
committerMark H Weaver <mhw@netris.org>2011-03-22 11:45:53 -0400
commit8099352769c8b8ec8730f87f7fa6c8771b64efb9 (patch)
tree470bfa8217d0c8494927a22bf37ee5860851b72c /module/system/repl/error-handling.scm
parent190d4b0d93599e5b58e773dc6375054c3a6e3dbf (diff)
downloadguile-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'.
Diffstat (limited to 'module/system/repl/error-handling.scm')
-rw-r--r--module/system/repl/error-handling.scm43
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))