136 |
(pass-if "overwriting a binding to a non-class" |
(pass-if "overwriting a binding to a non-class" |
137 |
(eval '(define <foo> #f) (current-module)) |
(eval '(define <foo> #f) (current-module)) |
138 |
(eval '(define-class <foo> ()) (current-module)) |
(eval '(define-class <foo> ()) (current-module)) |
139 |
(eval '(is-a? <foo> <class>) (current-module))))) |
(eval '(is-a? <foo> <class>) (current-module))) |
140 |
|
|
141 |
|
(expect-fail "bad init-thunk" |
142 |
|
(catch #t |
143 |
|
(lambda () |
144 |
|
(eval '(define-class <foo> () |
145 |
|
(x #:init-thunk (lambda (x) 1))) |
146 |
|
(current-module)) |
147 |
|
#t) |
148 |
|
(lambda args |
149 |
|
#f))) |
150 |
|
)) |
151 |
|
|
152 |
(with-test-prefix "defining generics" |
(with-test-prefix "defining generics" |
153 |
|
|
221 |
(current-module)) |
(current-module)) |
222 |
(eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module)))) |
(eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module)))) |
223 |
|
|
224 |
(with-test-prefix "equal?" |
(with-test-prefix "object comparison" |
225 |
(pass-if "equal" |
(pass-if "default method" |
226 |
(eval '(begin |
(eval '(begin |
227 |
(define-class <c> () |
(define-class <c> () |
228 |
(x #:accessor x #:init-keyword #:x) |
(x #:accessor x #:init-keyword #:x) |
229 |
(y #:accessor y #:init-keyword #:y)) |
(y #:accessor y #:init-keyword #:y)) |
230 |
|
(define o1 (make <c> #:x '(1) #:y '(2))) |
231 |
|
(define o2 (make <c> #:x '(1) #:y '(3))) |
232 |
|
(define o3 (make <c> #:x '(4) #:y '(3))) |
233 |
|
(define o4 (make <c> #:x '(4) #:y '(3))) |
234 |
|
(not (eqv? o1 o2))) |
235 |
|
(current-module))) |
236 |
|
(pass-if "eqv?" |
237 |
|
(eval '(begin |
238 |
|
(define-method (eqv? (a <c>) (b <c>)) |
239 |
|
(equal? (x a) (x b))) |
240 |
|
(eqv? o1 o2)) |
241 |
|
(current-module))) |
242 |
|
(pass-if "not eqv?" |
243 |
|
(eval '(not (eqv? o2 o3)) |
244 |
|
(current-module))) |
245 |
|
(pass-if "transfer eqv? => equal?" |
246 |
|
(eval '(equal? o1 o2) |
247 |
|
(current-module))) |
248 |
|
(pass-if "equal?" |
249 |
|
(eval '(begin |
250 |
(define-method (equal? (a <c>) (b <c>)) |
(define-method (equal? (a <c>) (b <c>)) |
251 |
(equal? (y a) (y b))) |
(equal? (y a) (y b))) |
252 |
(define o1 (make <c> #:x '(1) #:y '(3))) |
(equal? o2 o3)) |
|
(define o2 (make <c> #:x '(2) #:y '(3))) |
|
|
(define o3 (make <c> #:x '(2) #:y '(4))) |
|
|
(equal? o1 o2)) |
|
253 |
(current-module))) |
(current-module))) |
254 |
(pass-if "not equal" |
(pass-if "not equal?" |
255 |
(eval '(not (equal? o2 o3)) |
(eval '(not (equal? o1 o2)) |
256 |
(current-module)))) |
(current-module))) |
257 |
|
(pass-if "=" |
258 |
|
(eval '(begin |
259 |
|
(define-method (= (a <c>) (b <c>)) |
260 |
|
(and (equal? (x a) (x b)) |
261 |
|
(equal? (y a) (y b)))) |
262 |
|
(= o3 o4)) |
263 |
|
(current-module))) |
264 |
|
(pass-if "not =" |
265 |
|
(eval '(not (= o1 o2)) |
266 |
|
(current-module))) |
267 |
|
) |
268 |
|
|
269 |
(use-modules (oop goops active-slot)) |
(use-modules (oop goops active-slot)) |
270 |
|
|
299 |
before-set! 2 before-ref after-ref after-set! 2 2))) |
before-set! 2 before-ref after-ref after-set! 2 2))) |
300 |
(current-module)))) |
(current-module)))) |
301 |
|
|
302 |
|
(use-modules (oop goops composite-slot)) |
303 |
|
|
304 |
|
(with-test-prefix "composite-slot" |
305 |
|
(pass-if "creating instance with propagated slot" |
306 |
|
(eval '(begin |
307 |
|
(define-class <a> () |
308 |
|
(x #:accessor x #:init-keyword #:x) |
309 |
|
(y #:accessor y #:init-keyword #:y)) |
310 |
|
(define-class <c> () |
311 |
|
(o1 #:accessor o1 #:init-form (make <a> #:x 1 #:y 2)) |
312 |
|
(o2 #:accessor o2 #:init-form (make <a> #:x 3 #:y 4)) |
313 |
|
(x #:accessor x |
314 |
|
#:allocation #:propagated |
315 |
|
#:propagate-to '(o1 (o2 y))) |
316 |
|
#:metaclass <composite-class>) |
317 |
|
(define o (make <c>)) |
318 |
|
(is-a? o <c>)) |
319 |
|
(current-module))) |
320 |
|
(pass-if "reading propagated slot" |
321 |
|
(eval '(= (x o) 1) (current-module))) |
322 |
|
(pass-if "writing propagated slot" |
323 |
|
(eval '(begin |
324 |
|
(set! (x o) 5) |
325 |
|
(and (= (x (o1 o)) 5) |
326 |
|
(= (y (o1 o)) 2) |
327 |
|
(= (x (o2 o)) 3) |
328 |
|
(= (y (o2 o)) 5))) |
329 |
|
(current-module)))) |