1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-10 15:50:50 +02:00

Updated tests

This commit is contained in:
Mikael Djurfeldt 2003-04-17 19:16:27 +00:00
parent 95f2bb326c
commit 3ad4ed2c8b

View file

@ -222,22 +222,29 @@
(eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module))))
(with-test-prefix "object comparison"
(pass-if "eqv?"
(pass-if "default method"
(eval '(begin
(define-class <c> ()
(x #:accessor x #:init-keyword #:x)
(y #:accessor y #:init-keyword #:y))
(define-method (eqv? (a <c>) (b <c>))
(equal? (x a) (x b)))
(define o1 (make <c> #:x '(1) #:y '(2)))
(define o2 (make <c> #:x '(1) #:y '(3)))
(define o3 (make <c> #:x '(4) #:y '(3)))
(define o4 (make <c> #:x '(4) #:y '(3)))
(not (eqv? o1 o2)))
(current-module)))
(pass-if "eqv?"
(eval '(begin
(define-method (eqv? (a <c>) (b <c>))
(equal? (x a) (x b)))
(eqv? o1 o2))
(current-module)))
(pass-if "not eqv?"
(eval '(not (eqv? o2 o3))
(current-module)))
(pass-if "transfer eqv? => equal?"
(eval '(equal? o1 o2)
(current-module)))
(pass-if "equal?"
(eval '(begin
(define-method (equal? (a <c>) (b <c>))