source: trunk/source/tests/ansi-tests/restart-case.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 6.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Mar 22 06:58:03 2003
4;;;; Contains: Tests for RESTART-CASE
5
6(in-package :cl-test)
7
8(deftest restart-case.1
9  (restart-case (values)))
10
11(deftest restart-case.2
12  (restart-case 1)
13  1)
14
15(deftest restart-case.3
16  (restart-case (values 'a 'b 'c 'd 'e 'f))
17  a b c d e f)
18
19(deftest restart-case.4
20  (restart-case (progn (invoke-restart 'foo) 'bad)
21                (foo () 'good))
22  good)
23
24(deftest restart-case.5
25  (restart-case (progn (invoke-restart 'foo) 'bad)
26                (foo ()))
27  nil)
28
29(deftest restart-case.6
30  (restart-case
31   (progn (invoke-restart 'foo) 'bad)
32   (bar () 'bad2)
33   (foo () 'good)
34   (foo () 'bad3))
35  good)
36
37(deftest restart-case.7
38  (restart-case
39   (invoke-restart 'foo 'a 'b 'c 'd)
40   (foo (w x y z) (list z y x w)))
41  (d c b a))
42
43(deftest restart-case.8
44  (restart-case
45   (invoke-restart 'foo :a 1 :b 2)
46   (foo (&key a b c d) (list a b c d)))
47  (1 2 nil nil))
48
49(deftest restart-case.9
50  (restart-case
51   (invoke-restart 'foo 1 2 3 4)
52   (foo (&rest args) (reverse args)))
53  (4 3 2 1))
54
55(deftest restart-case.10
56  (restart-case
57   (invoke-restart 'foo 1 2 3)
58   (foo (a b &optional c d) (list a b c d)))
59  (1 2 3 nil))
60
61(deftest restart-case.11
62  (restart-case
63   (invoke-restart 'foo 1 2)
64   (foo (x y) (declare (type fixnum x y)) (+ x y)))
65  3)
66
67(deftest restart-case.12
68  (restart-case
69   (restart-case (invoke-restart 'foo 1)
70                 (foo (x) (invoke-restart 'foo (1+ x))))
71   (foo (y) (+ 4 y)))
72  6)
73
74(deftest restart-case.13
75  (let ((i 10))
76    (values
77     (restart-case (progn (invoke-restart 'foo) 'bad)
78                   (foo () (incf i 100) 'good))
79     i))
80  good 110)
81
82(deftest restart-case.14
83  (restart-case
84   (invoke-restart 'foo 1 2)
85   (foo (x y)
86        (declare (type fixnum x))
87        (declare (type fixnum y))
88        (+ x y)))
89  3)
90
91(deftest restart-case.15
92  (restart-case
93   (invoke-restart 'foo 1 2)
94   (foo (x y)
95        (declare (ignore x y))
96        (declare (type fixnum x))
97        (declare (type fixnum y))))
98  nil)
99
100(deftest restart-case.16
101  (restart-case
102   (invoke-restart 'foo)
103   (foo () (values))))
104
105(deftest restart-case.17
106  (restart-case
107   (invoke-restart 'foo)
108   (foo () (values 'a 'b 'c 'd 'e 'f)))
109  a b c d e f)
110
111(deftest restart-case.18
112  (restart-case
113   (invoke-restart 'foo)
114   (foo () :test (lambda (c) (declare (ignore c)) t) 'good))
115  good)
116
117(deftest restart-case.19
118  (restart-case
119   (invoke-restart 'foo)
120   (foo () :test (lambda (c) (declare (ignore c)) nil) 'bad)
121   (foo () 'good))
122  good)
123
124(deftest restart-case.20
125  (with-output-to-string
126    (s)
127    (restart-case
128     (let ((restart (find-restart 'foo))
129           (*print-escape* nil))
130       (format s "~A" restart))
131     (foo () :report "A report")))
132  "A report")
133
134(deftest restart-case.21
135  (with-output-to-string
136    (s)
137    (flet ((%f (s2) (format s2 "A report")))
138      (restart-case
139       (let ((restart (find-restart 'foo))
140             (*print-escape* nil))
141         (format s "~A" restart))
142       (foo () :report %f))))
143  "A report")
144
145(deftest restart-case.22
146  (with-output-to-string
147    (s)
148    (restart-case
149     (let ((restart (find-restart 'foo))
150           (*print-escape* nil))
151       (format s "~A" restart))
152     (foo () :report (lambda (s2) (format s2 "A report")))))
153  "A report")
154
155;;; Special cases when restart-case associates the restarts with
156;;; a condition
157
158(deftest restart-case.23
159  (handler-bind
160   ((error #'(lambda (c) (declare (ignore c)) (invoke-restart 'foo))))
161   (restart-case
162    (error "Boo!")
163    (foo () 'good)))
164  good)
165
166(deftest restart-case.24
167  (handler-bind
168   ((error #'(lambda (c) (invoke-restart (find-restart 'foo c)))))
169   (restart-case
170    (error "Boo!")
171    (foo () 'good)))
172  good)
173
174
175;;; Test that the inner restart-case has associated its restart with
176;;; the condition to be raised by the error form.
177
178(deftest restart-case.25
179  (handler-bind
180   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
181   (handler-bind
182    ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
183    (restart-case
184     (restart-case
185      (error "Boo!")
186      (foo () 'bad))
187     (foo () 'good))))
188  good)
189
190(deftest restart-case.26
191  (handler-bind
192   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
193   (handler-bind
194    ((simple-condition #'(lambda (c) (declare (ignore c)) (error "Blah"))))
195    (restart-case
196     (restart-case
197      (signal "Boo!")
198      (foo () 'bad))
199     (foo () 'good))))
200  good)
201
202(deftest restart-case.27
203  (handler-bind
204   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
205   (handler-bind
206    ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
207    (restart-case
208     (restart-case
209      (cerror "" "")
210      (foo () 'bad))
211     (foo () 'good))))
212  good)
213
214(deftest restart-case.28
215  (handler-bind
216   ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
217   (handler-bind
218    ((warning #'(lambda (c) (declare (ignore c)) (error "Blah"))))
219    (restart-case
220     (restart-case
221      (warn "Boo!")
222      (foo () 'bad))
223     (foo () 'good))))
224  good)
225
226(deftest restart-case.29
227  (macrolet ((%m (&rest args) (cons 'error args)))
228    (handler-bind
229     ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
230     (handler-bind
231      ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
232      (restart-case
233       (restart-case
234        (%m "Boo!")
235        (foo () 'bad))
236       (foo () 'good)))))
237  good)
238
239(deftest restart-case.30
240  (symbol-macrolet ((%s (error "Boo!")))
241    (handler-bind
242     ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
243     (handler-bind
244      ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
245      (restart-case
246       (restart-case
247        %s
248        (foo () 'bad))
249       (foo () 'good)))))
250  good)
251
252(deftest restart-case.31
253  (macrolet ((%m2 (&rest args) (cons 'error args)))
254    (macrolet ((%m (&rest args &environment env)
255                   (macroexpand (cons '%m2 args) env)))
256      (handler-bind
257       ((error #'(lambda (c2) (invoke-restart (find-restart 'foo c2)))))
258       (handler-bind
259        ((error #'(lambda (c) (declare (ignore c)) (error "Blah"))))
260        (restart-case
261         (restart-case
262          (%m "Boo!")
263          (foo () 'bad))
264         (foo () 'good))))))
265  good)
266
267(deftest restart-case.32
268  (restart-case
269   (invoke-restart-interactively 'foo)
270   (foo () 'good))
271  good)
272
273(deftest restart-case.33
274  (restart-case
275   (invoke-restart-interactively 'foo)
276   (foo (w x y z)
277        :interactive (lambda () (list 'a 'b 'c 'd))
278        (list x w z y)))
279  (b a d c))
280
281(deftest restart-case.34
282  (flet ((%f () (list 'a 'b 'c 'd)))
283    (restart-case
284     (invoke-restart-interactively 'foo)
285     (foo (w x y z)
286          :interactive %f
287          (list x w z y))))
288  (b a d c))
289
290(deftest restart-case.35
291  (restart-case
292   (loop for i from 1 to 4
293         for r in (compute-restarts)
294         collect (restart-name r))
295   (foo () t)
296   (bar () t)
297   (foo () 'a)
298   (nil () :report (lambda (s) (format s "Anonymous restart"))  10))
299  (foo bar foo nil))
300
301(deftest restart-case.36
302  (let ((x :bad))
303    (declare (special x))
304    (let ((x :good))
305      (restart-case
306       (invoke-restart 'foo)
307       (foo (&aux (y x))
308            (declare (special x))
309            y))))
310  :good)
Note: See TracBrowser for help on using the repository browser.