From 5731998a20ca14e4a72d81e985779a8ea56801e5 Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Thu, 17 Apr 2003 12:55:57 +0000
Subject: [PATCH] 	Fix for COMPUTE-RESTARTS.9 from Paul Dietz' test
 suite.

	* src/code/error.lisp (%find-restarts): New function.
	(munge-restart-case-expression): Use it instead of find-restart
	which returns only one restart object for restarts with equal
	names.
---
 code/error.lisp | 31 ++++++++++++++++++++++---------
 1 file changed, 22 insertions(+), 9 deletions(-)

diff --git a/code/error.lisp b/code/error.lisp
index 00b5a659a..36bb3443a 100644
--- a/code/error.lisp
+++ b/code/error.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.69 2003/04/16 19:41:05 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.70 2003/04/17 12:55:57 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -218,6 +218,22 @@
 
 
 (eval-when (compile load eval)
+
+;;;
+;;; Return a list of restarts with names NAMES, taking duplicate
+;;; names into account.
+;;;
+(defun %find-restarts (names)
+  (let ((all (compute-restarts)))
+    (collect ((restarts))
+      (dolist (name names (restarts))
+	(let ((restart (find-if (lambda (x)
+				  (or (eq x name)
+				      (eq (restart-name x) name)))
+				all)))
+	  (restarts restart)
+	  (setq all (delete restart all)))))))
+
 ;;; Wrap the restart-case expression in a with-condition-restarts if
 ;;; appropriate.  Gross, but it's what the book seems to say...
 ;;;
@@ -235,14 +251,11 @@
 					(signal 'simple-condition)
 					(t 'simple-error))
 				    ',name)))
-		`(with-condition-restarts
-		     ,n-cond
-		     (list ,@(mapcar #'(lambda (da)
-					 `(find-restart ',(nth 0 da)))
-				     data))
-		   ,(if (eq name 'cerror)
-			`(cerror ,(second expression) ,n-cond)
-			`(,name ,n-cond))))
+		 `(with-condition-restarts ,n-cond
+		      (%find-restarts ',(mapcar (lambda (x) (nth 0 x)) data))
+		    ,(if (eq name 'cerror)
+			 `(cerror ,(second expression) ,n-cond)
+			 `(,name ,n-cond))))
 	      expression))
 	expression)))
 
-- 
GitLab