From: Daniel Hartwig <mandyke@gmail.com>
To: 13741@debbugs.gnu.org
Subject: bug#13741: [PATCH] test-suite: eq-ness of numbers, characters is unspecified
Date: Tue, 19 Feb 2013 09:55:14 +0800 [thread overview]
Message-ID: <1361238914-14823-1-git-send-email-mandyke@gmail.com> (raw)
In-Reply-To: <87ip5pnpyd.fsf@tines.lan>
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain; charset=UTF-8, Size: 13629 bytes --]
* 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))))))
\f
(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
next prev parent reply other threads:[~2013-02-19 1:55 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2013-02-18 3:27 bug#13741: guile-2.0: optimize, and eq-ness of literals (test-suite) Daniel Hartwig
2013-02-18 9:16 ` Ludovic Courtès
2013-02-18 10:02 ` Daniel Hartwig
2013-03-01 16:13 ` Mark H Weaver
2013-02-18 17:19 ` Andy Wingo
2013-02-18 23:48 ` Mark H Weaver
2013-02-19 1:55 ` Daniel Hartwig [this message]
2013-02-19 4:29 ` bug#13741: [PATCH] test-suite: eq-ness of numbers, characters is unspecified Daniel Hartwig
2013-02-19 5:19 ` Mark H Weaver
2013-03-01 16:10 ` Mark H Weaver
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1361238914-14823-1-git-send-email-mandyke@gmail.com \
--to=mandyke@gmail.com \
--cc=13741@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).