source: trunk/source/tests/ansi-tests/restart-bind.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: 4.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Mar 21 22:28:53 2003
4;;;; Contains: Tests for RESTART-BIND
5
6(in-package :cl-test)
7
8(deftest restart-bind.1
9  (restart-bind () nil)
10  nil)
11
12(deftest restart-bind.2
13  (restart-bind () (values)))
14 
15(deftest restart-bind.3
16  (restart-bind () (values 'a 'b 'c 'd 'e 'f))
17  a b c d e f)
18
19(deftest restart-bind.4
20  (block nil
21    (restart-bind () (return 'good) 'bad))
22  good)
23
24(deftest restart-bind.5
25  (block done
26    (tagbody
27     (restart-bind () (go 10) (return-from done 'bad))
28     10
29     (return-from done 'good)))
30  good)
31
32(deftest restart-bind.6
33  (restart-bind ())
34  nil)
35
36(deftest restart-bind.7
37  (block done
38    (restart-bind ((foo #'(lambda () (return-from done 'good))))
39                  (invoke-restart 'foo)
40                  'bad))
41  good)
42
43(deftest restart-bind.8
44  (block done
45    (restart-bind ((foo #'(lambda () (return-from done 'good))))
46                  (let ((restart (find-restart 'foo)))
47                    (and (typep restart 'restart)
48                         (invoke-restart restart)))
49                  'bad))
50  good)
51
52(deftest restart-bind.9
53  (restart-bind ((foo #'(lambda (a b c) (list c a b))))
54                (invoke-restart 'foo 1 2 3))
55  (3 1 2))
56
57(deftest restart-bind.10
58  (flet ((%f () (invoke-restart 'foo 'x 'y 'z)))
59    (restart-bind ((foo #'(lambda (a b c) (list c a b))))
60                  (%f)))
61  (z x y))
62
63(deftest restart-bind.11
64  (restart-bind
65   ((foo #'(lambda () 'bad)))
66   (restart-bind
67    ((foo #'(lambda () 'good)))
68    (invoke-restart 'foo)))
69  good)
70
71(deftest restart-bind.12
72  (let ((*x* 'bad))
73    (declare (special *x*))
74    (restart-bind
75     ((foo #'(lambda () (declare (special *x*)) *x*)))
76     (let ((*x* 'good))
77       (declare (special *x*))
78       (invoke-restart 'foo))))
79  good)
80
81(deftest restart-bind.13
82  (restart-bind
83   ((foo #'(lambda () 'bad)))
84   (flet ((%f () (invoke-restart 'foo)))
85     (restart-bind
86      ((foo #'(lambda () 'good)))
87      (%f))))
88  good)
89
90(deftest restart-bind.14
91  (let ((x 10) (y nil))
92    (restart-bind
93     ((foo #'(lambda ()
94               (when (> x 0)
95                 (push 'a y)
96                 (decf x)
97                 (invoke-restart 'foo))
98               y)))
99     (invoke-restart 'foo)))
100  (a a a a a a a a a a))
101
102(deftest restart-bind.15
103  (block done
104    (let ((i 0))
105      (restart-bind ((foo (progn (incf i)
106                                 #'(lambda () (return-from done i)))))
107                    (invoke-restart 'foo)
108                    'bad)))
109  1)
110
111(deftest restart-bind.16
112  (let ((i 0))
113    (values
114     (with-output-to-string
115       (s)
116       (restart-bind
117        ((foo #'(lambda () nil)
118              :report-function (progn (incf i)
119                                      #'(lambda (s) (format s "A report")))))
120        (let ((*print-escape* nil))
121          (format s "~A" (find-restart 'foo)))))
122     i))
123  "A report"
124  1)
125
126(deftest restart-bind.17
127  (restart-bind
128   ((foo #'(lambda () 'good))
129    (foo #'(lambda () 'bad)))
130   (invoke-restart 'foo))
131  good)
132
133(deftest restart-bind.18
134  (restart-bind
135   ((foo #'(lambda () 'good))
136    (bar #'(lambda () 'bad)))
137   (invoke-restart 'foo))
138  good)
139
140(deftest restart-bind.19
141  (restart-bind
142   ((foo #'(lambda () 'bad))
143    (bar #'(lambda () 'good)))
144   (invoke-restart 'bar))
145  good)
146
147;;; Using the :test-function to associate a restart with a condition
148
149;;; This test is disabled until I figure out how to fix
150;;; it.  See sbcl-devel mailing list, Oct 2005
151#|
152(deftest restart-bind.20
153  (let ((c (make-condition 'error)))
154    (restart-bind
155     ((foo #'(lambda () 'bad)
156           :test-function #'(lambda (c1) (not (eq c c1))))
157      (foo #'(lambda () 'good)
158           :test-function #'(lambda (c2) (or (null c2)
159                                             (eq c c2)))))
160     (invoke-restart (find-restart 'foo c))))
161  good)
162|#
163
164(deftest restart-bind.21
165  (let ((c (make-condition 'error)))
166    (restart-bind
167     ((foo #'(lambda () 'bad)
168           :test-function #'(lambda (c1) nil))
169      (foo #'(lambda () 'good)
170           :test-function #'(lambda (c2) t)))
171     (invoke-restart (find-restart 'foo c))))
172  good)
173
174(deftest restart-bind.22
175  (let ((c (make-condition 'error))
176        (i 0))
177    (values
178     (restart-bind
179      ((foo #'(lambda () 'good)
180            :test-function (progn (incf i) #'(lambda (c2) t))))
181      (invoke-restart (find-restart 'foo c)))
182     i))
183  good
184  1)
185
186;;; Error tests
187
188(deftest restart-bind.error.1
189  (signals-error
190   (restart-bind
191    ((foo #'(lambda () t)))
192    (invoke-restart 'foo 'a))
193   program-error)
194  t)
195
196(deftest restart-bind.error.2
197  (signals-error
198   (restart-bind
199    ((foo #'(lambda (x) x)))
200    (invoke-restart 'foo))
201   program-error)
202  t)
203
204(deftest restart-bind.error.3
205  (signals-error
206   (restart-bind
207    ((foo #'identity))
208    (invoke-restart 'foo))
209   program-error)
210  t)
211
212(deftest restart-bind.23
213  (restart-bind
214   ((foo #'(lambda () 'good)))
215   (invoke-restart-interactively 'foo))
216  good)
217
218(deftest restart-bind.24
219  (let ((i 0))
220    (values
221     (restart-bind
222      ((foo
223        #'(lambda (x y z) (list z y x))
224        :interactive-function (progn (incf i)
225                                     #'(lambda () (list 'a 'b 'c)))))
226      (invoke-restart-interactively 'foo))
227     i))
228  (c b a)
229  1)
230
Note: See TracBrowser for help on using the repository browser.