Subject: [PATCH] test-suite: eq-ness of numbers, characters is unspecified

From: Daniel Hartwig <[email-masked]>
Date: Tue, 19 Feb 2013 09:55:14 +0800

* test-suite/tests/00-socket.test:
* test-suite/tests/alist.test:
* test-suite/tests/elisp.test:
* test-suite/tests/encoding-iso88591.test:
* test-suite/tests/encoding-iso88597.test:
* test-suite/tests/encoding-utf8.test:
* test-suite/tests/hash.test:
* test-suite/tests/i18n.test:
* test-suite/tests/modules.test:
* test-suite/tests/ports.test:
* test-suite/tests/srfi-35.test: Make tests use eqv? instead of eq? when
  comparing numbers, characters.  Checked also for similar uses of
  assq[-ref].

* test-suite/tests/vlist.test ("vhash-delete honors HASH"): Change test
  to use eqv-ness, not eq-ness, which should not impact its purpose as
  these two are equivalent for strings.
---
 test-suite/tests/00-socket.test         |    6 +++---
 test-suite/tests/alist.test             |    4 ++--
 test-suite/tests/elisp.test             |    8 ++++----
 test-suite/tests/encoding-iso88591.test |   10 +++++-----
 test-suite/tests/encoding-iso88597.test |   10 +++++-----
 test-suite/tests/encoding-utf8.test     |   10 +++++-----
 test-suite/tests/hash.test              |    6 +-----
 test-suite/tests/i18n.test              |   20 ++++++++++----------
 test-suite/tests/modules.test           |    2 +-
 test-suite/tests/ports.test             |    8 ++++----
 test-suite/tests/srfi-35.test           |   16 ++++++++--------
 test-suite/tests/vlist.test             |    8 ++++----
 12 files changed, 52 insertions(+), 56 deletions(-)

diff --git a/test-suite/tests/00-socket.test b/test-suite/tests/00-socket.test
index 6deb285..8079cf5 100644
--- a/test-suite/tests/00-socket.test
+++ b/test-suite/tests/00-socket.test
@@ -336,7 +336,7 @@
 	  (if (not server-pid)
 	      (throw 'unresolved)
 	      (let ((status (cdr (waitpid server-pid))))
-		(eq? 0 (status:exit-val status)))))
+		(eqv? 0 (status:exit-val status)))))
 
 	(false-if-exception (delete-file path))
 
@@ -409,7 +409,7 @@
           (if (not server-pid)
               (throw 'unresolved)
               (let ((status (cdr (waitpid server-pid))))
-                (eq? 0 (status:exit-val status)))))
+                (eqv? 0 (status:exit-val status)))))
 
         (false-if-exception (delete-file path))
 
@@ -505,7 +505,7 @@
 	  (if (not server-pid)
 	      (throw 'unresolved)
 	      (let ((status (cdr (waitpid server-pid))))
-		(eq? 0 (status:exit-val status)))))
+		(eqv? 0 (status:exit-val status)))))
 
 	#t)))
 
