[PATCH] Do not enter the debugger if the thrown key is in `pass-keys'

[Mark H Weaver]

FYI, I just pushed this small bug fix.

    Mark


>From 8099352769c8b8ec8730f87f7fa6c8771b64efb9 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Tue, 22 Mar 2011 11:11:53 -0400
Subject: [PATCH] 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'.
---
 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 c94db24..c6c64cc 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))
-- 
1.7.1