/[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.3 by pfdietz, Thu Mar 13 05:45:24 2003 UTC revision 1.4 by pfdietz, Sat Mar 15 19:21:13 2003 UTC
# Line 11  Line 11 
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)
# Line 97  Line 97 
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")

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

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