Revert "Fix bound-identifier=? to compare binding names, not just symbolic names."

[bpt/guile.git] / test-suite / tests / hash.test

diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index d2bde48..ad247f5 100644 (file)
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -1,6 +1,6 @@
 ;;;; hash.test --- test guile hashing     -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2005, 2006, 2008, 2011, 2012 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -18,7 +18,8 @@
 
 (define-module (test-suite test-numbers)
   #:use-module (test-suite lib)
-  #:use-module (ice-9 documentation))
+  #:use-module (ice-9 documentation)
+  #:use-module (ice-9 hash-table))
 
 ;;;
 ;;; hash
@@ -32,7 +33,10 @@
     (hash #t 0))
   (pass-if (= 0 (hash #t 1)))
   (pass-if (= 0 (hash #f 1)))
-  (pass-if (= 0 (hash noop 1))))
+  (pass-if (= 0 (hash noop 1)))
+  (pass-if (= 0 (hash +inf.0 1)))
+  (pass-if (= 0 (hash -inf.0 1)))
+  (pass-if (= 0 (hash +nan.0 1))))
 
 ;;;
 ;;; hashv
@@ -72,9 +76,45 @@
                    (make-hash-table -1))
  (pass-if (hash-table? (make-hash-table 0))) ;; default
  (pass-if (not (hash-table? 'not-a-hash-table)))
- (pass-if (equal? "#<hash-table 0/113>" 
-                 (with-output-to-string 
-                   (lambda () (write (make-hash-table 100)))))))
+ (pass-if (string-suffix? " 0/113>"
+                          (with-output-to-string
+                            (lambda ()
+                              (write (make-hash-table 100)))))))
+
+;;;
+;;; alist->hash-table
+;;;
+
+(with-test-prefix
+  "alist conversion"
+
+  (pass-if "alist->hash-table"
+    (let ((table (alist->hash-table '(("foo" . 1)
+                                      ("bar" . 2)
+                                      ("foo" . 3)))))
+      (and (= (hash-ref table "foo") 1)
+           (= (hash-ref table "bar") 2))))
+
+  (pass-if "alist->hashq-table"
+    (let ((table (alist->hashq-table '((foo . 1)
+                                       (bar . 2)
+                                       (foo . 3)))))
+      (and (= (hashq-ref table 'foo) 1)
+           (= (hashq-ref table 'bar) 2))))
+
+  (pass-if "alist->hashv-table"
+    (let ((table (alist->hashv-table '((1 . 1)
+                                       (2 . 2)
+                                       (1 . 3)))))
+      (and (= (hashv-ref table 1) 1)
+           (= (hashv-ref table 2) 2))))
+
+  (pass-if "alist->hashx-table"
+    (let ((table (alist->hashx-table hash assoc '((foo . 1)
+                                                  (bar . 2)
+                                                  (foo . 3)))))
+      (and (= (hashx-ref hash assoc table 'foo) 1)
+           (= (hashx-ref hash assoc table 'bar) 2)))))
 
 ;;;
 ;;; usual set and reference
@@ -126,10 +166,11 @@
                 (equal? 'thirty (hash-ref table 30))
                 (equal? 'thirty-three (hash-ref table 33))
                 (equal? 'bar (hash-ref table 'foo))
-                (equal? "#<hash-table 36/61>" 
-                        (with-output-to-string (lambda () (write table)))))))
+                (string-suffix? " 36/61>"
+                                 (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)
@@ -138,12 +179,8 @@
                  (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 eq?
+ ;; 1/2 and 2/4 are equal? and eqv? (but not necessarily eq?)
  (pass-if (equal? 'foo
                  (let ((table (make-hash-table)))
                    (hash-set! table 1/2 'foo)
@@ -152,10 +189,6 @@
                  (let ((table (make-hash-table)))
                    (hashv-set! table 1/2 'foo)
                    (hashv-ref table 2/4))))
- (pass-if (equal? #f
-                 (let ((table (make-hash-table)))
-                   (hashq-set! table 1/2 'foo)
-                   (hashq-ref table 2/4))))
 
  ;; (list 1 2) is equal? but not eqv? or eq? to another (list 1 2)
  (pass-if (equal? 'foo
@@ -237,8 +270,9 @@
    (pass-if (equal? 'equal (hashx-ref hash assoc table 2/64)))
    (pass-if (equal? 'equal (hashx-ref hash assoc table 2/66)))
    (pass-if (equal? 'equal (hashx-ref hash assoc table 34)))
-   (pass-if (equal? "#<hash-table 33/61>" 
-                   (with-output-to-string (lambda () (write table)))))))
+   (pass-if (string-suffix? " 33/61>"
+                            (with-output-to-string
+                              (lambda () (write table)))))))
 
 (with-test-prefix 
  "hashx"
@@ -286,3 +320,19 @@
    exception:wrong-type-arg
    (hashx-set! (lambda (k s) 1) (lambda (k al) #t) (make-hash-table) 'foo 'bar))
   )
+
+
+;;;
+;;; hash-count
+;;;
+
+(with-test-prefix "hash-count"
+  (let ((table (make-hash-table)))
+    (hashq-set! table 'foo "bar")
+    (hashq-set! table 'braz "zonk")
+    (hashq-create-handle! table 'frob #f)
+
+    (pass-if (equal? 3 (hash-count (const #t) table)))
+
+    (pass-if (equal? 2 (hash-count (lambda (k v)
+                                     (string? v)) table)))))