From 61951a9a9a5b96b84007de97f5d03a0638efee0b Mon Sep 17 00:00:00 2001
From: Mikael Djurfeldt <djurfeldt@nada.kth.se>
Date: Thu, 17 Apr 2003 18:48:27 +0000
Subject: [PATCH] *** empty log message ***

---
 oop/ChangeLog               |  3 ++-
 test-suite/tests/goops.test | 39 ++++++++++++++++++++++++++++---------
 2 files changed, 32 insertions(+), 10 deletions(-)

diff --git a/oop/ChangeLog b/oop/ChangeLog
index b7c621c99..415f419d8 100644
--- a/oop/ChangeLog
+++ b/oop/ChangeLog
@@ -1,6 +1,7 @@
 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.
 
 2003-04-15  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index a5cf919c8..05583678e 100644
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -221,22 +221,43 @@
 	  (current-module))
     (eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module))))
 
-(with-test-prefix "equal?"
-  (pass-if "equal"
+(with-test-prefix "object comparison"
+  (pass-if "eqv?"
 	   (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)))
+		    (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>))
 		      (equal? (y a) (y b)))
-		    (define o1 (make <c> #:x '(1) #:y '(3)))
-		    (define o2 (make <c> #:x '(2) #:y '(3)))
-		    (define o3 (make <c> #:x '(2) #:y '(4)))
-		    (equal? o1 o2))
+		    (equal? o2 o3))
 		 (current-module)))
-  (pass-if "not equal"
-	   (eval '(not (equal? o2 o3))
-		 (current-module))))
+  (pass-if "not equal?"
+	   (eval '(not (equal? o1 o2))
+		 (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))