/[gcl]/gcl/ansi-tests/shared-initialize.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/shared-initialize.lsp

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

revision 1.2 by pfdietz, Fri May 2 05:22:00 2003 UTC revision 1.3 by pfdietz, Fri May 2 11:51:47 2003 UTC
# Line 11  Line 11 
11     (c :initarg :c)     (c :initarg :c)
12     d))     d))
13    
14  (deftest shared-initialize.1  (deftest shared-initialize.1.1
15    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
16      (values      (values
17       (map-slot-boundp* obj '(a b c d))       (map-slot-boundp* obj '(a b c d))
# Line 23  Line 23 
23    (t t t nil)    (t t t nil)
24    (1 3 14))    (1 3 14))
25    
26  (deftest shared-initialize.2  (deftest shared-initialize.1.2
27    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
28      (values      (values
29       (map-slot-boundp* obj '(a b c d))       (map-slot-boundp* obj '(a b c d))
# Line 33  Line 33 
33    t    t
34    (nil nil nil nil))    (nil nil nil nil))
35    
36  (deftest shared-initialize.3  (deftest shared-initialize.1.3
37    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
38      (values      (values
39       (map-slot-boundp* obj '(a b c d))       (map-slot-boundp* obj '(a b c d))
# Line 45  Line 45 
45    (t nil nil nil)    (t nil nil nil)
46    1)    1)
47    
48  (deftest shared-initialize.4  (deftest shared-initialize.1.4
49    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
50      (values      (values
51       (map-slot-boundp* obj '(a b c d))       (map-slot-boundp* obj '(a b c d))
# Line 57  Line 57 
57    (t nil nil nil)    (t nil nil nil)
58    1)    1)
59    
60  (deftest shared-initialize.5  (deftest shared-initialize.1.5
61    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
62      (values      (values
63       (map-slot-boundp* obj '(a b c d))       (map-slot-boundp* obj '(a b c d))
# Line 69  Line 69 
69    (t nil nil nil)    (t nil nil nil)
70    1)    1)
71    
72  (deftest shared-initialize.6  (deftest shared-initialize.1.6
73    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
74      (values      (values
75       (map-slot-boundp* obj '(a b c d))       (map-slot-boundp* obj '(a b c d))
# Line 81  Line 81 
81    (t nil nil nil)    (t nil nil nil)
82    x)    x)
83    
84  (deftest shared-initialize.7  (deftest shared-initialize.1.7
85    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
86      (values      (values
87       (map-slot-boundp* obj '(a b c d))       (map-slot-boundp* obj '(a b c d))
# Line 94  Line 94 
94    (t t nil nil)    (t t nil nil)
95    x y)    x y)
96    
97  (deftest shared-initialize.8  (deftest shared-initialize.1.8
98    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
99      (values      (values
100       (map-slot-boundp* obj '(a b c d))       (map-slot-boundp* obj '(a b c d))
# Line 108  Line 108 
108    (t t t nil)    (t t t nil)
109    x 10 100)    x 10 100)
110    
111  (deftest shared-initialize.9  (deftest shared-initialize.1.9
112    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))    (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
113      (values      (values
114       (map-slot-boundp* obj '(a b c d))       (map-slot-boundp* obj '(a b c d))
# Line 123  Line 123 
123    (t t t nil)    (t t t nil)
124    5 37 213)    5 37 213)
125    
126    (deftest shared-initialize.1.10
127      (let ((obj (allocate-instance (find-class 'shared-init-class-01))))
128        (setf (slot-value obj 'a) 1000)
129        (values
130         (map-slot-boundp* obj '(a b c d))
131         (eqt obj (shared-initialize obj '(a)))
132         (map-slot-boundp* obj '(a b c d))
133         (slot-value obj 'a)))
134      (t nil nil nil)
135      t
136      (t nil nil nil)
137      1000)
138    
139  ;;; Initforms in the lexical environment of the defclass  ;;; Initforms in the lexical environment of the defclass
140    
# Line 141  Line 153 
153         (d))         (d))
154        (:default-initargs :c 100))))        (:default-initargs :c 100))))
155    
156  (deftest shared-initialize.10  (deftest shared-initialize.2.1
157    (progn    (progn
158      (funcall *shared-init-var-02-init* 5 10)      (funcall *shared-init-var-02-init* 5 10)
159      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))
# Line 158  Line 170 
170    (t t nil nil)    (t t nil nil)
171    (6 11))    (6 11))
172    
173  (deftest shared-initialize.11  (deftest shared-initialize.2.2
174    (progn    (progn
175      (funcall *shared-init-var-02-init* 5 10)      (funcall *shared-init-var-02-init* 5 10)
176      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))
# Line 172  Line 184 
184    (nil nil nil nil)    (nil nil nil nil)
185    (5 10))    (5 10))
186    
187  (deftest shared-initialize.12  (deftest shared-initialize.2.3
188    (progn    (progn
189      (funcall *shared-init-var-02-init* 5 10)      (funcall *shared-init-var-02-init* 5 10)
190      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))
# Line 188  Line 200 
200    (t nil nil nil)    (t nil nil nil)
201    (6 10))    (6 10))
202    
203  (deftest shared-initialize.13  (deftest shared-initialize.2.4
204    (progn    (progn
205      (funcall *shared-init-var-02-init* 5 10)      (funcall *shared-init-var-02-init* 5 10)
206      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))
# Line 204  Line 216 
216    (nil t nil nil)    (nil t nil nil)
217    (5 11))    (5 11))
218    
219  (deftest shared-initialize.14  (deftest shared-initialize.2.5
220    (progn    (progn
221      (funcall *shared-init-var-02-init* 5 10)      (funcall *shared-init-var-02-init* 5 10)
222      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))
# Line 220  Line 232 
232    (t t nil nil)    (t t nil nil)
233    (5 10))    (5 10))
234    
235  (deftest shared-initialize.15  (deftest shared-initialize.2.6
236    (progn    (progn
237      (funcall *shared-init-var-02-init* 5 10)      (funcall *shared-init-var-02-init* 5 10)
238      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))      (let ((obj (allocate-instance (find-class 'shared-init-class-02))))
# Line 254  Line 266 
266    (when c-p (setf (slot-value obj 'c) c))    (when c-p (setf (slot-value obj 'c) c))
267    obj)    obj)
268    
269  (deftest shared-initialize.16  (deftest shared-initialize.3.1
270    (let ((obj (make-shared-init-class-03)))    (let ((obj (make-shared-init-class-03)))
271      (values      (values
272       (eqt obj (shared-initialize obj nil :a 1 :b 5 :c 19))       (eqt obj (shared-initialize obj nil :a 1 :b 5 :c 19))
# Line 264  Line 276 
276    t 1 5 19)    t 1 5 19)
277    
278    
279    ;;; Inheritance
280    
281    (defclass shared-init-class-04a ()
282      ((a :initform 4 :initarg :a)
283       (b :initform 8 :initarg :b)))
284    
285    (defclass shared-init-class-04b (shared-init-class-04a)
286      ((c :initform 17 :initarg :c) d)
287      (:default-initargs :a 1))
288    
289    (deftest shared-initialize.4.1
290      (let ((obj (allocate-instance (find-class 'shared-init-class-04b))))
291        (values
292         (eqt obj (shared-initialize obj nil :a 'x))
293         (map-slot-boundp* obj '(a b c d))
294         (slot-value obj 'a)))
295      t
296      (t nil nil nil)
297      x)
298    
299    (deftest shared-initialize.4.2
300      (let ((obj (allocate-instance (find-class 'shared-init-class-04b))))
301        (values
302         (eqt obj (shared-initialize obj nil))
303         (map-slot-boundp* obj '(a b c d))))
304      t
305      (nil nil nil nil))
306    
307    (deftest shared-initialize.4.3
308      (let ((obj (allocate-instance (find-class 'shared-init-class-04b))))
309        (values
310         (eqt obj (shared-initialize obj t))
311         (map-slot-boundp* obj '(a b c d))
312         (map-slot-value obj '(a b c))))
313      t
314      (t t t nil)
315      (4 8 17))
316    
317    (deftest shared-initialize.4.4
318      (let ((obj (allocate-instance (find-class 'shared-init-class-04b))))
319        (values
320         (eqt obj (shared-initialize obj '(a c)))
321         (map-slot-boundp* obj '(a b c d))
322         (map-slot-value obj '(a c))))
323      t
324      (t nil t nil)
325      (4 17))
326    
327    (deftest shared-initialize.4.5
328      (let ((obj (allocate-instance (find-class 'shared-init-class-04b))))
329        (values
330         (eqt obj (shared-initialize obj '(a c) :c 81))
331         (map-slot-boundp* obj '(a b c d))
332         (map-slot-value obj '(a c))))
333      t
334      (t nil t nil)
335      (4 81))
336    
337    (deftest shared-initialize.4.6
338      (let ((obj (allocate-instance (find-class 'shared-init-class-04b))))
339        (values
340         (eqt obj (shared-initialize obj '(a c) :a 91))
341         (map-slot-boundp* obj '(a b c d))
342         (map-slot-value obj '(a c))))
343      t
344      (t nil t nil)
345      (91 17))
346    

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

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