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