/[guile]/guile/guile-core/test-suite/tests/goops.test
ViewVC logotype

Diff of /guile/guile-core/test-suite/tests/goops.test

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

revision 1.2.2.2 by mdj, Thu Apr 17 18:48:27 2003 UTC revision 1.2.2.3 by mdj, Thu Apr 17 19:16:27 2003 UTC
# Line 222  Line 222 
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 "object comparison"  (with-test-prefix "object comparison"
225    (pass-if "eqv?"    (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))
                     (define-method (eqv? (a <c>) (b <c>))  
                       (equal? (x a) (x b)))  
230                      (define o1 (make <c> #:x '(1) #:y '(2)))                      (define o1 (make <c> #:x '(1) #:y '(2)))
231                      (define o2 (make <c> #:x '(1) #:y '(3)))                      (define o2 (make <c> #:x '(1) #:y '(3)))
232                      (define o3 (make <c> #:x '(4) #:y '(3)))                      (define o3 (make <c> #:x '(4) #:y '(3)))
233                      (define o4 (make <c> #:x '(4) #:y '(3)))                      (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))                      (eqv? o1 o2))
241                   (current-module)))                   (current-module)))
242    (pass-if "not eqv?"    (pass-if "not eqv?"
243             (eval '(not (eqv? o2 o3))             (eval '(not (eqv? o2 o3))
244                   (current-module)))                   (current-module)))
245      (pass-if "transfer eqv? => equal?"
246               (eval '(equal? o1 o2)
247                     (current-module)))
248    (pass-if "equal?"    (pass-if "equal?"
249             (eval '(begin             (eval '(begin
250                      (define-method (equal? (a <c>) (b <c>))                      (define-method (equal? (a <c>) (b <c>))

Legend:
Removed from v.1.2.2.2  
changed lines
  Added in v.1.2.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26