11 |
|
|
12 |
(define-condition-with-tests cond-2 (condition) nil) |
(define-condition-with-tests cond-2 (condition) nil) |
13 |
|
|
14 |
(define-condition-with-tests #:cond-3 nil nil) |
#-gcl (define-condition-with-tests #:cond-3 nil nil) |
15 |
|
|
16 |
(define-condition-with-tests cond-4 nil |
(define-condition-with-tests cond-4 nil |
17 |
((slot1 :initarg :slot1 :reader cond-4/slot-1) |
((slot1 :initarg :slot1 :reader cond-4/slot-1) |
97 |
(eqt (cond-6/slot-2 c) 'a))) |
(eqt (cond-6/slot-2 c) 'a))) |
98 |
t) |
t) |
99 |
|
|
100 |
|
(define-condition-with-tests cond-7 nil |
101 |
|
((s :initarg :i1 :initarg :i2 :reader cond-7/s))) |
102 |
|
|
103 |
|
(deftest cond-7-slots.1 |
104 |
|
(let ((c (make-condition 'cond-7 :i1 'a))) |
105 |
|
(and (typep c 'cond-7) |
106 |
|
(eqt (cond-7/s c) 'a))) |
107 |
|
t) |
108 |
|
|
109 |
|
(deftest cond-7-slots.2 |
110 |
|
(let ((c (make-condition 'cond-7 :i2 'a))) |
111 |
|
(and (typep c 'cond-7) |
112 |
|
(eqt (cond-7/s c) 'a))) |
113 |
|
t) |
114 |
|
|
115 |
|
(deftest cond-7-slots.3 |
116 |
|
(let ((c (make-condition 'cond-7 :i1 'a :i2 'b))) |
117 |
|
(and (typep c 'cond-7) |
118 |
|
(eqt (cond-7/s c) 'a))) |
119 |
|
t) |
120 |
|
|
121 |
|
(deftest cond-7-slots.4 |
122 |
|
(let ((c (make-condition 'cond-7 :i2 'a :i1 'b))) |
123 |
|
(and (typep c 'cond-7) |
124 |
|
(eqt (cond-7/s c) 'a))) |
125 |
|
t) |
126 |
|
|
127 |
|
(defparameter *cond-8-counter* 0) |
128 |
|
|
129 |
|
(define-condition-with-tests cond-8 nil |
130 |
|
((s :initarg :i1 :initform (incf *cond-8-counter*) :reader cond-8/s))) |
131 |
|
|
132 |
|
(deftest cond-8-slots.1 |
133 |
|
(let ((*cond-8-counter* 100)) |
134 |
|
(declare (special *cond-8-counter*)) |
135 |
|
(values |
136 |
|
(cond-8/s (make-condition 'cond-8)) |
137 |
|
*cond-8-counter*)) |
138 |
|
101 101) |
139 |
|
|
140 |
|
(define-condition-with-tests cond-9 nil |
141 |
|
((s1 :initarg :i1 :initform 15 :reader cond-9/s1) |
142 |
|
(s2 :initarg :i2 :initform 37 :reader cond-9/s2))) |
143 |
|
|
144 |
|
(deftest cond-9-slots.1 |
145 |
|
(let ((c (make-condition 'cond-9))) |
146 |
|
(values (notnot (typep c 'cond-9)) |
147 |
|
(cond-9/s1 c) |
148 |
|
(cond-9/s2 c))) |
149 |
|
t 15 37) |
150 |
|
|
151 |
|
(deftest cond-9-slots.2 |
152 |
|
(let ((c (make-condition 'cond-9 :i1 3))) |
153 |
|
(values (notnot (typep c 'cond-9)) |
154 |
|
(cond-9/s1 c) |
155 |
|
(cond-9/s2 c))) |
156 |
|
t 3 37) |
157 |
|
|
158 |
|
(deftest cond-9-slots.3 |
159 |
|
(let ((c (make-condition 'cond-9 :i2 3))) |
160 |
|
(values (notnot (typep c 'cond-9)) |
161 |
|
(cond-9/s1 c) |
162 |
|
(cond-9/s2 c))) |
163 |
|
t 15 3) |
164 |
|
|
165 |
|
(deftest cond-9-slots.4 |
166 |
|
(let ((c (make-condition 'cond-9 :i2 3 :i2 8))) |
167 |
|
(values (notnot (typep c 'cond-9)) |
168 |
|
(cond-9/s1 c) |
169 |
|
(cond-9/s2 c))) |
170 |
|
t 15 3) |
171 |
|
|
172 |
|
(deftest cond-9-slots.5 |
173 |
|
(let ((c (make-condition 'cond-9 :i1 3 :i2 8))) |
174 |
|
(values (notnot (typep c 'cond-9)) |
175 |
|
(cond-9/s1 c) |
176 |
|
(cond-9/s2 c))) |
177 |
|
t 3 8) |
178 |
|
|
179 |
|
(deftest cond-9-slots.6 |
180 |
|
(let ((c (make-condition 'cond-9 :i1 3 :i2 8 :i1 100 :i2 500))) |
181 |
|
(values (notnot (typep c 'cond-9)) |
182 |
|
(cond-9/s1 c) |
183 |
|
(cond-9/s2 c))) |
184 |
|
t 3 8) |
185 |
|
|
186 |
|
;;; (define-condition-with-tests cond-10 nil |
187 |
|
;;; ((s1 :initarg :i1 :writer cond-10/s1-w :reader cond-10/s1-r))) |
188 |
|
;;; |
189 |
|
;;; (deftest cond-10-slots.1 |
190 |
|
;;; (let ((c (make-condition 'cond-10 :i1 11))) |
191 |
|
;;; (cond-10/s1-r c)) |
192 |
|
;;; 11) |
193 |
|
;;; |
194 |
|
;;; (deftest cond-10-slots.2 |
195 |
|
;;; (let ((c (make-condition 'cond-10 :i1 11))) |
196 |
|
;;; (cond-10/s1-w 17 c)) |
197 |
|
;;; 17) |
198 |
|
;;; |
199 |
|
;;; (deftest cond-10-slots.3 |
200 |
|
;;; (let ((c (make-condition 'cond-10 :i1 11))) |
201 |
|
;;; (cond-10/s1-w 107 c) |
202 |
|
;;; (cond-10/s1-r c)) |
203 |
|
;;; 107) |
204 |
|
;;; |
205 |
|
;;; (define-condition-with-tests cond-11 nil |
206 |
|
;;; ((s1 :initarg :i1 :writer (setf cond-11/w) :reader cond-11/r))) |
207 |
|
;;; |
208 |
|
;;; (deftest cond-11-slots.1 |
209 |
|
;;; (let ((c (make-condition 'cond-11 :i1 11))) |
210 |
|
;;; (cond-11/r c)) |
211 |
|
;;; 11) |
212 |
|
;;; |
213 |
|
;;; (deftest cond-11-slots.2 |
214 |
|
;;; (let ((c (make-condition 'cond-11 :i1 11))) |
215 |
|
;;; (setf (cond-11/w c) 17)) |
216 |
|
;;; 17) |
217 |
|
;;; |
218 |
|
;;; (deftest cond-11-slots.3 |
219 |
|
;;; (let ((c (make-condition 'cond-11 :i1 11))) |
220 |
|
;;; (setf (cond-11/w c) 117) |
221 |
|
;;; (cond-11/r c)) |
222 |
|
;;; 117) |
223 |
|
;;; |
224 |
|
;;; (deftest cond-11-slots.4 |
225 |
|
;;; (let ((c (make-condition 'cond-11 :i1 11))) |
226 |
|
;;; (values |
227 |
|
;;; (funcall #'(setf cond-11/w) 117 c) |
228 |
|
;;; (cond-11/r c))) |
229 |
|
;;; 117 117) |
230 |
|
|
231 |
|
(define-condition-with-tests cond-12 nil |
232 |
|
(((slot1) :initarg :slot1 :reader cond-12/slot-1) |
233 |
|
((slot2) :initarg :slot2 :reader cond-12/slot-2))) |
234 |
|
|
235 |
|
(deftest cond-12-slots.1 |
236 |
|
(let ((c (make-condition 'cond-12 :slot1 'a :slot2 'b))) |
237 |
|
(and (typep c 'cond-12) |
238 |
|
(eqt (cond-12/slot-1 c) 'a) |
239 |
|
(eqt (cond-12/slot-2 c) 'b))) |
240 |
|
t) |
241 |
|
|
242 |
|
(define-condition-with-tests cond-13 nil |
243 |
|
(((slot1 10) :initarg :slot1 :reader cond-13/slot-1))) |
244 |
|
|
245 |
|
(deftest cond-13-slots.1 |
246 |
|
(let ((c (make-condition 'cond-13))) |
247 |
|
(and (typep c 'cond-13) |
248 |
|
(cond-13/slot-1 c))) |
249 |
|
10) |
250 |
|
|
251 |
|
(define-condition-with-tests cond-14 nil |
252 |
|
((s1 :initarg :i1 :type fixnum :reader cond-14/s1) |
253 |
|
(s2 :initarg :i2 :type t :reader cond-14/s2))) |
254 |
|
|
255 |
|
(deftest cond-14-slots.1 |
256 |
|
(let ((c (make-condition 'cond-14 :i1 10))) |
257 |
|
(and (typep c 'cond-14) |
258 |
|
(cond-14/s1 c))) |
259 |
|
10) |
260 |
|
|
261 |
|
(deftest cond-14-slots.2 |
262 |
|
(let ((c (make-condition 'cond-14 :i2 'a))) |
263 |
|
(and (typep c 'cond-14) |
264 |
|
(cond-14/s2 c))) |
265 |
|
a) |
266 |
|
|
267 |
|
(deftest cond-14-slots.3 |
268 |
|
(let ((c (make-condition 'cond-14 :i1 10 :i2 'h))) |
269 |
|
(and (typep c 'cond-14) |
270 |
|
(eqt (cond-14/s1 c) 10) |
271 |
|
(cond-14/s2 c))) |
272 |
|
h) |
273 |
|
|
274 |
|
(define-condition-with-tests cond-15 nil |
275 |
|
((s1 :type nil))) |
276 |
|
|
277 |
|
(define-condition-with-tests cond-16 nil |
278 |
|
((slot1)) |
279 |
|
(:report "The report for cond-16")) |
280 |
|
|
281 |
|
(deftest cond-16-report.1 |
282 |
|
(let ((*print-escape* nil) |
283 |
|
(c (make-condition 'cond-16))) |
284 |
|
(with-output-to-string (s) (print-object c s))) |
285 |
|
"The report for cond-16") |
286 |
|
|
287 |
|
(define-condition-with-tests cond-17 nil |
288 |
|
((s :initarg :i1 :reader cond-17/s )) |
289 |
|
(:report cond-17-report)) |
290 |
|
|
291 |
|
(defun cond-17-report (c s) |
292 |
|
(format s "cond-17: ~A" (cond-17/s c))) |
293 |
|
|
294 |
|
(deftest cond-17-report.1 |
295 |
|
(let ((*print-escape* nil) |
296 |
|
(c (make-condition 'cond-17 :i1 1234))) |
297 |
|
(with-output-to-string (s) (print-object c s))) |
298 |
|
"cond-17: 1234") |
299 |
|
|
300 |
|
(define-condition-with-tests cond-18 nil |
301 |
|
((s :initarg :i1 :reader cond-18/s )) |
302 |
|
(:report (lambda (c s) (format s "cond-18: ~A" (cond-18/s c))))) |
303 |
|
|
304 |
|
(deftest cond-18-report.1 |
305 |
|
(let ((*print-escape* nil) |
306 |
|
(c (make-condition 'cond-18 :i1 4321))) |
307 |
|
(with-output-to-string (s) (print-object c s))) |
308 |
|
"cond-18: 4321") |