/[gcl]/gcl/ansi-tests/defclass-01.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/defclass-01.lsp

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

revision 1.1 by pfdietz, Mon Apr 21 12:20:33 2003 UTC revision 1.2 by pfdietz, Tue Apr 22 05:00:21 2003 UTC
# Line 164  Line 164 
164    
165  ;;;;  ;;;;
166    
167    (defclass class-07 () ((s1 :initarg :s1a :initarg :s1b :reader s1)
168                           (s2 :initarg :s2 :reader s2)))
169    
170        (deftest class-07.1
171      (let ((c (make-instance 'class-07)))
172        (values
173         (slot-boundp c 's1)
174         (slot-boundp c 's2)))
175      nil nil)
176    
177    (deftest class-07.2
178      (let ((c (make-instance 'class-07 :s1a 'x)))
179        (values
180         (notnot (slot-boundp c 's1))
181         (s1 c)
182         (slot-boundp c 's2)))
183      t x nil)
184    
185    (deftest class-07.3
186      (let ((c (make-instance 'class-07 :s1b 'x)))
187        (values
188         (notnot (slot-boundp c 's1))
189         (s1 c)
190         (slot-boundp c 's2)))
191      t x nil)
192    
193    (deftest class-07.4
194      (let ((c (make-instance 'class-07 :s1a 'y :s1b 'x)))
195        (values
196         (notnot (slot-boundp c 's1))
197         (s1 c)
198         (slot-boundp c 's2)))
199      t y nil)
200    
201    
202    (deftest class-07.5
203      (let ((c (make-instance 'class-07 :s1b 'y :s1a 'x)))
204        (values
205         (notnot (slot-boundp c 's1))
206         (s1 c)
207         (slot-boundp c 's2)))
208      t y nil)
209    
210    (deftest class-07.6
211      (let ((c (make-instance 'class-07 :s1a 'y :s1a 'x)))
212        (values
213         (notnot (slot-boundp c 's1))
214         (s1 c)
215         (slot-boundp c 's2)))
216      t y nil)
217    
218    (deftest class-07.7
219      (let ((c (make-instance 'class-07 :s2 'a :s1a 'b)))
220        (values
221         (notnot (slot-boundp c 's1))
222         (notnot (slot-boundp c 's2))
223         (s1 c)
224         (s2 c)))
225      t t b a)
226    
227    (deftest class-07.8
228      (let ((c (make-instance 'class-07 :s2 'a :s1a 'b :s2 'x :s1a 'y :s1b 'z)))
229        (values
230         (notnot (slot-boundp c 's1))
231         (notnot (slot-boundp c 's2))
232         (s1 c)
233         (s2 c)))
234      t t b a)
235    
236    ;;;;
237    
238    (declaim (special *class-08-s2-initvar*))
239    
240    (defclass class-08 ()
241      ((s1 :initform 0) (s2 :initform *class-08-s2-initvar*)))
242    
243    (deftest class-08.1
244      (let* ((*class-08-s2-initvar* 'x)
245             (c (make-instance 'class-08)))
246        (values
247         (slot-value c 's1)
248         (slot-value c 's2)))
249      0 x)
250    
251    ;;;;
252    
253    (declaim (special *class-09-s2-initvar*))
254    
255    (defclass class-09 ()
256      ((s1 :initform 0 :initarg :s1)
257       (s2 :initform *class-09-s2-initvar* :initarg :s2)))
258    
259    (deftest class-09.1
260      (let* ((*class-09-s2-initvar* 'x)
261             (c (make-instance 'class-09)))
262        (values
263         (slot-value c 's1)
264         (slot-value c 's2)))
265      0 x)
266    
267    (deftest class-09.2
268      (let* ((*class-09-s2-initvar* 'x)
269             (c (make-instance 'class-09 :s1 1)))
270        (values
271         (slot-value c 's1)
272         (slot-value c 's2)))
273      1 x)
274    
275    (deftest class-09.3
276      (let* ((c (make-instance 'class-09 :s2 'a)))
277        (values
278         (slot-value c 's1)
279         (slot-value c 's2)))
280      0 a)
281    
282    (deftest class-09.4
283      (let* ((c (make-instance 'class-09 :s2 'a :s1 10 :s1 'bad :s2 'bad)))
284        (values
285         (slot-value c 's1)
286         (slot-value c 's2)))
287      10 a)
288    
289    ;;;;
290    
291    (declaim (special *class-10-s1-initvar*))
292    
293    (defclass class-10 ()
294      ((s1 :initform (incf *class-10-s1-initvar*) :initarg :s1)))
295    
296    (deftest class-10.1
297      (let* ((*class-10-s1-initvar* 0)
298             (c (make-instance 'class-10)))
299        (values
300         *class-10-s1-initvar*
301         (slot-value c 's1)))
302      1 1)
303    
304    (deftest class-10.2
305      (let* ((*class-10-s1-initvar* 0)
306             (c (make-instance 'class-10 :s1 10)))
307        (values
308         *class-10-s1-initvar*
309         (slot-value c 's1)))
310      0 10)
311    
312    ;;;;
313    
314    (let ((x 7))
315      (defclass class-11 ()
316        ((s1 :initform x :initarg :s1))))
317    
318    (deftest class-11.1
319      (slot-value (make-instance 'class-11) 's1)
320      7)
321    
322    (deftest class-11.2
323      (slot-value (make-instance 'class-11 :s1 100) 's1)
324      100)
325    
326    ;;;
327    
328    (flet ((%f () 'x))
329      (defclass class-12 ()
330        ((s1 :initform (%f) :initarg :s1))))
331    
332    (deftest class-12.1
333      (slot-value (make-instance 'class-12) 's1)
334      x)
335    
336    (deftest class-12.2
337      (slot-value (make-instance 'class-12 :s1 'y) 's1)
338      y)
339    
340    
341    
342        
343        

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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