Skip to content
Snippets Groups Projects
Commit b662ca74 authored by gerd's avatar gerd
Browse files

The debugger computes active restarts in a dynamic environment

	that can be different from the dynamic environment at the point
	where the user chooses one of the computed restarts.  Effect: The
	debugger offers a restart, but complains that it isn't active
	when the restart is chosen.

	* src/code/error.lisp (%invoke-restart-interactively): New function.
	(invoke-restart-interactively): Use it.
	* src/code/debug.lisp (make-restart-commands): Use it.
parent fd9fcb92
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug.lisp,v 1.61 2003/06/26 13:27:42 toy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug.lisp,v 1.62 2003/07/20 11:02:48 gerd Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1151,8 +1151,17 @@ See the CMU Common Lisp User's Manual for more information. ...@@ -1151,8 +1151,17 @@ See the CMU Common Lisp User's Manual for more information.
(num 0)) ; better be the same as show-restarts! (num 0)) ; better be the same as show-restarts!
(dolist (restart restarts) (dolist (restart restarts)
(let ((name (string (restart-name restart)))) (let ((name (string (restart-name restart))))
;;
;; Use %Invoke-Restart-Interactively because the dynamic
;; environment when the debugger invokes the restart can be
;; different from the dynamic environment when the debugger
;; computes active restarts. If this is the case,
;; Invoke-Restart-Interactively might find that the restart
;; being invoked is not currently active and signal a
;; Control-Error.
(let ((restart-fun (let ((restart-fun
#'(lambda () (invoke-restart-interactively restart)))) (lambda ()
(conditions::%invoke-restart-interactively restart))))
(push (cons (format nil "~d" num) restart-fun) commands) (push (cons (format nil "~d" num) restart-fun) commands)
(unless (or (null (restart-name restart)) (unless (or (null (restart-name restart))
(find name commands :key #'car :test #'string=)) (find name commands :key #'car :test #'string=))
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.75 2003/05/03 11:22:09 gerd Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.76 2003/07/20 11:02:48 gerd Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -209,13 +209,19 @@ ...@@ -209,13 +209,19 @@
(error 'simple-control-error (error 'simple-control-error
:format-control "Restart ~S is not active." :format-control "Restart ~S is not active."
:format-arguments (list restart))) :format-arguments (list restart)))
(apply (restart-function real-restart) (%invoke-restart-interactively real-restart)))
(let ((interactive-function
(restart-interactive-function real-restart)))
(if interactive-function
(funcall interactive-function)
'())))))
;;;
;;; Like Invoke-Restart-Interactively, but don't check if the restart
;;; is currently active. Used by the debugger.
;;;
(defun %invoke-restart-interactively (restart)
(apply (restart-function restart)
(let ((interactive-function
(restart-interactive-function restart)))
(if interactive-function
(funcall interactive-function)
'()))))
(eval-when (compile load eval) (eval-when (compile load eval)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment