/[gcl]/gcl/ansi-tests/define-condition.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/define-condition.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7 by pfdietz, Sat Mar 22 17:22:36 2003 UTC revision 1.8 by pfdietz, Tue Mar 25 12:24:45 2003 UTC
# Line 7  Line 7 
7    
8  ;;;  ;;;
9    
10  (define-condition-with-tests cond-1 nil nil)  (define-condition-with-tests condition-1 nil nil)
11    
12  (define-condition-with-tests cond-2 (condition) nil)  (define-condition-with-tests condition-2 (condition) nil)
13    
14  #-gcl (define-condition-with-tests #:cond-3 nil nil)  #-gcl (define-condition-with-tests #:condition-3 nil nil)
15    
16  (define-condition-with-tests cond-4 nil  (define-condition-with-tests condition-4 nil
17    ((slot1 :initarg :slot1 :reader cond-4/slot-1)    ((slot1 :initarg :slot1 :reader condition-4/slot-1)
18     (slot2 :initarg :slot2 :reader cond-4/slot-2)))     (slot2 :initarg :slot2 :reader condition-4/slot-2)))
19    
20  (deftest cond-4-slots.1  (deftest condition-4-slots.1
21    (let ((c (make-condition 'cond-4 :slot1 'a :slot2 'b)))    (let ((c (make-condition 'condition-4 :slot1 'a :slot2 'b)))
22      (and (typep c 'cond-4)      (and (typep c 'condition-4)
23           (eqt (cond-4/slot-1 c) 'a)           (eqt (condition-4/slot-1 c) 'a)
24           (eqt (cond-4/slot-2 c) 'b)))           (eqt (condition-4/slot-2 c) 'b)))
25    t)    t)
26    
27  (define-condition-with-tests cond-5 nil  (define-condition-with-tests condition-5 nil
28    ((slot1 :initarg :slot1 :initform 'x :reader cond-5/slot-1)    ((slot1 :initarg :slot1 :initform 'x :reader condition-5/slot-1)
29     (slot2 :initarg :slot2 :initform 'y :reader cond-5/slot-2)))     (slot2 :initarg :slot2 :initform 'y :reader condition-5/slot-2)))
30    
31  (deftest cond-5-slots.1  (deftest condition-5-slots.1
32    (let ((c (make-condition 'cond-5 :slot1 'a :slot2 'b)))    (let ((c (make-condition 'condition-5 :slot1 'a :slot2 'b)))
33      (and (typep c 'cond-5)      (and (typep c 'condition-5)
34           (eqt (cond-5/slot-1 c) 'a)           (eqt (condition-5/slot-1 c) 'a)
35           (eqt (cond-5/slot-2 c) 'b)))           (eqt (condition-5/slot-2 c) 'b)))
36    t)    t)
37    
38  (deftest cond-5-slots.2  (deftest condition-5-slots.2
39    (let ((c (make-condition 'cond-5 :slot1 'a)))    (let ((c (make-condition 'condition-5 :slot1 'a)))
40      (and (typep c 'cond-5)      (and (typep c 'condition-5)
41           (eqt (cond-5/slot-1 c) 'a)           (eqt (condition-5/slot-1 c) 'a)
42           (eqt (cond-5/slot-2 c) 'y)))           (eqt (condition-5/slot-2 c) 'y)))
43    t)    t)
44    
45  (deftest cond-5-slots.3  (deftest condition-5-slots.3
46    (let ((c (make-condition 'cond-5 :slot2 'b)))    (let ((c (make-condition 'condition-5 :slot2 'b)))
47      (and (typep c 'cond-5)      (and (typep c 'condition-5)
48           (eqt (cond-5/slot-1 c) 'x)           (eqt (condition-5/slot-1 c) 'x)
49           (eqt (cond-5/slot-2 c) 'b)))           (eqt (condition-5/slot-2 c) 'b)))
50    t)    t)
51    
52  (deftest cond-5-slots.4  (deftest condition-5-slots.4
53    (let ((c (make-condition 'cond-5)))    (let ((c (make-condition 'condition-5)))
54      (and (typep c 'cond-5)      (and (typep c 'condition-5)
55           (eqt (cond-5/slot-1 c) 'x)           (eqt (condition-5/slot-1 c) 'x)
56           (eqt (cond-5/slot-2 c) 'y)))           (eqt (condition-5/slot-2 c) 'y)))
57    t)    t)
58    
59  (define-condition-with-tests cond-6 nil  (define-condition-with-tests condition-6 nil
60    ((slot1 :initarg :slot1 :initarg :both-slots    ((slot1 :initarg :slot1 :initarg :both-slots
61            :initform 'x :reader cond-6/slot-1)            :initform 'x :reader condition-6/slot-1)
62     (slot2 :initarg :slot2 :initarg :both-slots     (slot2 :initarg :slot2 :initarg :both-slots
63            :initform 'y :reader cond-6/slot-2)))            :initform 'y :reader condition-6/slot-2)))
64    
65  (deftest cond-6-slots.1  (deftest condition-6-slots.1
66    (let ((c (make-condition 'cond-6 :both-slots 'a)))    (let ((c (make-condition 'condition-6 :both-slots 'a)))
67      (and (typep c 'cond-6)      (and (typep c 'condition-6)
68           (eqt (cond-6/slot-1 c) 'a)           (eqt (condition-6/slot-1 c) 'a)
69           (eqt (cond-6/slot-2 c) 'a)))           (eqt (condition-6/slot-2 c) 'a)))
70    t)    t)
71    
72  (deftest cond-6-slots.2  (deftest condition-6-slots.2
73    (let ((c (make-condition 'cond-6)))    (let ((c (make-condition 'condition-6)))
74      (and (typep c 'cond-6)      (and (typep c 'condition-6)
75           (eqt (cond-6/slot-1 c) 'x)           (eqt (condition-6/slot-1 c) 'x)
76           (eqt (cond-6/slot-2 c) 'y)))           (eqt (condition-6/slot-2 c) 'y)))
77    t)    t)
78    
79  (deftest cond-6-slots.3  (deftest condition-6-slots.3
80    (let ((c (make-condition 'cond-6 :slot1 'a :both-slots 'b)))    (let ((c (make-condition 'condition-6 :slot1 'a :both-slots 'b)))
81      (and (typep c 'cond-6)      (and (typep c 'condition-6)
82           (eqt (cond-6/slot-1 c) 'a)           (eqt (condition-6/slot-1 c) 'a)
83           (eqt (cond-6/slot-2 c) 'b)))           (eqt (condition-6/slot-2 c) 'b)))
84    t)    t)
85    
86  (deftest cond-6-slots.4  (deftest condition-6-slots.4
87    (let ((c (make-condition 'cond-6 :slot2 'b :both-slots 'a)))    (let ((c (make-condition 'condition-6 :slot2 'b :both-slots 'a)))
88      (and (typep c 'cond-6)      (and (typep c 'condition-6)
89           (eqt (cond-6/slot-1 c) 'a)           (eqt (condition-6/slot-1 c) 'a)
90           (eqt (cond-6/slot-2 c) 'b)))           (eqt (condition-6/slot-2 c) 'b)))
91    t)    t)
92    
93  (deftest cond-6-slots.5  (deftest condition-6-slots.5
94    (let ((c (make-condition 'cond-6 :both-slots 'a :slot1 'c :slot2 'd)))    (let ((c (make-condition 'condition-6 :both-slots 'a :slot1 'c :slot2 'd)))
95      (and (typep c 'cond-6)      (and (typep c 'condition-6)
96           (eqt (cond-6/slot-1 c) 'a)           (eqt (condition-6/slot-1 c) 'a)
97           (eqt (cond-6/slot-2 c) 'a)))           (eqt (condition-6/slot-2 c) 'a)))
98    t)    t)
99    
100  (define-condition-with-tests cond-7 nil  (define-condition-with-tests condition-7 nil
101    ((s :initarg :i1 :initarg :i2 :reader cond-7/s)))    ((s :initarg :i1 :initarg :i2 :reader condition-7/s)))
102    
103  (deftest cond-7-slots.1  (deftest condition-7-slots.1
104    (let ((c (make-condition 'cond-7 :i1 'a)))    (let ((c (make-condition 'condition-7 :i1 'a)))
105      (and (typep c 'cond-7)      (and (typep c 'condition-7)
106           (eqt (cond-7/s c) 'a)))           (eqt (condition-7/s c) 'a)))
107    t)    t)
108    
109  (deftest cond-7-slots.2  (deftest condition-7-slots.2
110    (let ((c (make-condition 'cond-7 :i2 'a)))    (let ((c (make-condition 'condition-7 :i2 'a)))
111      (and (typep c 'cond-7)      (and (typep c 'condition-7)
112           (eqt (cond-7/s c) 'a)))           (eqt (condition-7/s c) 'a)))
113    t)    t)
114    
115  (deftest cond-7-slots.3  (deftest condition-7-slots.3
116    (let ((c (make-condition 'cond-7 :i1 'a :i2 'b)))    (let ((c (make-condition 'condition-7 :i1 'a :i2 'b)))
117      (and (typep c 'cond-7)      (and (typep c 'condition-7)
118           (eqt (cond-7/s c) 'a)))           (eqt (condition-7/s c) 'a)))
119    t)    t)
120    
121  (deftest cond-7-slots.4  (deftest condition-7-slots.4
122    (let ((c (make-condition 'cond-7 :i2 'a :i1 'b)))    (let ((c (make-condition 'condition-7 :i2 'a :i1 'b)))
123      (and (typep c 'cond-7)      (and (typep c 'condition-7)
124           (eqt (cond-7/s c) 'a)))           (eqt (condition-7/s c) 'a)))
125    t)    t)
126    
127  (defparameter *cond-8-counter* 0)  (defparameter *condition-8-counter* 0)
128    
129  (define-condition-with-tests cond-8 nil  (define-condition-with-tests condition-8 nil
130    ((s :initarg :i1 :initform (incf *cond-8-counter*) :reader cond-8/s)))    ((s :initarg :i1 :initform (incf *condition-8-counter*) :reader condition-8/s)))
131    
132  (deftest cond-8-slots.1  (deftest condition-8-slots.1
133    (let ((*cond-8-counter* 100))    (let ((*condition-8-counter* 100))
134      (declare (special *cond-8-counter*))      (declare (special *condition-8-counter*))
135      (values      (values
136       (cond-8/s (make-condition 'cond-8))       (condition-8/s (make-condition 'condition-8))
137       *cond-8-counter*))       *condition-8-counter*))
138    101 101)    101 101)
139    
140  (define-condition-with-tests cond-9 nil  (define-condition-with-tests condition-9 nil
141    ((s1 :initarg :i1 :initform 15 :reader cond-9/s1)    ((s1 :initarg :i1 :initform 15 :reader condition-9/s1)
142     (s2 :initarg :i2 :initform 37 :reader cond-9/s2)))     (s2 :initarg :i2 :initform 37 :reader condition-9/s2)))
143    
144  (deftest cond-9-slots.1  (deftest condition-9-slots.1
145    (let ((c (make-condition 'cond-9)))    (let ((c (make-condition 'condition-9)))
146      (values (notnot (typep c 'cond-9))      (values (notnot (typep c 'condition-9))
147              (cond-9/s1 c)              (condition-9/s1 c)
148              (cond-9/s2 c)))              (condition-9/s2 c)))
149    t 15 37)    t 15 37)
150    
151  (deftest cond-9-slots.2  (deftest condition-9-slots.2
152    (let ((c (make-condition 'cond-9 :i1 3)))    (let ((c (make-condition 'condition-9 :i1 3)))
153      (values (notnot (typep c 'cond-9))      (values (notnot (typep c 'condition-9))
154              (cond-9/s1 c)              (condition-9/s1 c)
155              (cond-9/s2 c)))              (condition-9/s2 c)))
156    t 3 37)    t 3 37)
157    
158  (deftest cond-9-slots.3  (deftest condition-9-slots.3
159    (let ((c (make-condition 'cond-9 :i2 3)))    (let ((c (make-condition 'condition-9 :i2 3)))
160      (values (notnot (typep c 'cond-9))      (values (notnot (typep c 'condition-9))
161              (cond-9/s1 c)              (condition-9/s1 c)
162              (cond-9/s2 c)))              (condition-9/s2 c)))
163    t 15 3)    t 15 3)
164    
165  (deftest cond-9-slots.4  (deftest condition-9-slots.4
166    (let ((c (make-condition 'cond-9 :i2 3 :i2 8)))    (let ((c (make-condition 'condition-9 :i2 3 :i2 8)))
167      (values (notnot (typep c 'cond-9))      (values (notnot (typep c 'condition-9))
168              (cond-9/s1 c)              (condition-9/s1 c)
169              (cond-9/s2 c)))              (condition-9/s2 c)))
170    t 15 3)    t 15 3)
171    
172  (deftest cond-9-slots.5  (deftest condition-9-slots.5
173    (let ((c (make-condition 'cond-9 :i1 3 :i2 8)))    (let ((c (make-condition 'condition-9 :i1 3 :i2 8)))
174      (values (notnot (typep c 'cond-9))      (values (notnot (typep c 'condition-9))
175              (cond-9/s1 c)              (condition-9/s1 c)
176              (cond-9/s2 c)))              (condition-9/s2 c)))
177    t 3 8)    t 3 8)
178    
179  (deftest cond-9-slots.6  (deftest condition-9-slots.6
180    (let ((c (make-condition 'cond-9 :i1 3 :i2 8 :i1 100 :i2 500)))    (let ((c (make-condition 'condition-9 :i1 3 :i2 8 :i1 100 :i2 500)))
181      (values (notnot (typep c 'cond-9))      (values (notnot (typep c 'condition-9))
182              (cond-9/s1 c)              (condition-9/s1 c)
183              (cond-9/s2 c)))              (condition-9/s2 c)))
184    t 3 8)    t 3 8)
185    
186  ;;; (define-condition-with-tests cond-10 nil  ;;; (define-condition-with-tests condition-10 nil
187  ;;;   ((s1 :initarg :i1 :writer cond-10/s1-w :reader cond-10/s1-r)))  ;;;   ((s1 :initarg :i1 :writer condition-10/s1-w :reader condition-10/s1-r)))
188  ;;;  ;;;
189  ;;; (deftest cond-10-slots.1  ;;; (deftest condition-10-slots.1
190  ;;;   (let ((c (make-condition 'cond-10 :i1 11)))  ;;;   (let ((c (make-condition 'condition-10 :i1 11)))
191  ;;;      (cond-10/s1-r c))  ;;;      (condition-10/s1-r c))
192  ;;;   11)  ;;;   11)
193  ;;;  ;;;
194  ;;; (deftest cond-10-slots.2  ;;; (deftest condition-10-slots.2
195  ;;;   (let ((c (make-condition 'cond-10 :i1 11)))  ;;;   (let ((c (make-condition 'condition-10 :i1 11)))
196  ;;;      (cond-10/s1-w 17 c))  ;;;      (condition-10/s1-w 17 c))
197  ;;;   17)  ;;;   17)
198  ;;;  ;;;
199  ;;; (deftest cond-10-slots.3  ;;; (deftest condition-10-slots.3
200  ;;;   (let ((c (make-condition 'cond-10 :i1 11)))  ;;;   (let ((c (make-condition 'condition-10 :i1 11)))
201  ;;;      (cond-10/s1-w 107 c)  ;;;      (condition-10/s1-w 107 c)
202  ;;;      (cond-10/s1-r c))  ;;;      (condition-10/s1-r c))
203  ;;;   107)  ;;;   107)
204  ;;;  ;;;
205  ;;; (define-condition-with-tests cond-11 nil  ;;; (define-condition-with-tests condition-11 nil
206  ;;;   ((s1 :initarg :i1 :writer (setf cond-11/w) :reader cond-11/r)))  ;;;   ((s1 :initarg :i1 :writer (setf condition-11/w) :reader condition-11/r)))
207  ;;;  ;;;
208  ;;; (deftest cond-11-slots.1  ;;; (deftest condition-11-slots.1
209  ;;;   (let ((c (make-condition 'cond-11 :i1 11)))  ;;;   (let ((c (make-condition 'condition-11 :i1 11)))
210  ;;;      (cond-11/r c))  ;;;      (condition-11/r c))
211  ;;;   11)  ;;;   11)
212  ;;;  ;;;
213  ;;; (deftest cond-11-slots.2  ;;; (deftest condition-11-slots.2
214  ;;;   (let ((c (make-condition 'cond-11 :i1 11)))  ;;;   (let ((c (make-condition 'condition-11 :i1 11)))
215  ;;;      (setf (cond-11/w c) 17))  ;;;      (setf (condition-11/w c) 17))
216  ;;;   17)  ;;;   17)
217  ;;;  ;;;
218  ;;; (deftest cond-11-slots.3  ;;; (deftest condition-11-slots.3
219  ;;;   (let ((c (make-condition 'cond-11 :i1 11)))  ;;;   (let ((c (make-condition 'condition-11 :i1 11)))
220  ;;;      (setf (cond-11/w c) 117)  ;;;      (setf (condition-11/w c) 117)
221  ;;;      (cond-11/r c))  ;;;      (condition-11/r c))
222  ;;;   117)  ;;;   117)
223  ;;;  ;;;
224  ;;; (deftest cond-11-slots.4  ;;; (deftest condition-11-slots.4
225  ;;;   (let ((c (make-condition 'cond-11 :i1 11)))  ;;;   (let ((c (make-condition 'condition-11 :i1 11)))
226  ;;;     (values  ;;;     (values
227  ;;;      (funcall #'(setf cond-11/w) 117 c)  ;;;      (funcall #'(setf condition-11/w) 117 c)
228  ;;;      (cond-11/r c)))  ;;;      (condition-11/r c)))
229  ;;;   117 117)  ;;;   117 117)
230    
231  ;;; The cond-12 and cond-13 tests have been removed.  Duane Rettig  ;;; The condition-12 and condition-13 tests have been removed.  Duane Rettig
232  ;;; convincingly argued that the feature being tested (non-symbol  ;;; convincingly argued that the feature being tested (non-symbol
233  ;;; slot names) remains in the standard only because of editing errors.  ;;; slot names) remains in the standard only because of editing errors.
234    
235  ;;; (define-condition-with-tests cond-12 nil  ;;; (define-condition-with-tests condition-12 nil
236  ;;;   (((slot1) :initarg :slot1 :reader cond-12/slot-1)  ;;;   (((slot1) :initarg :slot1 :reader condition-12/slot-1)
237  ;;;    ((slot2) :initarg :slot2 :reader cond-12/slot-2)))  ;;;    ((slot2) :initarg :slot2 :reader condition-12/slot-2)))
238  ;;;  ;;;
239  ;;; (deftest cond-12-slots.1  ;;; (deftest condition-12-slots.1
240  ;;;   (let ((c (make-condition 'cond-12 :slot1 'a :slot2 'b)))  ;;;   (let ((c (make-condition 'condition-12 :slot1 'a :slot2 'b)))
241  ;;;     (and (typep c 'cond-12)  ;;;     (and (typep c 'condition-12)
242  ;;;      (eqt (cond-12/slot-1 c) 'a)  ;;;      (eqt (condition-12/slot-1 c) 'a)
243  ;;;      (eqt (cond-12/slot-2 c) 'b)))  ;;;      (eqt (condition-12/slot-2 c) 'b)))
244  ;;;   t)  ;;;   t)
245  ;;;  ;;;
246  ;;; (define-condition-with-tests cond-13 nil  ;;; (define-condition-with-tests condition-13 nil
247  ;;;   (((slot1 10) :initarg :slot1 :reader cond-13/slot-1)))  ;;;   (((slot1 10) :initarg :slot1 :reader condition-13/slot-1)))
248  ;;;  ;;;
249  ;;; (deftest cond-13-slots.1  ;;; (deftest condition-13-slots.1
250  ;;;   (let ((c (make-condition 'cond-13)))  ;;;   (let ((c (make-condition 'condition-13)))
251  ;;;     (and (typep c 'cond-13)  ;;;     (and (typep c 'condition-13)
252  ;;;      (cond-13/slot-1 c)))  ;;;      (condition-13/slot-1 c)))
253  ;;;   10)  ;;;   10)
254    
255  (define-condition-with-tests cond-14 nil  (define-condition-with-tests condition-14 nil
256    ((s1 :initarg :i1 :type fixnum :reader cond-14/s1)    ((s1 :initarg :i1 :type fixnum :reader condition-14/s1)
257     (s2 :initarg :i2 :type t :reader cond-14/s2)))     (s2 :initarg :i2 :type t :reader condition-14/s2)))
258    
259  (deftest cond-14-slots.1  (deftest condition-14-slots.1
260    (let ((c (make-condition 'cond-14 :i1 10)))    (let ((c (make-condition 'condition-14 :i1 10)))
261      (and (typep c 'cond-14)      (and (typep c 'condition-14)
262           (cond-14/s1 c)))           (condition-14/s1 c)))
263    10)    10)
264    
265  (deftest cond-14-slots.2  (deftest condition-14-slots.2
266    (let ((c (make-condition 'cond-14 :i2 'a)))    (let ((c (make-condition 'condition-14 :i2 'a)))
267      (and (typep c 'cond-14)      (and (typep c 'condition-14)
268           (cond-14/s2 c)))           (condition-14/s2 c)))
269    a)    a)
270    
271  (deftest cond-14-slots.3  (deftest condition-14-slots.3
272    (let ((c (make-condition 'cond-14 :i1 10 :i2 'h)))    (let ((c (make-condition 'condition-14 :i1 10 :i2 'h)))
273      (and (typep c 'cond-14)      (and (typep c 'condition-14)
274           (eqt (cond-14/s1 c) 10)           (eqt (condition-14/s1 c) 10)
275           (cond-14/s2 c)))           (condition-14/s2 c)))
276    h)    h)
277    
278  (define-condition-with-tests cond-15 nil  (define-condition-with-tests condition-15 nil
279    ((s1 :type nil)))    ((s1 :type nil)))
280    
281  (define-condition-with-tests cond-16 nil  (define-condition-with-tests condition-16 nil
282    ((slot1))    ((slot1))
283    (:report "The report for cond-16"))    (:report "The report for condition-16"))
284    
285  (deftest cond-16-report.1  (deftest condition-16-report.1
286    (let ((*print-escape* nil)    (let ((*print-escape* nil)
287          (c (make-condition 'cond-16)))          (c (make-condition 'condition-16)))
288      (with-output-to-string (s) (print-object c s)))      (with-output-to-string (s) (print-object c s)))
289    "The report for cond-16")    "The report for condition-16")
290    
291  (define-condition-with-tests cond-17 nil  (define-condition-with-tests condition-17 nil
292    ((s :initarg :i1 :reader cond-17/s ))    ((s :initarg :i1 :reader condition-17/s ))
293    (:report cond-17-report))    (:report condition-17-report))
294    
295  (defun cond-17-report (c s)  (defun condition-17-report (c s)
296    (format s "cond-17: ~A" (cond-17/s c)))    (format s "condition-17: ~A" (condition-17/s c)))
297    
298  (deftest cond-17-report.1  (deftest condition-17-report.1
299    (let ((*print-escape* nil)    (let ((*print-escape* nil)
300          (c (make-condition 'cond-17 :i1 1234)))          (c (make-condition 'condition-17 :i1 1234)))
301      (with-output-to-string (s) (print-object c s)))      (with-output-to-string (s) (print-object c s)))
302    "cond-17: 1234")    "condition-17: 1234")
303    
304  (define-condition-with-tests cond-18 nil  (define-condition-with-tests condition-18 nil
305    ((s :initarg :i1 :reader cond-18/s ))    ((s :initarg :i1 :reader condition-18/s ))
306    (:report (lambda (c s) (format s "cond-18: ~A" (cond-18/s c)))))    (:report (lambda (c s) (format s "condition-18: ~A" (condition-18/s c)))))
307    
308  (deftest cond-18-report.1  (deftest condition-18-report.1
309    (let ((*print-escape* nil)    (let ((*print-escape* nil)
310          (c (make-condition 'cond-18 :i1 4321)))          (c (make-condition 'condition-18 :i1 4321)))
311      (with-output-to-string (s) (print-object c s)))      (with-output-to-string (s) (print-object c s)))
312    "cond-18: 4321")    "condition-18: 4321")
313    
314  ;;;  ;;;
315  ;;; Tests of :default-initargs  ;;; Tests of :default-initargs
# Line 320  Line 320 
320  ;;; are initargs and initforms.  I have taken the second interpretation.  ;;; are initargs and initforms.  I have taken the second interpretation.
321  ;;;  ;;;
322    
323  (define-condition-with-tests cond-19 nil  (define-condition-with-tests condition-19 nil
324    ((s1 :reader cond-19/s1 :initarg :i1)    ((s1 :reader condition-19/s1 :initarg :i1)
325     (s2 :reader cond-19/s2 :initarg :i2))     (s2 :reader condition-19/s2 :initarg :i2))
326    (:default-initargs :i1 10    (:default-initargs :i1 10
327                       :i2 20))                       :i2 20))
328    
329  (deftest cond-19-slots.1  (deftest condition-19-slots.1
330    (let ((c (make-condition 'cond-19)))    (let ((c (make-condition 'condition-19)))
331      (values      (values
332       (notnot (typep c 'cond-19))       (notnot (typep c 'condition-19))
333       (cond-19/s1 c)       (condition-19/s1 c)
334       (cond-19/s2 c)))       (condition-19/s2 c)))
335    t 10 20)    t 10 20)
336    
337  (deftest cond-19-slots.2  (deftest condition-19-slots.2
338    (let ((c (make-condition 'cond-19 :i1 'a)))    (let ((c (make-condition 'condition-19 :i1 'a)))
339      (values      (values
340       (notnot (typep c 'cond-19))       (notnot (typep c 'condition-19))
341       (cond-19/s1 c)       (condition-19/s1 c)
342       (cond-19/s2 c)))       (condition-19/s2 c)))
343    t a 20)    t a 20)
344    
345  (deftest cond-19-slots.3  (deftest condition-19-slots.3
346    (let ((c (make-condition 'cond-19 :i2 'a)))    (let ((c (make-condition 'condition-19 :i2 'a)))
347      (values      (values
348       (notnot (typep c 'cond-19))       (notnot (typep c 'condition-19))
349       (cond-19/s1 c)       (condition-19/s1 c)
350       (cond-19/s2 c)))       (condition-19/s2 c)))
351    t 10 a)    t 10 a)
352    
353  (deftest cond-19-slots.4  (deftest condition-19-slots.4
354    (let ((c (make-condition 'cond-19 :i1 'x :i2 'y)))    (let ((c (make-condition 'condition-19 :i1 'x :i2 'y)))
355      (values      (values
356       (notnot (typep c 'cond-19))       (notnot (typep c 'condition-19))
357       (cond-19/s1 c)       (condition-19/s1 c)
358       (cond-19/s2 c)))       (condition-19/s2 c)))
359    t x y)    t x y)
360    
361  (deftest cond-19-slots.5  (deftest condition-19-slots.5
362    (let ((c (make-condition 'cond-19 :i2 'y :i1 'x)))    (let ((c (make-condition 'condition-19 :i2 'y :i1 'x)))
363      (values      (values
364       (notnot (typep c 'cond-19))       (notnot (typep c 'condition-19))
365       (cond-19/s1 c)       (condition-19/s1 c)
366       (cond-19/s2 c)))       (condition-19/s2 c)))
367    t x y)    t x y)
368    
369  (defparameter *cond-20/s1-val* 0)  (defparameter *condition-20/s1-val* 0)
370  (defparameter *cond-20/s2-val* 0)  (defparameter *condition-20/s2-val* 0)
371    
372  (define-condition-with-tests cond-20 nil  (define-condition-with-tests condition-20 nil
373    ((s1 :reader cond-20/s1 :initarg :i1)    ((s1 :reader condition-20/s1 :initarg :i1)
374     (s2 :reader cond-20/s2 :initarg :i2))     (s2 :reader condition-20/s2 :initarg :i2))
375    (:default-initargs :i1 (incf *cond-20/s1-val*)    (:default-initargs :i1 (incf *condition-20/s1-val*)
376                       :i2 (incf *cond-20/s2-val*)))                       :i2 (incf *condition-20/s2-val*)))
377    
378  (deftest cond-20-slots.1  (deftest condition-20-slots.1
379    (let ((*cond-20/s1-val* 0)    (let ((*condition-20/s1-val* 0)
380          (*cond-20/s2-val* 10))          (*condition-20/s2-val* 10))
381      (declare (special *cond-20/s1-val* *cond-20/s2-val*))      (declare (special *condition-20/s1-val* *condition-20/s2-val*))
382      (let ((c (make-condition 'cond-20)))      (let ((c (make-condition 'condition-20)))
383        (values        (values
384         (notnot (typep c 'cond-20))         (notnot (typep c 'condition-20))
385         (cond-20/s1 c)         (condition-20/s1 c)
386         (cond-20/s2 c)         (condition-20/s2 c)
387         *cond-20/s1-val*         *condition-20/s1-val*
388         *cond-20/s2-val*)))         *condition-20/s2-val*)))
389    t 1 11 1 11)    t 1 11 1 11)
390    
391  (deftest cond-20-slots.2  (deftest condition-20-slots.2
392    (let ((*cond-20/s1-val* 0)    (let ((*condition-20/s1-val* 0)
393          (*cond-20/s2-val* 10))          (*condition-20/s2-val* 10))
394      (declare (special *cond-20/s1-val* *cond-20/s2-val*))      (declare (special *condition-20/s1-val* *condition-20/s2-val*))
395      (let ((c (make-condition 'cond-20 :i1 'x)))      (let ((c (make-condition 'condition-20 :i1 'x)))
396        (values        (values
397         (notnot (typep c 'cond-20))         (notnot (typep c 'condition-20))
398         (cond-20/s1 c)         (condition-20/s1 c)
399         (cond-20/s2 c)         (condition-20/s2 c)
400         *cond-20/s1-val*         *condition-20/s1-val*
401         *cond-20/s2-val*)))         *condition-20/s2-val*)))
402    t x 11 0 11)    t x 11 0 11)
403    
404  (deftest cond-20-slots.3  (deftest condition-20-slots.3
405    (let ((*cond-20/s1-val* 0)    (let ((*condition-20/s1-val* 0)
406          (*cond-20/s2-val* 10))          (*condition-20/s2-val* 10))
407      (declare (special *cond-20/s1-val* *cond-20/s2-val*))      (declare (special *condition-20/s1-val* *condition-20/s2-val*))
408      (let ((c (make-condition 'cond-20 :i2 'y)))      (let ((c (make-condition 'condition-20 :i2 'y)))
409        (values        (values
410         (notnot (typep c 'cond-20))         (notnot (typep c 'condition-20))
411         (cond-20/s1 c)         (condition-20/s1 c)
412         (cond-20/s2 c)         (condition-20/s2 c)
413         *cond-20/s1-val*         *condition-20/s1-val*
414         *cond-20/s2-val*)))         *condition-20/s2-val*)))
415    t 1 y 1 10)    t 1 y 1 10)
416    
417  (deftest cond-20-slots.4  (deftest condition-20-slots.4
418    (let ((*cond-20/s1-val* 0)    (let ((*condition-20/s1-val* 0)
419          (*cond-20/s2-val* 10))          (*condition-20/s2-val* 10))
420      (declare (special *cond-20/s1-val* *cond-20/s2-val*))      (declare (special *condition-20/s1-val* *condition-20/s2-val*))
421      (let ((c (make-condition 'cond-20 :i2 'y :i1 'x)))      (let ((c (make-condition 'condition-20 :i2 'y :i1 'x)))
422        (values        (values
423         (notnot (typep c 'cond-20))         (notnot (typep c 'condition-20))
424         (cond-20/s1 c)         (condition-20/s1 c)
425         (cond-20/s2 c)         (condition-20/s2 c)
426         *cond-20/s1-val*         *condition-20/s1-val*
427         *cond-20/s2-val*)))         *condition-20/s2-val*)))
428    t x y 0 10)    t x y 0 10)
429    
430    
431  ;;;;;;;;; tests of inheritance  ;;;;;;;;; tests of inheritance
432    
433  (define-condition-with-tests cond-21 (cond-4) nil)  (define-condition-with-tests condition-21 (condition-4) nil)
434    
435  (deftest cond-21-slots.1  (deftest condition-21-slots.1
436    (let ((c (make-condition 'cond-21 :slot1 'a :slot2 'b)))    (let ((c (make-condition 'condition-21 :slot1 'a :slot2 'b)))
437      (and (typep c 'cond-4)      (and (typep c 'condition-4)
438           (typep c 'cond-21)           (typep c 'condition-21)
439           (eqt (cond-4/slot-1 c) 'a)           (eqt (condition-4/slot-1 c) 'a)
440           (eqt (cond-4/slot-2 c) 'b)))           (eqt (condition-4/slot-2 c) 'b)))
441    t)    t)
442    
443  (define-condition-with-tests cond-22 (cond-4)  (define-condition-with-tests condition-22 (condition-4)
444    ((slot3 :initarg :slot3 :reader cond-22/slot-3)    ((slot3 :initarg :slot3 :reader condition-22/slot-3)
445     (slot4 :initarg :slot4 :reader cond-22/slot-4)))     (slot4 :initarg :slot4 :reader condition-22/slot-4)))
446    
447  (deftest cond-22-slots.1  (deftest condition-22-slots.1
448    (let ((c (make-condition 'cond-22 :slot1 'a :slot2 'b    (let ((c (make-condition 'condition-22 :slot1 'a :slot2 'b
449                             :slot3 'c :slot4 'd)))                             :slot3 'c :slot4 'd)))
450      (and (typep c 'cond-4)      (and (typep c 'condition-4)
451           (typep c 'cond-22)           (typep c 'condition-22)
452           (eqt (cond-4/slot-1 c) 'a)           (eqt (condition-4/slot-1 c) 'a)
453           (eqt (cond-4/slot-2 c) 'b)           (eqt (condition-4/slot-2 c) 'b)
454           (eqt (cond-22/slot-3 c) 'c)           (eqt (condition-22/slot-3 c) 'c)
455           (eqt (cond-22/slot-4 c) 'd)           (eqt (condition-22/slot-4 c) 'd)
456           ))           ))
457    t)    t)
458    
459  (define-condition-with-tests cond-23 (cond-5) nil)  (define-condition-with-tests condition-23 (condition-5) nil)
460    
461  (deftest cond-23-slots.1  (deftest condition-23-slots.1
462    (let ((c (make-condition 'cond-23 :slot1 'a :slot2 'b)))    (let ((c (make-condition 'condition-23 :slot1 'a :slot2 'b)))
463      (and (typep c 'cond-5)      (and (typep c 'condition-5)
464           (typep c 'cond-23)           (typep c 'condition-23)
465           (eqt (cond-5/slot-1 c) 'a)           (eqt (condition-5/slot-1 c) 'a)
466           (eqt (cond-5/slot-2 c) 'b)           (eqt (condition-5/slot-2 c) 'b)
467           ))           ))
468    t)    t)
469    
470  (deftest cond-23-slots.2  (deftest condition-23-slots.2
471    (let ((c (make-condition 'cond-23 :slot1 'a)))    (let ((c (make-condition 'condition-23 :slot1 'a)))
472      (and (typep c 'cond-5)      (and (typep c 'condition-5)
473           (typep c 'cond-23)           (typep c 'condition-23)
474           (eqt (cond-5/slot-1 c) 'a)           (eqt (condition-5/slot-1 c) 'a)
475           (eqt (cond-5/slot-2 c) 'y)           (eqt (condition-5/slot-2 c) 'y)
476           ))           ))
477    t)    t)
478    
479  (deftest cond-23-slots.3  (deftest condition-23-slots.3
480    (let ((c (make-condition 'cond-23 :slot2 'b)))    (let ((c (make-condition 'condition-23 :slot2 'b)))
481      (and (typep c 'cond-5)      (and (typep c 'condition-5)
482           (typep c 'cond-23)           (typep c 'condition-23)
483           (eqt (cond-5/slot-1 c) 'x)           (eqt (condition-5/slot-1 c) 'x)
484           (eqt (cond-5/slot-2 c) 'b)           (eqt (condition-5/slot-2 c) 'b)
485           ))           ))
486    t)    t)
487    
488  (deftest cond-23-slots.4  (deftest condition-23-slots.4
489    (let ((c (make-condition 'cond-23)))    (let ((c (make-condition 'condition-23)))
490      (and (typep c 'cond-5)      (and (typep c 'condition-5)
491           (typep c 'cond-23)           (typep c 'condition-23)
492           (eqt (cond-5/slot-1 c) 'x)           (eqt (condition-5/slot-1 c) 'x)
493           (eqt (cond-5/slot-2 c) 'y)           (eqt (condition-5/slot-2 c) 'y)
494           ))           ))
495    t)    t)
496    
497  (define-condition-with-tests cond-24 (cond-5)  (define-condition-with-tests condition-24 (condition-5)
498    nil    nil
499    (:default-initargs :slot1 'z))    (:default-initargs :slot1 'z))
500    
501  (deftest cond-24-slots.1  (deftest condition-24-slots.1
502    (let ((c (make-condition 'cond-24)))    (let ((c (make-condition 'condition-24)))
503      (and (typep c 'cond-5)      (and (typep c 'condition-5)
504           (typep c 'cond-24)           (typep c 'condition-24)
505           (eqt (cond-5/slot-1 c) 'z)           (eqt (condition-5/slot-1 c) 'z)
506           (eqt (cond-5/slot-2 c) 'y)           (eqt (condition-5/slot-2 c) 'y)
507           ))           ))
508    t)    t)
509    
510  (deftest cond-24-slots.2  (deftest condition-24-slots.2
511    (let ((c (make-condition 'cond-24 :slot1 'a)))    (let ((c (make-condition 'condition-24 :slot1 'a)))
512      (and (typep c 'cond-5)      (and (typep c 'condition-5)
513           (typep c 'cond-24)           (typep c 'condition-24)
514           (eqt (cond-5/slot-1 c) 'a)           (eqt (condition-5/slot-1 c) 'a)
515           (eqt (cond-5/slot-2 c) 'y)           (eqt (condition-5/slot-2 c) 'y)
516           ))           ))
517    t)    t)
518    
519  (deftest cond-24-slots.3  (deftest condition-24-slots.3
520    (let ((c (make-condition 'cond-24 :slot2 'a)))    (let ((c (make-condition 'condition-24 :slot2 'a)))
521      (and (typep c 'cond-5)      (and (typep c 'condition-5)
522           (typep c 'cond-24)           (typep c 'condition-24)
523           (eqt (cond-5/slot-1 c) 'z)           (eqt (condition-5/slot-1 c) 'z)
524           (eqt (cond-5/slot-2 c) 'a)           (eqt (condition-5/slot-2 c) 'a)
525           ))           ))
526    t)    t)
527    
528  (deftest cond-24-slots.4  (deftest condition-24-slots.4
529    (let ((c (make-condition 'cond-24 :slot1 'b :slot2 'a)))    (let ((c (make-condition 'condition-24 :slot1 'b :slot2 'a)))
530      (and (typep c 'cond-5)      (and (typep c 'condition-5)
531           (typep c 'cond-24)           (typep c 'condition-24)
532           (eqt (cond-5/slot-1 c) 'b)           (eqt (condition-5/slot-1 c) 'b)
533           (eqt (cond-5/slot-2 c) 'a)           (eqt (condition-5/slot-2 c) 'a)
534           ))           ))
535    t)    t)
536    
537  ;;; Multiple inheritance  ;;; Multiple inheritance
538    
539  (define-condition-with-tests cond-25a nil  (define-condition-with-tests condition-25a nil
540    ((s1 :initarg :s1 :initform 'a :reader cond-25a/s1)))    ((s1 :initarg :s1 :initform 'a :reader condition-25a/s1)))
541    
542  (define-condition-with-tests cond-25b nil  (define-condition-with-tests condition-25b nil
543    ((s2 :initarg :s2 :initform 'b :reader cond-25b/s2)))    ((s2 :initarg :s2 :initform 'b :reader condition-25b/s2)))
544    
545  (define-condition-with-tests cond-25 (cond-25a cond-25b)  (define-condition-with-tests condition-25 (condition-25a condition-25b)
546    ((s3 :initarg :s3 :initform 'c :reader cond-25/s3)))    ((s3 :initarg :s3 :initform 'c :reader condition-25/s3)))
547    
548  (deftest cond-25-slots.1  (deftest condition-25-slots.1
549    (let ((c (make-condition 'cond-25)))    (let ((c (make-condition 'condition-25)))
550      (and (typep c 'cond-25a)      (and (typep c 'condition-25a)
551           (typep c 'cond-25b)           (typep c 'condition-25b)
552           (typep c 'cond-25)           (typep c 'condition-25)
553           (eqt (cond-25a/s1 c) 'a)           (eqt (condition-25a/s1 c) 'a)
554           (eqt (cond-25b/s2 c) 'b)           (eqt (condition-25b/s2 c) 'b)
555           (eqt (cond-25/s3 c) 'c)))           (eqt (condition-25/s3 c) 'c)))
556    t)    t)
557    
558  (deftest cond-25-slots.2  (deftest condition-25-slots.2
559    (let ((c (make-condition 'cond-25 :s1 'x)))    (let ((c (make-condition 'condition-25 :s1 'x)))
560      (and (typep c 'cond-25a)      (and (typep c 'condition-25a)
561           (typep c 'cond-25b)           (typep c 'condition-25b)
562           (typep c 'cond-25)           (typep c 'condition-25)
563           (eqt (cond-25a/s1 c) 'x)           (eqt (condition-25a/s1 c) 'x)
564           (eqt (cond-25b/s2 c) 'b)           (eqt (condition-25b/s2 c) 'b)
565           (eqt (cond-25/s3 c) 'c)))           (eqt (condition-25/s3 c) 'c)))
566    t)    t)
567    
568  (deftest cond-25-slots.3  (deftest condition-25-slots.3
569    (let ((c (make-condition 'cond-25 :s2 'x)))    (let ((c (make-condition 'condition-25 :s2 'x)))
570      (and (typep c 'cond-25a)      (and (typep c 'condition-25a)
571           (typep c 'cond-25b)           (typep c 'condition-25b)
572           (typep c 'cond-25)           (typep c 'condition-25)
573           (eqt (cond-25a/s1 c) 'a)           (eqt (condition-25a/s1 c) 'a)
574           (eqt (cond-25b/s2 c) 'x)           (eqt (condition-25b/s2 c) 'x)
575           (eqt (cond-25/s3 c) 'c)))           (eqt (condition-25/s3 c) 'c)))
576    t)    t)
577    
578  (deftest cond-25-slots.4  (deftest condition-25-slots.4
579    (let ((c (make-condition 'cond-25 :s3 'x)))    (let ((c (make-condition 'condition-25 :s3 'x)))
580      (and (typep c 'cond-25a)      (and (typep c 'condition-25a)
581           (typep c 'cond-25b)           (typep c 'condition-25b)
582           (typep c 'cond-25)           (typep c 'condition-25)
583           (eqt (cond-25a/s1 c) 'a)           (eqt (condition-25a/s1 c) 'a)
584           (eqt (cond-25b/s2 c) 'b)           (eqt (condition-25b/s2 c) 'b)
585           (eqt (cond-25/s3 c) 'x)))           (eqt (condition-25/s3 c) 'x)))
586    t)    t)
587    
588  (deftest cond-25-slots.5  (deftest condition-25-slots.5
589    (let ((c (make-condition 'cond-25 :s3 'z :s2 'y :s1 'x)))    (let ((c (make-condition 'condition-25 :s3 'z :s2 'y :s1 'x)))
590      (and (typep c 'cond-25a)      (and (typep c 'condition-25a)
591           (typep c 'cond-25b)           (typep c 'condition-25b)
592           (typep c 'cond-25)           (typep c 'condition-25)
593           (eqt (cond-25a/s1 c) 'x)           (eqt (condition-25a/s1 c) 'x)
594           (eqt (cond-25b/s2 c) 'y)           (eqt (condition-25b/s2 c) 'y)
595           (eqt (cond-25/s3 c) 'z)))           (eqt (condition-25/s3 c) 'z)))
596    t)    t)
597    
598  ;;;  ;;;
599    
600  (define-condition-with-tests cond-26a nil  (define-condition-with-tests condition-26a nil
601    ((s1 :initarg :s1 :initform 'a :reader cond-26a/s1)))    ((s1 :initarg :s1 :initform 'a :reader condition-26a/s1)))
602    
603  (define-condition-with-tests cond-26b (cond-26a) nil)  (define-condition-with-tests condition-26b (condition-26a) nil)
604  (define-condition-with-tests cond-26c (cond-26a) nil)  (define-condition-with-tests condition-26c (condition-26a) nil)
605  (define-condition-with-tests cond-26 (cond-26b cond-26c) nil)  (define-condition-with-tests condition-26 (condition-26b condition-26c) nil)
606    
607  (deftest cond-26-slots.1  (deftest condition-26-slots.1
608    (let ((c (make-condition 'cond-26)))    (let ((c (make-condition 'condition-26)))
609      (and (typep c 'cond-26a)      (and (typep c 'condition-26a)
610           (typep c 'cond-26b)           (typep c 'condition-26b)
611           (typep c 'cond-26c)           (typep c 'condition-26c)
612           (typep c 'cond-26)           (typep c 'condition-26)
613           (eqt (cond-26a/s1 c) 'a)))           (eqt (condition-26a/s1 c) 'a)))
614    t)    t)
615    
616  (deftest cond-26-slots.2  (deftest condition-26-slots.2
617    (let ((c (make-condition 'cond-26 :s1 'x)))    (let ((c (make-condition 'condition-26 :s1 'x)))
618      (and (typep c 'cond-26a)      (and (typep c 'condition-26a)
619           (typep c 'cond-26b)           (typep c 'condition-26b)
620           (typep c 'cond-26c)           (typep c 'condition-26c)
621           (typep c 'cond-26)           (typep c 'condition-26)
622           (eqt (cond-26a/s1 c) 'x)))           (eqt (condition-26a/s1 c) 'x)))
623    t)    t)
624    
625    
626  ;;; Test that a slot reader is truly a generic function  ;;; Test that a slot reader is truly a generic function
627    
628  (define-condition-with-tests cond-27a nil  (define-condition-with-tests condition-27a nil
629    ((s0 :initarg :s0 :initform 10 :reader cond-27a/s0)    ((s0 :initarg :s0 :initform 10 :reader condition-27a/s0)
630     (s1 :initarg :s1 :initform 'a :reader cond-27/s1)))     (s1 :initarg :s1 :initform 'a :reader condition-27/s1)))
631    
632  (define-condition-with-tests cond-27b nil  (define-condition-with-tests condition-27b nil
633    ((s1 :initarg :s1 :initform 'a :reader cond-27/s1)    ((s1 :initarg :s1 :initform 'a :reader condition-27/s1)
634     (s2 :initarg :s2 :initform 16 :reader cond-27b/s2)))     (s2 :initarg :s2 :initform 16 :reader condition-27b/s2)))
635    
636  (deftest cond-27-slots.1  (deftest condition-27-slots.1
637    (let ((c (make-condition 'cond-27a)))    (let ((c (make-condition 'condition-27a)))
638      (and (typep c 'cond-27a)      (and (typep c 'condition-27a)
639           (not (typep c 'cond-27b))           (not (typep c 'condition-27b))
640           (eqt (cond-27/s1 c) 'a)))           (eqt (condition-27/s1 c) 'a)))
641    t)    t)
642    
643  (deftest cond-27-slots.2  (deftest condition-27-slots.2
644    (let ((c (make-condition 'cond-27b)))    (let ((c (make-condition 'condition-27b)))
645      (and (typep c 'cond-27b)      (and (typep c 'condition-27b)
646           (not (typep c 'cond-27a))           (not (typep c 'condition-27a))
647           (eqt (cond-27/s1 c) 'a)))           (eqt (condition-27/s1 c) 'a)))
648    t)    t)
649    
650  (deftest cond-27-reader-is-generic  (deftest condition-27-reader-is-generic
651    (notnot-mv (typep #'cond-27/s1 'generic-function))    (notnot-mv (typep #'condition-27/s1 'generic-function))
652    t)    t)
653    
654  ;;; More inheritance  ;;; More inheritance
# Line 659  Line 659 
659  ;;; fully integrated into the standard.)  ;;; fully integrated into the standard.)
660    
661  #|  #|
662  (define-condition-with-tests cond-28a nil  (define-condition-with-tests condition-28a nil
663    ((s1 :initarg :i1 :initform 'x :reader cond-28a/s1)))    ((s1 :initarg :i1 :initform 'x :reader condition-28a/s1)))
664    
665  (define-condition-with-tests cond-28 (cond-28a)  (define-condition-with-tests condition-28 (condition-28a)
666    ((s1 :initarg :i1a :reader cond-28/s1)))    ((s1 :initarg :i1a :reader condition-28/s1)))
667    
668  (deftest cond-28-slots.1  (deftest condition-28-slots.1
669    (let ((c (make-condition 'cond-28)))    (let ((c (make-condition 'condition-28)))
670      (and (typep c 'cond-28a)      (and (typep c 'condition-28a)
671           (typep c 'cond-28)           (typep c 'condition-28)
672           (eqt (cond-28a/s1 c) 'x)           (eqt (condition-28a/s1 c) 'x)
673           (eqt (cond-28/s1 c) 'x)))           (eqt (condition-28/s1 c) 'x)))
674    t)    t)
675    
676  (deftest cond-28-slots.2  (deftest condition-28-slots.2
677    (let ((c (make-condition 'cond-28 :i1 'z)))    (let ((c (make-condition 'condition-28 :i1 'z)))
678      (and (typep c 'cond-28a)      (and (typep c 'condition-28a)
679           (typep c 'cond-28)           (typep c 'condition-28)
680           (eqt (cond-28a/s1 c) 'z)           (eqt (condition-28a/s1 c) 'z)
681           (eqt (cond-28/s1 c) 'z)))           (eqt (condition-28/s1 c) 'z)))
682    t)    t)
683    
684  (deftest cond-28-slots.3  (deftest condition-28-slots.3
685    (let ((c (make-condition 'cond-28 :i1a 'w)))    (let ((c (make-condition 'condition-28 :i1a 'w)))
686      (and (typep c 'cond-28a)      (and (typep c 'condition-28a)
687           (typep c 'cond-28)           (typep c 'condition-28)
688           (eqt (cond-28a/s1 c) 'w)           (eqt (condition-28a/s1 c) 'w)
689           (eqt (cond-28/s1 c) 'w)))           (eqt (condition-28/s1 c) 'w)))
690    t)    t)
691    
692  (deftest cond-28-slots.4  (deftest condition-28-slots.4
693    (let ((c (make-condition 'cond-28 :i1 'y :i1a 'w)))    (let ((c (make-condition 'condition-28 :i1 'y :i1a 'w)))
694      (and (typep c 'cond-28a)      (and (typep c 'condition-28a)
695           (typep c 'cond-28)           (typep c 'condition-28)
696           (eqt (cond-28a/s1 c) 'y)           (eqt (condition-28a/s1 c) 'y)
697           (eqt (cond-28/s1 c) 'y)))           (eqt (condition-28/s1 c) 'y)))
698    t)    t)
699    
700  (deftest cond-28-slots.5  (deftest condition-28-slots.5
701    (let ((c (make-condition 'cond-28 :i1a 'y :i1 'w)))    (let ((c (make-condition 'condition-28 :i1a 'y :i1 'w)))
702      (and (typep c 'cond-28a)      (and (typep c 'condition-28a)
703           (typep c 'cond-28)           (typep c 'condition-28)
704           (eqt (cond-28a/s1 c) 'y)           (eqt (condition-28a/s1 c) 'y)
705           (eqt (cond-28/s1 c) 'y)))           (eqt (condition-28/s1 c) 'y)))
706    t)    t)
707  |#  |#
708    
# Line 710  Line 710 
710  ;;; Documentation  ;;; Documentation
711    
712  ;;; Pitman says this should have been in the spec, but it isn't really  ;;; Pitman says this should have been in the spec, but it isn't really
713  ;;; (define-condition-with-tests cond-29 nil  ;;; (define-condition-with-tests condition-29 nil
714  ;;;  ((s1 :initarg :i1 :initform 'x  ;;;  ((s1 :initarg :i1 :initform 'x
715  ;;;       :documentation "This is slot s1 in condition cond-29")))  ;;;       :documentation "This is slot s1 in condition condition-29")))
716    
717  (define-condition-with-tests cond-30 nil  (define-condition-with-tests condition-30 nil
718    ((s1 :initarg :i1 :initform 'x))    ((s1 :initarg :i1 :initform 'x))
719    (:documentation "This is class cond-30"))    (:documentation "This is class condition-30"))

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26