diff --git a/test-suite/tests/alist.test b/test-suite/tests/alist.test
index 699c10e..0ed5d22 100644
--- a/test-suite/tests/alist.test
+++ b/test-suite/tests/alist.test
@@ -124,8 +124,8 @@
   (pass-if "assoc-ref"
 	   (let ((x (assoc-ref b "one")))
 	     (and (list? x)
-		  (eq? (car x) 2)
-		  (eq? (cadr x) 3))))
+		  (eqv? (car x) 2)
+		  (eqv? (cadr x) 3))))

   (pass-if-not "assoc-ref not" (assoc-ref a 'testing))
diff --git a/test-suite/tests/elisp.test b/test-suite/tests/elisp.test
index 41800fd..baf8546 100644
--- a/test-suite/tests/elisp.test
+++ b/test-suite/tests/elisp.test
@@ -124,8 +124,8 @@
         (with-fluids* (cons f (cons g #nil))
                       '(3 4)
                       (lambda ()
-                        (and (eq? (fluid-ref f) 3)
-                             (eq? (fluid-ref g) 4))))))
+                        (and (eqv? (fluid-ref f) 3)
+                             (eqv? (fluid-ref g) 4))))))
 
     (pass-if "append!"
       (let ((a (copy-tree '(1 2 3)))
@@ -150,11 +150,11 @@
               '(5 4 3 2 1)))            ; Ditto.
 
     (pass-if "list-ref"
-      (eq? (list-ref '(0 1 2 3 4 . #nil) 4) 4))
+      (eqv? (list-ref '(0 1 2 3 4 . #nil) 4) 4))
 
     (pass-if-exception "list-ref"
                        exception:out-of-range
-                       (eq? (list-ref '(0 1 2 3 4 . #nil) 6) 6))
+                       (eqv? (list-ref '(0 1 2 3 4 . #nil) 6) 6))
 
     (pass-if "list-set!"
       (let ((l (copy-tree '(0 1 2 3 4 . #nil))))
diff --git a/test-suite/tests/encoding-iso88591.test b/test-suite/tests/encoding-iso88591.test
index f7bec5e..8265ff1 100644
--- a/test-suite/tests/encoding-iso88591.test
+++ b/test-suite/tests/encoding-iso88591.test
@@ -106,16 +106,16 @@
 (with-test-prefix "string length"
 
   (pass-if "�ltima"
-	   (eq? (string-length s1) 6))
+	   (eqv? (string-length s1) 6))
     
   (pass-if "c�dula"
-	   (eq? (string-length s2) 6))
+	   (eqv? (string-length s2) 6))
 
   (pass-if "a�os"
-	   (eq? (string-length s3) 4))
+	   (eqv? (string-length s3) 4))
 
   (pass-if "�C�mo?"
-	   (eq? (string-length s4) 6)))
+	   (eqv? (string-length s4) 6)))
 
 (with-test-prefix "internal encoding"
 
@@ -168,7 +168,7 @@
   (pass-if "1"
 	   (let ((� 1)
 		 (� 2))
-	     (eq? (+ � �) 3))))
+	     (eqv? (+ � �) 3))))
 
 (with-test-prefix "output errors"
 
diff --git a/test-suite/tests/encoding-iso88597.test b/test-suite/tests/encoding-iso88597.test
index f116194..a577b2a 100644
--- a/test-suite/tests/encoding-iso88597.test
+++ b/test-suite/tests/encoding-iso88597.test
@@ -95,16 +95,16 @@
 (with-test-prefix "string length"
 
   (pass-if "s1"
-	   (eq? (string-length s1) 4))
+	   (eqv? (string-length s1) 4))
   
   (pass-if "s2"
-	   (eq? (string-length s2) 3))
+	   (eqv? (string-length s2) 3))
   
   (pass-if "s3"
-	   (eq? (string-length s3) 8))
+	   (eqv? (string-length s3) 8))
   
   (pass-if "s4" 
-	   (eq? (string-length s4) 3)))
+	   (eqv? (string-length s4) 3)))
 
 (with-test-prefix "internal encoding"
 
@@ -157,7 +157,7 @@
   (pass-if "1"
 	   (let ((� 1)
 		 (� 2))
-	     (eq? (+ � �) 3))))
+	     (eqv? (+ � �) 3))))
 
 (with-test-prefix "output errors"
 
diff --git a/test-suite/tests/encoding-utf8.test b/test-suite/tests/encoding-utf8.test
index 966a04d..1de3fa7 100644
--- a/test-suite/tests/encoding-utf8.test
+++ b/test-suite/tests/encoding-utf8.test
@@ -126,16 +126,16 @@
 (with-test-prefix "string length"
 
   (pass-if "última"
-	   (eq? (string-length s1) 6))
+	   (eqv? (string-length s1) 6))
     
   (pass-if "cédula"
-	   (eq? (string-length s2) 6))
+	   (eqv? (string-length s2) 6))
 
   (pass-if "años"
-	   (eq? (string-length s3) 4))
+	   (eqv? (string-length s3) 4))
 
   (pass-if "羅生門"
-	   (eq? (string-length s4) 3)))
+	   (eqv? (string-length s4) 3)))
 
 (with-test-prefix "internal encoding"
 
@@ -188,7 +188,7 @@
   (pass-if "1"
 	   (let ((芥川龍之介  1)
 		 (ñ 2))
-	     (eq? (+  芥川龍之介 ñ) 3))))
+	     (eqv? (+  芥川龍之介 ñ) 3))))
 
 (if (defined? 'setlocale)
     (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index cb6b5cc..3bd4004 100644
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -134,7 +134,7 @@
                                  (with-output-to-string
                                    (lambda () (write table)))))))
 
