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 "eqv?" |
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-method (eqv? (a <c>) (b <c>)) |
231 |
|
(equal? (x a) (x b))) |
232 |
|
(define o1 (make <c> #:x '(1) #:y '(2))) |
233 |
|
(define o2 (make <c> #:x '(1) #:y '(3))) |
234 |
|
(define o3 (make <c> #:x '(4) #:y '(3))) |
235 |
|
(define o4 (make <c> #:x '(4) #:y '(3))) |
236 |
|
(eqv? o1 o2)) |
237 |
|
(current-module))) |
238 |
|
(pass-if "not eqv?" |
239 |
|
(eval '(not (eqv? o2 o3)) |
240 |
|
(current-module))) |
241 |
|
(pass-if "equal?" |
242 |
|
(eval '(begin |
243 |
(define-method (equal? (a <c>) (b <c>)) |
(define-method (equal? (a <c>) (b <c>)) |
244 |
(equal? (y a) (y b))) |
(equal? (y a) (y b))) |
245 |
(define o1 (make <c> #:x '(1) #:y '(3))) |
(equal? o2 o3)) |
246 |
(define o2 (make <c> #:x '(2) #:y '(3))) |
(current-module))) |
247 |
(define o3 (make <c> #:x '(2) #:y '(4))) |
(pass-if "not equal?" |
248 |
(equal? o1 o2)) |
(eval '(not (equal? o1 o2)) |
249 |
(current-module))) |
(current-module))) |
250 |
(pass-if "not equal" |
(pass-if "=" |
251 |
(eval '(not (equal? o2 o3)) |
(eval '(begin |
252 |
(current-module)))) |
(define-method (= (a <c>) (b <c>)) |
253 |
|
(and (equal? (x a) (x b)) |
254 |
|
(equal? (y a) (y b)))) |
255 |
|
(= o3 o4)) |
256 |
|
(current-module))) |
257 |
|
(pass-if "not =" |
258 |
|
(eval '(not (= o1 o2)) |
259 |
|
(current-module))) |
260 |
|
) |
261 |
|
|
262 |
(use-modules (oop goops active-slot)) |
(use-modules (oop goops active-slot)) |
263 |
|
|