From 4a62a77568fcf738f0b06c16361774493aa21d33 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Mon, 24 Mar 2003 03:13:52 +0000
Subject: [PATCH] Finished adding tess for the conditions section.  Mostly
 restarts.

---
 ansi-tests/abort.lsp                   | 53 ++++++++++++++
 ansi-tests/compute-restarts.lsp        | 21 ++++++
 ansi-tests/continue.lsp                | 54 +++++++++++++++
 ansi-tests/load-conditions.lsp         |  7 ++
 ansi-tests/muffle-warning.lsp          | 53 ++++++++++++++
 ansi-tests/restart-case.lsp            | 14 ++++
 ansi-tests/store-value.lsp             | 52 ++++++++++++++
 ansi-tests/use-value.lsp               | 53 ++++++++++++++
 ansi-tests/with-condition-restarts.lsp | 96 ++++++++++++++++++++++++++
 ansi-tests/with-simple-restart.lsp     | 54 +++++++++++++++
 10 files changed, 457 insertions(+)
 create mode 100644 ansi-tests/abort.lsp
 create mode 100644 ansi-tests/continue.lsp
 create mode 100644 ansi-tests/muffle-warning.lsp
 create mode 100644 ansi-tests/store-value.lsp
 create mode 100644 ansi-tests/use-value.lsp
 create mode 100644 ansi-tests/with-condition-restarts.lsp
 create mode 100644 ansi-tests/with-simple-restart.lsp