- ;; 1 and 1 are equal? and eqv? and eq?
+ ;; 1 and 1 are equal? and eqv? (but not necessarily eq?)
  (pass-if (equal? 'foo
 		  (let ((table (make-hash-table)))
 		    (hash-set! table 1 'foo)
@@ -143,10 +143,6 @@
 		  (let ((table (make-hash-table)))
 		    (hashv-set! table 1 'foo)
 		    (hashv-ref table 1))))
- (pass-if (equal? 'foo
-		  (let ((table (make-hash-table)))
-		    (hashq-set! table 1 'foo)
-		    (hashq-ref table 1))))
 
  ;; 1/2 and 2/4 are equal? and eqv? (but not necessarily eq?)
  (pass-if (equal? 'foo
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index ef08dd4..ad65b73 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -255,30 +255,30 @@
 (with-test-prefix "character mapping"
 
   (pass-if "char-locale-downcase"
-    (and (eq? #\a (char-locale-downcase #\A))
-         (eq? #\a (char-locale-downcase #\A (make-locale LC_ALL "C")))))
+    (and (eqv? #\a (char-locale-downcase #\A))
+         (eqv? #\a (char-locale-downcase #\A (make-locale LC_ALL "C")))))
 
   (pass-if "char-locale-upcase"
-    (and (eq? #\Z (char-locale-upcase #\z))
-         (eq? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))
+    (and (eqv? #\Z (char-locale-upcase #\z))
+         (eqv? #\Z (char-locale-upcase #\z (make-locale LC_ALL "C")))))
 
   (pass-if "char-locale-titlecase"
-    (and (eq? #\T (char-locale-titlecase #\t))
-	 (eq? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C")))))
+    (and (eqv? #\T (char-locale-titlecase #\t))
+	 (eqv? #\T (char-locale-titlecase #\t (make-locale LC_ALL "C")))))
 
   (pass-if "char-locale-titlecase Dž"
-    (and (eq? #\762 (char-locale-titlecase #\763))
-	 (eq? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C")))))
+    (and (eqv? #\762 (char-locale-titlecase #\763))
+	 (eqv? #\762 (char-locale-titlecase #\763 (make-locale LC_ALL "C")))))
 
   (pass-if "char-locale-upcase Turkish"
     (under-turkish-utf8-locale-or-unresolved
      (lambda ()
-       (eq? #\İ (char-locale-upcase #\i %turkish-utf8-locale)))))
+       (eqv? #\İ (char-locale-upcase #\i %turkish-utf8-locale)))))
 
   (pass-if "char-locale-downcase Turkish"
     (under-turkish-utf8-locale-or-unresolved
      (lambda ()
-       (eq? #\i (char-locale-downcase #\İ %turkish-utf8-locale))))))
+       (eqv? #\i (char-locale-downcase #\İ %turkish-utf8-locale))))))
 
 
 (with-test-prefix "string mapping"
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index 79e3c98..fb54061 100644
--- a/test-suite/tests/modules.test
+++ b/test-suite/tests/modules.test
@@ -345,7 +345,7 @@
       (set-module-binder! m (lambda args (set! invoked? #t) #f))
       (module-define! m 'something 2)
       (and invoked?
-           (eq? (module-ref m 'something) 2))))
+           (eqv? (module-ref m 'something) 2))))
 
   (pass-if "honored (ref)"
     (let ((m (make-module))
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 613d269..3729930 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -482,7 +482,7 @@
                 (display str))))
           #f)                            ; so the test really fails here
         (lambda (key subr message errno port chr)
-          (and (eq? chr #\ĉ)
+          (and (eqv? chr #\ĉ)
                (string? (strerror errno)))))))
 
   (pass-if "wrong encoding, substitute"
@@ -548,12 +548,12 @@
                      ((_ port (proc -> error))
                       (if (eq? 'substitute
                                (port-conversion-strategy port))
-                          (eq? (proc port) #\?)
+                          (eqv? (proc port) #\?)
                           (decoding-error? port (proc port))))
                      ((_ port (proc -> eof))
                       (eof-object? (proc port)))
                      ((_ port (proc -> char))
-                      (eq? (proc port) char))))
+                      (eqv? (proc port) char))))
                   (make-checks
                    (syntax-rules ()
                      ((_ port check ...)
@@ -1136,7 +1136,7 @@
         (display "This is GNU Guile.\nWelcome." p)))
     (call-with-input-file (test-file)
       (lambda (p)
-        (and (eq? #\T (read-char p))
+        (and (eqv? #\T (read-char p))
              (let ((line (port-line p))
                    (col  (port-column p)))
                (and (= line 0) (= col 1)
diff --git a/test-suite/tests/srfi-35.test b/test-suite/tests/srfi-35.test
index 6d725dc..5e4cb27 100644
--- a/test-suite/tests/srfi-35.test
+++ b/test-suite/tests/srfi-35.test
@@ -65,17 +65,17 @@
   (pass-if "condition-ref"
     (let* ((ct (make-condition-type 'chbouib &condition '(a b)))
            (c  (make-condition ct 'b 1 'a 0)))
-      (and (eq? (condition-ref c 'a) 0)
-           (eq? (condition-ref c 'b) 1))))
+      (and (eqv? (condition-ref c 'a) 0)
+           (eqv? (condition-ref c 'b) 1))))
 
   (pass-if "condition-ref with inheritance"
     (let* ((top (make-condition-type 'foo &condition '(a b)))
            (ct  (make-condition-type 'bar top '(c d)))
            (c   (make-condition ct 'b 1 'a 0 'd 3 'c 2)))
-      (and (eq? (condition-ref c 'a) 0)
-           (eq? (condition-ref c 'b) 1)
-           (eq? (condition-ref c 'c) 2)
-           (eq? (condition-ref c 'd) 3))))
+      (and (eqv? (condition-ref c 'a) 0)
+           (eqv? (condition-ref c 'b) 1)
+           (eqv? (condition-ref c 'c) 2)
+           (eqv? (condition-ref c 'd) 3))))
 
   (pass-if "extract-condition"
     (let* ((ct (make-condition-type 'chbouib &condition '(a b)))
@@ -149,8 +149,8 @@
                   (let ((c (make-condition &chbouib 'one 1 'two 2)))
                     (and (condition? c)
                          (chbouib? c)
-                         (eq? (chbouib-one c) 1)
-                         (eq? (chbouib-two c) 2))))
+                         (eqv? (chbouib-one c) 1)
+                         (eqv? (chbouib-two c) 2))))
             m)))
 
   (pass-if "condition"
diff --git a/test-suite/tests/vlist.test b/test-suite/tests/vlist.test
index d939284..a37be5e 100644
--- a/test-suite/tests/vlist.test
+++ b/test-suite/tests/vlist.test
@@ -287,12 +287,12 @@
     ;; using the supplied hash procedure, which could lead to
     ;; inconsistencies.
     (let* ((s  "hello")
-           (vh (fold vhash-consq
-                     (vhash-consq s "world" vlist-null)
+           (vh (fold vhash-consv
+                     (vhash-consv s "world" vlist-null)
                      (iota 300)
                      (iota 300))))
-      (and (vhash-assq s vh)
-           (pair? (vhash-assq s (vhash-delete 123 vh eq? hashq))))))
+      (and (vhash-assv s vh)
+           (pair? (vhash-assv s (vhash-delete 123 vh eqv? hashv))))))
 
   (pass-if "vhash-fold"
     (let* ((keys   '(a b c d e f g d h i))
-- 
1.7.10.4