mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 13:00:26 +02:00
Code Activity

*** empty log message ***

Browse source
This commit is contained in:
Mikael Djurfeldt 2003-04-17 18:48:27 +00:00
parent e672dd0208
commit 61951a9a9a
2 changed files with 32 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

3
oop/ChangeLog
View file

@ -1,6 +1,7 @@
2003-04-17 Mikael Djurfeldt <djurfeldt@nada.kth.se> 2003-04-17 Mikael Djurfeldt <djurfeldt@nada.kth.se>
* goops.scm (equal?): Provide default method for `equal?'. * goops.scm (eqv?, equal?): Provide default methods for `eqv?' and
`equal?'.
(compute-getters-n-setters): Check for bad init-thunks. (compute-getters-n-setters): Check for bad init-thunks.
2003-04-15 Mikael Djurfeldt <djurfeldt@nada.kth.se> 2003-04-15 Mikael Djurfeldt <djurfeldt@nada.kth.se>

39
test-suite/tests/goops.test
View file

@ -221,22 +221,43 @@
(current-module)) (current-module))
(eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module)))) (eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module))))
(with-test-prefix "equal?" (with-test-prefix "object comparison"
(pass-if "equal" (pass-if "eqv?"
(eval '(begin (eval '(begin
(define-class <c> () (define-class <c> ()
(x #:accessor x #:init-keyword #:x) (x #:accessor x #:init-keyword #:x)
(y #:accessor y #:init-keyword #:y)) (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)))
(eqv? o1 o2))
(current-module)))
(pass-if "not eqv?"
(eval '(not (eqv? o2 o3))
(current-module)))
(pass-if "equal?"
(eval '(begin
(define-method (equal? (a <c>) (b <c>)) (define-method (equal? (a <c>) (b <c>))
(equal? (y a) (y b))) (equal? (y a) (y b)))
(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))
(current-module))) (current-module)))
(pass-if "not equal" (pass-if "not equal?"
(eval '(not (equal? o2 o3)) (eval '(not (equal? o1 o2))
(current-module)))) (current-module)))
(pass-if "="
(eval '(begin
(define-method (= (a <c>) (b <c>))
(and (equal? (x a) (x b))
(equal? (y a) (y b))))
(= o3 o4))
(current-module)))
(pass-if "not ="
(eval '(not (= o1 o2))
(current-module)))
)
(use-modules (oop goops active-slot)) (use-modules (oop goops active-slot))