mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

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

Browse source 
* 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'.
This commit is contained in:
Mark H Weaver 2011-03-22 11:11:53 -04:00
parent 190d4b0d93
commit 8099352769
1 changed files with 22 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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))