summaryrefslogtreecommitdiff
path: root/module/system/repl/error-handling.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-03-16 15:27:26 +0100
committerAndy Wingo <wingo@pobox.com>2014-03-16 15:32:39 +0100
commit22806c244a624d3fd801ba739ca0670702815a6e (patch)
treec3aaef385a43d789dcb236b700d6c512066960a2 /module/system/repl/error-handling.scm
parentf57d4316c2048f0c58a47c56b63d25d10511f98f (diff)
downloadguile-22806c244a624d3fd801ba739ca0670702815a6e.tar.gz
Document stack-overflow handlers, limits, and unwind-only exceptions
* module/system/repl/error-handling.scm (call-with-error-handling): Add #:report-keys kwarg, so that unwind-only exceptions (stack-overflow in particular) get reported. * doc/ref/api-debug.texi (Pre-Unwind Debugging): Add documentation for #:report-keys kwarg of call-with-error-handling. (Stack Overflow): New subsubsection. (Debug Options): Remove discussion of stack overflow.
Diffstat (limited to 'module/system/repl/error-handling.scm')
-rw-r--r--module/system/repl/error-handling.scm48
1 files changed, 22 insertions, 26 deletions
diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm
index d0d7967a3..eea7b9701 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -1,6 +1,6 @@
;;; Error handling in the REPL
-;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -42,7 +42,8 @@
(define* (call-with-error-handling thunk #:key
(on-error 'debug) (post-error 'catch)
- (pass-keys '(quit)) (trap-handler 'debug))
+ (pass-keys '(quit)) (trap-handler 'debug)
+ (report-keys '(stack-overflow)))
(let ((in (current-input-port))
(out (current-output-port))
(err (current-error-port)))
@@ -92,6 +93,14 @@
((disabled) #f)
(else (error "Unknown trap-handler strategy" trap-handler))))
+ (define (report-error key args)
+ (with-saved-ports
+ (lambda ()
+ (run-hook before-error-hook)
+ (print-exception err #f key args)
+ (run-hook after-error-hook)
+ (force-output err))))
+
(catch #t
(lambda ()
(with-default-trap-handler le-trap-handler
@@ -103,17 +112,15 @@
(if (memq key pass-keys)
(apply throw key args)
(begin
- (with-saved-ports
- (lambda ()
- (run-hook before-error-hook)
- (print-exception err #f key args)
- (run-hook after-error-hook)
- (force-output err)))
+ (report-error key args)
(if #f #f)))))
((catch)
(lambda (key . args)
- (if (memq key pass-keys)
- (apply throw key args))))
+ (when (memq key pass-keys)
+ (apply throw key args))
+ (when (memq key report-keys)
+ (report-error key args))
+ (if #f #f)))
(else
(if (procedure? post-error)
(lambda (k . args)
@@ -147,15 +154,9 @@
((@ (system repl repl) start-repl) #:debug debug)))))))
((report)
(lambda (key . args)
- (if (not (memq key pass-keys))
- (begin
- (with-saved-ports
- (lambda ()
- (run-hook before-error-hook)
- (print-exception err #f key args)
- (run-hook after-error-hook)
- (force-output err)))
- (if #f #f)))))
+ (unless (memq key pass-keys)
+ (report-error key args))
+ (if #f #f)))
((backtrace)
(lambda (key . args)
(if (not (memq key pass-keys))
@@ -165,13 +166,8 @@
(make-stack #t)
;; Narrow as above, for the debugging case.
3 tag 0 (and tag 1))))
- (with-saved-ports
- (lambda ()
- (print-frames frames)
- (run-hook before-error-hook)
- (print-exception err #f key args)
- (run-hook after-error-hook)
- (force-output err)))
+ (with-saved-ports (lambda () (print-frames frames)))
+ (report-error key args)
(if #f #f)))))
((pass)
(lambda (key . args)