diff --git a/ansi-tests/abort.lsp b/ansi-tests/abort.lsp
new file mode 100644
index 00000000..df4f3ddc
--- /dev/null
+++ b/ansi-tests/abort.lsp
@@ -0,0 +1,53 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun Mar 23 08:25:50 2003
+;;;; Contains: Tests of the ABORT restart and function
+
+(in-package :cl-test)
+
+(deftest abort.1
+  (restart-case
+   (progn (abort) 'bad)
+   (abort () 'good))
+  good)
+
+(deftest abort.2
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (abort c2))
+     (abort () 'bad)
+     (abort () 'good)))
+  good)
+
+(deftest abort.3
+  (restart-case
+   (progn (abort nil) 'bad)
+   (abort () 'good))
+  good)
+
+(deftest abort.4
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (abort nil))
+     (abort () 'good)
+     (abort () 'bad)))
+  good)
+
+(deftest abort.5
+  (classify-error
+   (let ((c1 (make-condition 'error))
+	 (c2 (make-condition 'error)))
+     (with-condition-restarts
+      c1
+      (compute-restarts)
+      ;; All conditions are now associated with c1
+      (abort c2))))
+  control-error)
diff --git a/ansi-tests/compute-restarts.lsp b/ansi-tests/compute-restarts.lsp
index c1550a95..21e5bd8f 100644
--- a/ansi-tests/compute-restarts.lsp
+++ b/ansi-tests/compute-restarts.lsp
@@ -100,6 +100,27 @@
 	(foo () 'also-bad)))))
   nil nil)
 
+(deftest compute-restarts.10
+  (let ((c2 (make-condition 'error)))
+    (block done
+      (handler-bind
+       ((error #'(lambda (c)
+		   (declare (ignore c))
+		   (let* ((restarts (compute-restarts c2))
+			  (r (remove 'foo restarts
+				     :test-not #'eq
+				     :key #'restart-name)))
+		     ;; (write restarts)
+		     (return-from done
+		       (values r
+			       (mapcar #'restart-name r)))))))
+       (restart-case
+	(progn (error "an error"))
+	(foo () :test (lambda (c) (or (null c) (not (eq c c2))))
+	     'bad)
+	(foo () :test (lambda (c) (or (null c) (not (eq c c2))))
+	     'also-bad)))))
+  nil nil)
 
 
 
diff --git a/ansi-tests/continue.lsp b/ansi-tests/continue.lsp
new file mode 100644
index 00000000..bc3c1c77
--- /dev/null
+++ b/ansi-tests/continue.lsp
@@ -0,0 +1,54 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun Mar 23 08:37:15 2003
+;;;; Contains: Tests of CONTINUE restart and function
+
+(in-package :cl-test)
+
+(deftest continue.1
+  (restart-case
+   (progn (continue) 'bad)
+   (continue () 'good))
+  good)
+
+(deftest continue.2
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (continue c2))
+     (continue () 'bad)
+     (continue () 'good)))
+  good)
+
+(deftest continue.3
+  (restart-case
+   (progn (continue nil) 'bad)
+   (continue () 'good))
+  good)
+
+(deftest continue.4
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (continue nil))
+     (continue () 'good)
+     (continue () 'bad)))
+  good)
+
+(deftest continue.5
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (with-condition-restarts
+     c1
+     (compute-restarts)
+     ;; All conditions are now associated with c1
+     (continue c2)))
+  nil)
+
+
diff --git a/ansi-tests/load-conditions.lsp b/ansi-tests/load-conditions.lsp
index 6108bafc..6cded241 100644
--- a/ansi-tests/load-conditions.lsp
+++ b/ansi-tests/load-conditions.lsp
@@ -15,3 +15,10 @@
 (load "compute-restarts.lsp")
 (load "restart-bind.lsp")
 (load "restart-case.lsp")
+(load "with-condition-restarts.lsp")
+(load "with-simple-restart.lsp")
+(load "abort.lsp")
+(load "muffle-warning.lsp")
+(load "continue.lsp")
+(load "store-value.lsp")
+(load "use-value.lsp")
diff --git a/ansi-tests/muffle-warning.lsp b/ansi-tests/muffle-warning.lsp
new file mode 100644
index 00000000..6981c553
--- /dev/null
+++ b/ansi-tests/muffle-warning.lsp
@@ -0,0 +1,53 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun Mar 23 08:46:05 2003
+;;;; Contains: Tests of the MUFFLE-WARNING restart and function
+
+(in-package :cl-test)
+
+(deftest muffle-warning.1
+  (restart-case
+   (progn (muffle-warning) 'bad)
+   (muffle-warning () 'good))
+  good)
+
+(deftest muffle-warning.2
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (muffle-warning c2))
+     (muffle-warning () 'bad)
+     (muffle-warning () 'good)))
+  good)
+
+(deftest muffle-warning.3
+  (restart-case
+   (progn (muffle-warning nil) 'bad)
+   (muffle-warning () 'good))
+  good)
+
+(deftest muffle-warning.4
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (muffle-warning nil))
+     (muffle-warning () 'good)
+     (muffle-warning () 'bad)))
+  good)
+
+(deftest muffle-warning.5
+  (classify-error
+   (let ((c1 (make-condition 'error))
+	 (c2 (make-condition 'error)))
+     (with-condition-restarts
+      c1
+      (compute-restarts)
+      ;; All conditions are now associated with c1
+      (muffle-warning c2))))
+  control-error)
diff --git a/ansi-tests/restart-case.lsp b/ansi-tests/restart-case.lsp
index 3915221e..a079cd9d 100644
--- a/ansi-tests/restart-case.lsp
+++ b/ansi-tests/restart-case.lsp
@@ -287,6 +287,20 @@
 	  (list x w z y))))
   (b a d c))
 
+(deftest restart-case.35
+  (restart-case
+   (loop for i from 1 to 4
+	 for r in (compute-restarts)
+	 collect (restart-name r))
+   (foo () t)
+   (bar () t)
+   (foo () 'a)
+   (nil () :report (lambda (s) (format s "Anonymous restart"))  10))
+  (foo bar foo nil))
+
+
+
+
 
 
 
diff --git a/ansi-tests/store-value.lsp b/ansi-tests/store-value.lsp
new file mode 100644
index 00000000..3699ccc7
--- /dev/null
+++ b/ansi-tests/store-value.lsp
@@ -0,0 +1,52 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun Mar 23 09:10:22 2003
+;;;; Contains: Tests for STORE-VALUE restart and function
+
+(in-package :cl-test)
+
+(deftest store-value.1
+  (restart-case
+   (progn (store-value 10) 'bad)
+   (store-value (x) (list x 'good)))
+  (10 good))
+
+(deftest store-value.2
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (store-value 17 c2))
+     (store-value (x) (list x 'bad))
+     (store-value (x) (list x 'good))))
+  (17 good))
+
+(deftest store-value.3
+  (restart-case
+   (progn (store-value 11 nil) 'bad)
+   (store-value (x) (list x 'good)))
+  (11 good))
+
+(deftest store-value.4
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (store-value 18 nil))
+     (store-value (x) (list x 'good))
+     (store-value (x) (list x 'bad))))
+  (18 good))
+
+(deftest store-value.5
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+     (with-condition-restarts
+      c1
+      (compute-restarts)
+      ;; All conditions are now associated with c1
+      (store-value 21 c2)))
+  nil)
diff --git a/ansi-tests/use-value.lsp b/ansi-tests/use-value.lsp
new file mode 100644
index 00000000..33328a97
--- /dev/null
+++ b/ansi-tests/use-value.lsp
@@ -0,0 +1,53 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun Mar 23 09:13:59 2003
+;;;; Contains: Tests for USE-VALUE restart and function
+
+(in-package :cl-test)
+
+(deftest use-value.1
+  (restart-case
+   (progn (use-value 10) 'bad)
+   (use-value (x) (list x 'good)))
+  (10 good))
+
+(deftest use-value.2
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (use-value 17 c2))
+     (use-value (x) (list x 'bad))
+     (use-value (x) (list x 'good))))
+  (17 good))
+
+(deftest use-value.3
+  (restart-case
+   (progn (use-value 11 nil) 'bad)
+   (use-value (x) (list x 'good)))
+  (11 good))
+
+(deftest use-value.4
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c1
+      (list (first (compute-restarts)))
+      (use-value 18 nil))
+     (use-value (x) (list x 'good))
+     (use-value (x) (list x 'bad))))
+  (18 good))
+
+(deftest use-value.5
+  (let ((c1 (make-condition 'error))
+	(c2 (make-condition 'error)))
+     (with-condition-restarts
+      c1
+      (compute-restarts)
+      ;; All conditions are now associated with c1
+      (use-value 21 c2)))
+  nil)
+
diff --git a/ansi-tests/with-condition-restarts.lsp b/ansi-tests/with-condition-restarts.lsp
new file mode 100644
index 00000000..b6f5cc70
--- /dev/null
+++ b/ansi-tests/with-condition-restarts.lsp
@@ -0,0 +1,96 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun Mar 23 04:06:06 2003
+;;;; Contains: Tests of WITH-CONDITION-RESTARTS
+
+(in-package :cl-test)
+
+(deftest with-condition-restarts.1
+  (let (a b c (i 0))
+    (values
+     (with-condition-restarts
+      (progn (setf a (incf i)) (make-condition 'error))
+      (progn (setf b (incf i)) nil)
+      (setf c (incf i)))
+     a b c i))
+  3 1 2 3 3)
+
+(deftest with-condition-restarts.2
+  (with-condition-restarts
+   (make-condition 'error)
+   nil
+   (values)))
+
+(deftest with-condition-restarts.3
+  (with-condition-restarts
+   (make-condition 'error)
+   nil
+   (values 'a 'b 'c 'd 'e 'f))
+  a b c d e f)
+
+(deftest with-condition-restarts.4
+  (block done
+    (tagbody
+     (with-condition-restarts
+      (make-condition 'error)
+      nil
+      (go 10)
+      10
+      (return-from done 'bad))
+     10
+     (return-from done 'good)))
+  good)
+
+(deftest with-condition-restarts.5
+  (let ((c (make-condition 'error)))
+    (restart-case
+     (with-condition-restarts
+      c
+      (list (find-restart 'foo))
+      'good)
+     (foo () 'bad)))
+  good)
+
+(deftest with-condition-restarts.6
+  (let ((c (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (handler-bind
+     ((error #'(lambda (c) (invoke-restart (find-restart 'foo c2)))))
+     (restart-case
+      (with-condition-restarts
+       c
+       (list (find-restart 'foo))
+       (signal c2))
+      (foo () 'bad)
+      (foo () 'good))))
+  good)
+
+(deftest with-condition-restarts.7
+  (let ((c (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (handler-bind
+     ((error #'(lambda (c) (invoke-restart 'foo))))
+     (restart-case
+      (with-condition-restarts
+       c
+       (list (find-restart 'foo))
+       (signal c2))
+      (foo () 'good)
+      (foo () 'bad))))
+  good)
+
+;;; test that the association of a restart with a condition
+;;; has dynamic extent
+
+(deftest with-condition-restarts.8
+  (let ((c (make-condition 'error))
+	(c2 (make-condition 'error)))
+    (restart-case
+     (progn
+       (with-condition-restarts
+	c
+	(list (find-restart 'foo)))
+       (invoke-restart (find-restart 'foo c2)))
+     (foo () 'good)
+     (foo () 'bad)))
+  good)
diff --git a/ansi-tests/with-simple-restart.lsp b/ansi-tests/with-simple-restart.lsp
new file mode 100644
index 00000000..49207ea9
--- /dev/null
+++ b/ansi-tests/with-simple-restart.lsp
@@ -0,0 +1,54 @@
+;-*- Mode:     Lisp -*-
+;;;; Author:   Paul Dietz
+;;;; Created:  Sun Mar 23 04:36:52 2003
+;;;; Contains: Tests for WITH-SIMPLE-RESTART
+
+(in-package :cl-test)
+
+(deftest with-simple-restart.1
+  (with-simple-restart (foo ""))
+  nil)
+
+(deftest with-simple-restart.2
+  (with-simple-restart (foo "") (values)))
+
+(deftest with-simple-restart.3
+  (with-simple-restart (foo "") (values 1 2 3 4 5 6 7 8 9 10))
+  1 2 3 4 5 6 7 8 9 10)
+
+(deftest with-simple-restart.4
+  (block nil
+    (tagbody
+     (with-simple-restart
+      (foo "")
+      (go 10)
+      10
+      (return 'bad))
+     10
+     (return 'good)))
+  good)
+
+(deftest with-simple-restart.5
+  (with-simple-restart
+   (foo "zzz")
+   (invoke-restart 'foo))
+  nil t)
+
+(deftest with-simple-restart.6
+  (flet ((%f () (invoke-restart 'foo)))
+    (with-simple-restart
+     (foo "zzz")
+     (%f)))
+  nil t)
+
+(deftest with-simple-restart.7
+  (with-simple-restart
+   (foo (formatter "xxx"))
+   (invoke-restart 'foo))
+  nil t)
+
+(deftest with-simple-restart.8
+  (with-simple-restart
+   (nil "")
+   (invoke-restart (first (compute-restarts))))
+  nil t)
-- 
GitLab