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

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

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

revision 1.1 by pfdietz, Sat Apr 26 13:51:11 2003 UTC revision 1.2 by pfdietz, Sat Apr 26 14:38:08 2003 UTC
# Line 101  Line 101 
101    (nil nil)    (nil nil)
102    (nil nil nil nil))    (nil nil nil nil))
103    
     
       
104    ;;;
105    
106    (defclass class-0205a ()
107      ((a :initform 'x)
108       (b :initform 'y)
109       c))
110    
111    (defclass class-0205b (class-0205a)
112      ((a :initform 'z)
113       b
114       (c :initform 'w)))
115    
116    (deftest class-0205a.1
117      (let ((c (make-instance 'class-0205a)))
118        (values
119         (slot-value c 'a)
120         (slot-value c 'b)
121         (slot-boundp c 'c)))
122      x y nil)
123    
124    (deftest class-0205b.1
125      (let ((c (make-instance 'class-0205b)))
126        (map-slot-value c '(a b c)))
127      (z y w))
128    
129    ;;;
130    
131    (defclass class-0206a ()
132      ((a :allocation :instance)
133       (b :allocation :class)))
134    
135    (defclass class-0206b (class-0206a)
136      ((a :allocation :class)
137       (b :allocation :instance)))
138    
139    (deftest class-0206.1
140      (let ((c1 (make-instance 'class-0206a))      
141            (c2 (make-instance 'class-0206b)))
142        (values
143         (map-slot-boundp* c1 '(a b))
144         (map-slot-boundp* c2 '(a b))
145         (setf (slot-value c1 'a) 'x)
146         (setf (slot-value c1 'b) 'y)
147         (map-slot-boundp* c1 '(a b))
148         (map-slot-boundp* c2 '(a b))
149         (map-slot-value c1 '(a b))
150         (progn (slot-makunbound c1 'a)
151                (slot-makunbound c1 'b)
152                (setf (slot-value c2 'a) 'x))
153         (setf (slot-value c2 'b) 'y)
154         (map-slot-boundp* c1 '(a b))
155         (map-slot-boundp* c2 '(a b))
156         (map-slot-value c2 '(a b))
157         (progn (slot-makunbound c2 'a)
158                (slot-makunbound c2 'b)
159                nil)))
160      (nil nil) (nil nil)
161      x y
162      (t t) (nil nil)
163      (x y)
164      x y
165      (nil nil) (t t)
166      (x y)
167      nil)
168    
169    ;;;
170    
171    (defclass class-0207a ()
172      ((a :allocation :class)))
173    
174    (defclass class-0207b (class-0207a)
175      ((a :allocation :instance)))
176    
177    (defclass class-0207c (class-0207b)
178      ((a :allocation :class)))
179    
180    (deftest class-0207.1
181      (let ((c1 (make-instance 'class-0207a))
182            (c2 (make-instance 'class-0207b))
183            (c3 (make-instance 'class-0207c)))
184        (slot-makunbound c1 'a)
185        (slot-makunbound c2 'a)
186        (slot-makunbound c3 'a)
187        (values
188         (setf (slot-value c1 'a) 'x)
189         (slot-boundp* c1 'a)
190         (slot-boundp* c2 'a)
191         (slot-boundp* c3 'a)
192         (slot-value c1 'a)
193         (setf (slot-value c2 'a) 'y)
194         (slot-boundp* c1 'a)
195         (slot-boundp* c2 'a)
196         (slot-boundp* c3 'a)
197         (slot-value c1 'a)
198         (slot-value c2 'a)
199         (setf (slot-value c3 'a) 'z)
200         (slot-boundp* c1 'a)
201         (slot-boundp* c2 'a)
202         (slot-boundp* c3 'a)
203         (slot-value c1 'a)
204         (slot-value c2 'a)
205         (slot-value c3 'a)))
206      x
207      t nil nil
208      x
209      y
210      t t nil
211      x y
212      z
213      t t t
214      x y z)

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