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

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

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

File size: 4.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Mar  1 14:08:07 2003
4;;;; Contains: Tests of HANDLER-CASE
5
6(in-package :cl-test)
7
8(deftest handler-case.1
9  (handler-case
10   (error "an error")
11   (error () t))
12  t)
13
14(deftest handler-case.2
15  (handler-case
16   (error "an error")
17   (warning () nil)
18   (error () t))
19  t)
20
21(deftest handler-case.3
22  (handler-case
23   (error "an error")
24   (error (c) (and (typep c 'error) t))
25   (error () 'bad)
26   (condition () 'bad2))
27  t)
28
29(deftest handler-case.4
30  (handler-case
31   (error "an error")
32   (warning (c) c)
33   (error (c) (and (typep c 'error) t))
34   (error () 'bad)
35   (condition () 'bad2))
36  t)
37
38(deftest handler-case.5
39  (handler-case
40   (error "an error")
41   (#.(find-class 'error) (c) (and (typep c 'error) t))
42   (error () 'bad))
43  t)
44
45(deftest handler-case.6
46  (handler-case (values)
47                (error () nil)))
48
49(deftest handler-case.7
50  (handler-case 'foo (condition () 'bar))
51  foo)
52
53;;; (deftest handler-case.8
54;;;  (handler-case 'foo (t () 'bar))
55;;;  foo)
56
57(deftest handler-case.9
58  (handler-case (values 1 2 3 4 5 6 7 8) (condition () nil))
59  1 2 3 4 5 6 7 8)
60
61;;; (deftest handler-case.10
62;;;  (handler-case
63;;;   (error "foo")
64;;;   (t () 'good))
65;;;  good)
66
67(deftest handler-case.11
68  (labels ((%f () (declare (special *c*))
69               (and (typep *c* 'condition) t))
70           (%g ()
71               (let ((*c* nil))
72                 (declare (special *c*))
73                 (%h)))
74           (%h ()
75            (handler-case
76             (error "foo")
77             (error (*c*) (declare (special *c*))
78                    (%f)))))
79    (%g))
80  t)
81
82(deftest handler-case.12
83  (handler-case (error "foo")
84                (nil () nil)
85                (error (c) (notnot-mv (typep c 'simple-error))))
86  t)
87
88(deftest handler-case.13
89  (handler-case (error "foo")
90                (error (c) (values))))
91
92(deftest handler-case.14
93  (handler-case (error "foo")
94                (error (c)
95                       (values 1 2 3 4 5 6 7 8)))
96  1 2 3 4 5 6 7 8)
97
98(deftest handler-case.15
99  (handler-case
100   (handler-case (error "foo")
101                 (warning () 'bad))
102   (error () 'good))
103  good)
104
105(deftest handler-case.16
106  (handler-case
107   (handler-case (error "foo")
108                 (error () 'good))
109   (error () 'bad))
110  good)
111
112(deftest handler-case.17
113  (let ((i 0))
114    (values
115     (handler-case
116      (handler-case (error "foo")
117                    (error () (incf i) (error "bar")))
118      (error () 'good))
119     i))
120  good 1)
121
122(deftest handler-case.18
123  (let ((i 0))
124    (values
125     (handler-case
126      (handler-case (error "foo")
127                    (error (c) (incf i) (error c)))
128      (error () 'good))
129     i))
130  good 1)
131
132(deftest handler-case.19
133  (handler-case
134   (error "foo")
135   (error (c)
136          ;; Test that declarations can go here
137          (declare (optimize (safety 3)))
138          (declare (type condition c))
139          (declare (ignore c))
140          t))
141  t)
142
143(deftest handler-case.20
144  (handler-case
145   10
146   (:no-error (x) (+ x 3)))
147  13)
148
149(deftest handler-case.21
150  (handler-case
151   (values)
152   (:no-error () 'foo))
153  foo)
154
155(deftest handler-case.22
156  (handler-case
157   (values 1 2 3 4 5)
158   (:no-error (a b c d e) (list e d c b a)))
159  (5 4 3 2 1))
160
161(deftest handler-case.23
162  (signals-error
163   (handler-case (values 1 2) (:no-error (x) x))
164   program-error)
165  t)
166
167(deftest handler-case.24
168  (signals-error
169   (handler-case (values) (:no-error (x) x))
170   program-error)
171  t)
172
173(deftest handler-case.25
174  (handler-case
175   (handler-case
176    (values)
177    (error () 'bad)
178    (:no-error () (error "foo")))
179   (error () 'good))
180  good)
181
182(deftest handler-case.26
183  (handler-case
184   (values 1 'a 1.0)
185   (error () 'bad)
186   (:no-error (a b c)
187              ;; Test that declarations can go here
188              (declare (type integer a))
189              (declare (type symbol b))
190              (declare (type number c))
191              (declare (ignore a c))
192              b))
193  a)
194
195(deftest handler-case.27
196  (handler-case (error "foo") (error ()))
197  nil)
198
199(deftest handler-case.28
200  (handler-case (error "foo") (error () (declare (optimize speed))))
201  nil)
202
203;;; Free declaration scope
204
205(deftest handler-case.29
206  (let ((x :bad))
207    (declare (special x))
208    (let ((x :good))
209      (handler-case nil
210                    (:no-error (z &aux (y x))
211                               (declare (special x) (ignore z))
212                               y))))
213  :good)
Note: See TracBrowser for help on using the repository browser.