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

Fix for RESTART-CASE.29, RESTART-CASE.30, RESTART-CASE.31

	test cases.

	* src/code/error.lisp (munge-restart-case-expression) Add
	environment parameter.
	(restart-case): Add &environment and pass it to
	munge-restart-case-expression.
parent 5731998a
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/error.lisp,v 1.70 2003/04/17 12:55:57 gerd Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.71 2003/04/17 13:12:28 gerd Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -237,8 +237,8 @@ ...@@ -237,8 +237,8 @@
;;; Wrap the restart-case expression in a with-condition-restarts if ;;; Wrap the restart-case expression in a with-condition-restarts if
;;; appropriate. Gross, but it's what the book seems to say... ;;; appropriate. Gross, but it's what the book seems to say...
;;; ;;;
(defun munge-restart-case-expression (expression data) (defun munge-restart-case-expression (expression data env)
(let ((exp (macroexpand expression))) (let ((exp (macroexpand expression env)))
(if (consp exp) (if (consp exp)
(let* ((name (car exp)) (let* ((name (car exp))
(args (if (eq name 'cerror) (cddr exp) (cdr exp)))) (args (if (eq name 'cerror) (cddr exp) (cdr exp))))
...@@ -261,7 +261,7 @@ ...@@ -261,7 +261,7 @@
); eval-when (compile load eval) ); eval-when (compile load eval)
(defmacro restart-case (expression &body clauses) (defmacro restart-case (expression &body clauses &environment env)
"(RESTART-CASE form "(RESTART-CASE form
{(case-name arg-list {keyword value}* body)}*) {(case-name arg-list {keyword value}* body)}*)
The form is evaluated in a dynamic context where the clauses have special The form is evaluated in a dynamic context where the clauses have special
...@@ -317,7 +317,7 @@ ...@@ -317,7 +317,7 @@
,@keys))) ,@keys)))
data) data)
(return-from ,block-tag (return-from ,block-tag
,(munge-restart-case-expression expression data))) ,(munge-restart-case-expression expression data env)))
,@(mapcan #'(lambda (datum) ,@(mapcan #'(lambda (datum)
(let ((tag (nth 1 datum)) (let ((tag (nth 1 datum))
(bvl (nth 3 datum)) (bvl (nth 3 datum))
......
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