Skip to content
Snippets Groups Projects
Commit 4a62a775 authored by pfdietz's avatar pfdietz
Browse files

Finished adding tess for the conditions section. Mostly restarts.

parent 4890d4f9
No related branches found
No related tags found
No related merge requests found
;-*- 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 @@ ...@@ -100,6 +100,27 @@
(foo () 'also-bad))))) (foo () 'also-bad)))))
nil nil) 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 @@ ...@@ -15,3 +15,10 @@
(load "compute-restarts.lsp") (load "compute-restarts.lsp")
(load "restart-bind.lsp") (load "restart-bind.lsp")
(load "restart-case.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 @@ ...@@ -287,6 +287,20 @@
(list x w z y)))) (list x w z y))))
(b a d c)) (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)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment