From 474fc1a3f49fdf5024a7e3850ca7afa6eb76bfc5 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Sun, 23 Mar 2003 05:04:50 +0000
Subject: [PATCH] Added tests for associating restarts with a condition from an
 error, warn, cerror, or signal form.

---
 ansi-tests/restart-case.lsp | 56 +++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)

diff --git a/ansi-tests/restart-case.lsp b/ansi-tests/restart-case.lsp
index 249edb80..cde141b1 100644
--- a/ansi-tests/restart-case.lsp
+++ b/ansi-tests/restart-case.lsp
@@ -186,5 +186,61 @@
       (foo () 'good))))
   good)
 
+(deftest restart-case.26
+  (let ((c2 (make-condition 'error))
+	(c1 (make-condition 'error)))
+    (handler-bind
+     ((error #'(lambda (c) (invoke-restart (find-restart 'foo c)))))
+     (restart-case
+      (restart-case
+       (signal (progn (signal c2) c1))
+       (foo () 'bad))
+      (foo () 'good))))
+  good)
+
+(deftest restart-case.27
+  (let ((c2 (make-condition 'error)))
+    (handler-bind
+     ((error #'(lambda (c) (invoke-restart (find-restart 'foo c)))))
+     (restart-case
+      (restart-case
+       (cerror "Boo!" (signal c2))
+       (foo () 'bad))
+      (foo () 'good))))
+  good)
 
+(deftest restart-case.28
+  (let ((c2 (make-condition 'warning)))
+    (handler-bind
+     ((warning #'(lambda (c) (invoke-restart (find-restart 'foo c)))))
+     (restart-case
+      (restart-case
+       (warn "Boo!" (signal c2))
+       (foo () 'bad))
+      (foo () 'good))))
+  good)
+
+(deftest restart-case.29
+  (macrolet ((%m (&rest args) (cons 'error args)))
+    (let ((c2 (make-condition 'error)))
+      (handler-bind
+       ((error #'(lambda (c) (invoke-restart (find-restart 'foo c)))))
+       (restart-case
+	(restart-case
+	 (%m "Boo!" (signal c2))
+	 (foo () 'bad))
+	(foo () 'good)))))
+  good)
+
+(deftest restart-case.30
+  (symbol-macrolet ((%m (error "Boo!" (signal c2))))
+    (let ((c2 (make-condition 'error)))
+      (handler-bind
+       ((error #'(lambda (c) (invoke-restart (find-restart 'foo c)))))
+       (restart-case
+	(restart-case
+	 %m
+	 (foo () 'bad))
+	(foo () 'good)))))
+  good)
 
-- 
GitLab