Changeset 6045


Ignore:
Timestamp:
03/01/04 17:25:55 (17 years ago)
Author:
piso
Message:

SIGNAL: respect *MAXIMUM-ERROR-DEPTH*.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/signal.lisp

    r5129 r6045  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: signal.lisp,v 1.1 2003-12-14 17:14:41 piso Exp $
     4;;; $Id: signal.lisp,v 1.2 2004-03-01 17:25:55 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2222(in-package "SYSTEM")
    2323
     24(defvar *maximum-error-depth* 10)
     25
     26(defvar *current-error-depth* 0)
     27
    2428(defvar *handler-clusters* ())
    2529
    2630(defvar *break-on-signals* nil)
    2731
     32;; Redefined in clos.lisp.
    2833(defun coerce-to-condition (datum arguments default-type fun-name)
    2934  (cond ((typep datum 'condition)
     
    3237                  :datum arguments
    3338                  :expected-type 'null
    34                   :format-control "you may not supply additional arguments when giving ~S to ~S"
     39                  :format-control "You may not supply additional arguments when giving ~S to ~S."
    3540                  :format-arguments (list datum fun-name)))
    3641   datum)
     
    4550    :datum datum
    4651    :expected-type '(or symbol string)
    47     :format-control "bad argument to ~S: ~S"
     52    :format-control "Bad argument to ~S: ~S."
    4853    :format-arguments (list fun-name datum)))))
    4954
     
    6469      (funcall (cdr handler) condition)))))
    6570    (when (typep condition 'error)
    66       (setf *saved-backtrace* (backtrace-as-list))
    67       (invoke-debugger condition))
     71      (let ((*current-error-depth* (1+ *current-error-depth*)))
     72        (cond ((> *current-error-depth* *maximum-error-depth*)
     73               (%format t "~%Help! Maximum error depth exceeded (~D nested errors).~%"
     74                        *current-error-depth*)
     75               (debug-loop))
     76              (t
     77               (setf *saved-backtrace* (backtrace-as-list))
     78               (invoke-debugger condition)))))
    6879    nil))
    6980
Note: See TracChangeset for help on using the changeset viewer.