/[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.1 by mdj, Thu Apr 17 17:50:57 2003 UTC revision 1.2.2.2 by mdj, Thu Apr 17 18:48:27 2003 UTC
# Line 221  Line 221 
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    

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

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