Commit 4a62a775 authored by pfdietz's avatar pfdietz

Finished adding tess for the conditions section. Mostly restarts.

parent 4890d4f9
;-*- 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)
......@@ -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)
......
;-*- 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)
......@@ -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")
;-*- 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)
......@@ -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))
......
;-*- 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)
;-*- 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)
;-*- 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)
;-*- 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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment