xemacs-beta: tests/automated/hash-table-tests.el annotate

annotate tests/automated/hash-table-tests.el @ 5605:cc7f8a0e569a

Accept bignums unambiguously in the syntax for object labels, lread.c. src/ChangeLog addition: 2011-12-03 Aidan Kehoe <kehoea@parhasard.net> * lread.c (read1): Don't wrap when reading expressions that use bignums as object labels, that can lead to ambiguity and it's not actually that hard to use parse_integer() to avoid it. tests/ChangeLog addition: 2011-12-03 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-reader-tests.el: Check that integer object labels (using the #N=... syntax) treat bignums as such, rather than as fixnums that have wrapped.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Sat, 03 Dec 2011 15:13:55 +0000
parents	071b810ceb18
children	49c36ed998b6

rev	line source
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	1 ;; Copyright (C) 1998 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	2
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	3 ;; Author: Martin Buchholz <martin@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	4 ;; Maintainer: Martin Buchholz <martin@xemacs.org>
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	5 ;; Created: 1998
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	6 ;; Keywords: tests, database
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	7
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	8 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	9
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5191 diff changeset	10 ;; XEmacs is free software: you can redistribute it and/or modify it
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5191 diff changeset	11 ;; under the terms of the GNU General Public License as published by the
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5191 diff changeset	12 ;; Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5191 diff changeset	13 ;; option) any later version.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	14
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5191 diff changeset	15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5191 diff changeset	16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5191 diff changeset	17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5191 diff changeset	18 ;; for more details.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	19
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	20 ;; You should have received a copy of the GNU General Public License
5402 308d34e9f07d Changed bulk of GPLv2 or later files identified by script Mats Lidell <matsl@xemacs.org> parents: 5191 diff changeset	21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>.
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	22
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	23 ;;; Synched up with: Not in FSF.
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	24
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	25 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	26
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	27 ;;; Test hash tables implementation
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	28 ;;; See test-harness.el
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	29
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	30 (condition-case err
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	31 (require 'test-harness)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	32 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	33 (when (and (boundp 'load-file-name) (stringp load-file-name))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	34 (push (file-name-directory load-file-name) load-path)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	35 (require 'test-harness))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	36
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	37 ;; Test all combinations of make-hash-table keywords
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	38 (dolist (test '(eq eql equal equalp))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	39 (dolist (size '(0 1 100))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	40 (dolist (rehash-size '(1.1 9.9))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	41 (dolist (rehash-threshold '(0.2 .9))
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 428 diff changeset	42 (dolist (weakness '(nil key value key-or-value key-and-value))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	43 (dolist (data '(() (1 2) (1 2 3 4)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	44 (let ((ht (make-hash-table
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	45 :test test
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	46 :size size
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	47 :rehash-size rehash-size
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	48 :rehash-threshold rehash-threshold
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	49 :weakness weakness)))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	50 (Assert (equal ht (car (let ((print-readably t))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	51 (read-from-string (prin1-to-string ht))))))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	52 (Assert (eq test (hash-table-test ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	53 (Assert (<= size (hash-table-size ht)))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	54 (Assert (eql rehash-size (hash-table-rehash-size ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	55 (Assert (eql rehash-threshold (hash-table-rehash-threshold ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	56 (Assert (eq weakness (hash-table-weakness ht))))))))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	57
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	58 (loop for (fun weakness) in '((make-hashtable nil)
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 428 diff changeset	59 (make-weak-hashtable key-and-value)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	60 (make-key-weak-hashtable key)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	61 (make-value-weak-hashtable value))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	62 do (Assert (eq weakness (hash-table-weakness (funcall fun 10)))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	63
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	64 (loop for (type weakness) in '((non-weak nil)
442 abe6d1db359e Import from CVS: tag r21-2-36 cvs parents: 428 diff changeset	65 (weak key-and-value)
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	66 (key-weak key)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	67 (value-weak value))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	68 do (Assert (equal (make-hash-table :type type)
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	69 (make-hash-table :weakness weakness))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	70
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	71 (Assert (not (equal (make-hash-table :weakness nil)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	72 (make-hash-table :weakness t))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	73
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	74 (let ((ht (make-hash-table :size 20 :rehash-threshold .75 :test 'eq))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	75 (size 80))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	76 (Assert (hashtablep ht))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	77 (Assert (hash-table-p ht))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	78 (Assert (eq 'eq (hash-table-test ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	79 (Assert (eq 'non-weak (hash-table-type ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	80 (Assert (eq 'non-weak (hashtable-type ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	81 (Assert (eq 'nil (hash-table-weakness ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	82 (dotimes (j size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	83 (puthash j (- j) ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	84 (Assert (eq (gethash j ht) (- j)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	85 (Assert (= (hash-table-count ht) (1+ j)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	86 (Assert (= (hashtable-fullness ht) (hash-table-count ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	87 (puthash j j ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	88 (Assert (eq (gethash j ht 'foo) j))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	89 (Assert (= (hash-table-count ht) (1+ j)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	90 (setf (gethash j ht) (- j))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	91 (Assert (eq (gethash j ht) (- j)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	92 (Assert (= (hash-table-count ht) (1+ j))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	93
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	94 (clrhash ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	95 (Assert (= 0 (hash-table-count ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	96
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	97 (dotimes (j size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	98 (puthash j (- j) ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	99 (Assert (eq (gethash j ht) (- j)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	100 (Assert (= (hash-table-count ht) (1+ j))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	101
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	102 (let ((k-sum 0) (v-sum 0))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	103 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	104 (Assert (= k-sum (/ (* size (- size 1)) 2)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	105 (Assert (= v-sum (- k-sum))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	106
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	107 (let ((count size))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	108 (dotimes (j size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	109 (remhash j ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	110 (Assert (eq (gethash j ht) nil))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	111 (Assert (eq (gethash j ht 'foo) 'foo))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	112 (Assert (= (hash-table-count ht) (decf count))))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	113
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	114 (let ((ht (make-hash-table :size 30 :rehash-threshold .25 :test 'equal))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	115 (size 70))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	116 (Assert (hashtablep ht))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	117 (Assert (hash-table-p ht))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	118 (Assert (>= (hash-table-size ht) (/ 30 .25)))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	119 (Assert (eql .25 (hash-table-rehash-threshold ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	120 (Assert (eq 'equal (hash-table-test ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	121 (Assert (eq (hash-table-test ht) (hashtable-test-function ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	122 (Assert (eq 'non-weak (hash-table-type ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	123 (dotimes (j size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	124 (puthash (int-to-string j) (- j) ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	125 (Assert (eq (gethash (int-to-string j) ht) (- j)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	126 (Assert (= (hash-table-count ht) (1+ j)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	127 (puthash (int-to-string j) j ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	128 (Assert (eq (gethash (int-to-string j) ht 'foo) j))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	129 (Assert (= (hash-table-count ht) (1+ j))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	130
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	131 (clrhash ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	132 (Assert (= 0 (hash-table-count ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	133 (Assert (equal ht (copy-hash-table ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	134
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	135 (dotimes (j size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	136 (setf (gethash (int-to-string j) ht) (- j))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	137 (Assert (eq (gethash (int-to-string j) ht) (- j)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	138 (Assert (= (hash-table-count ht) (1+ j))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	139
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	140 (let ((count size))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	141 (dotimes (j size)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	142 (remhash (int-to-string j) ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	143 (Assert (eq (gethash (int-to-string j) ht) nil))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	144 (Assert (eq (gethash (int-to-string j) ht 'foo) 'foo))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	145 (Assert (= (hash-table-count ht) (decf count))))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	146
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	147 (let ((iterations 5) (one 1.0) (two 2.0))
5576 071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	148 (labels ((check-copy
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	149 (ht)
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	150 (let ((copy-of-ht (copy-hash-table ht)))
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	151 (Assert (equal ht copy-of-ht))
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	152 (Assert (not (eq ht copy-of-ht)))
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	153 (Assert (eq (hash-table-count ht)
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	154 (hash-table-count copy-of-ht)))
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	155 (Assert (eq (hash-table-type ht)
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	156 (hash-table-type copy-of-ht)))
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	157 (Assert (eq (hash-table-size ht)
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	158 (hash-table-size copy-of-ht)))
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	159 (Assert (eql (hash-table-rehash-size ht)
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	160 (hash-table-rehash-size copy-of-ht)))
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	161 (Assert (eql (hash-table-rehash-threshold ht)
071b810ceb18 Declare labels as line where appropriate; use #'labels, not #'flet, tests. Aidan Kehoe <kehoea@parhasard.net> parents: 5402 diff changeset	162 (hash-table-rehash-threshold copy-of-ht))))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	163
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	164 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eq)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	165 (dotimes (j iterations)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	166 (puthash (+ one 0.0) t ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	167 (puthash (+ two 0.0) t ht)
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	168 (puthash (cons 1 2) t ht)
576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	169 (puthash (cons 3 4) t ht))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	170 (Assert (eq (hashtable-test-function ht) 'eq))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	171 (Assert (eq (hash-table-test ht) 'eq))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	172 (Assert (= (* iterations 4) (hash-table-count ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	173 (Assert (eq nil (gethash 1.0 ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	174 (Assert (eq nil (gethash '(1 . 2) ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	175 (check-copy ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	176 )
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	177
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	178 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eql)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	179 (dotimes (j iterations)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	180 (puthash (+ one 0.0) t ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	181 (puthash (+ two 0.0) t ht)
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	182 (puthash (cons 1 2) t ht)
576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	183 (puthash (cons 3 4) t ht))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	184 (Assert (eq (hashtable-test-function ht) 'eql))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	185 (Assert (eq (hash-table-test ht) 'eql))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	186 (Assert (= (+ 2 (* 2 iterations)) (hash-table-count ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	187 (Assert (eq t (gethash 1.0 ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	188 (Assert (eq nil (gethash '(1 . 2) ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	189 (check-copy ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	190 )
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	191
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	192 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'equal)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	193 (dotimes (j iterations)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	194 (puthash (+ one 0.0) t ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	195 (puthash (+ two 0.0) t ht)
444 576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	196 (puthash (cons 1 2) t ht)
576fb035e263 Import from CVS: tag r21-2-37 cvs parents: 442 diff changeset	197 (puthash (cons 3 4) t ht))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	198 (Assert (eq (hashtable-test-function ht) 'equal))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	199 (Assert (eq (hash-table-test ht) 'equal))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	200 (Assert (= 4 (hash-table-count ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	201 (Assert (eq t (gethash 1.0 ht)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	202 (Assert (eq t (gethash '(1 . 2) ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	203 (check-copy ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	204 )
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	205
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	206 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'equalp)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	207 (dotimes (j iterations)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	208 (puthash (+ one 0.0) t ht)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	209 (puthash 1 t ht)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	210 (puthash (+ two 0.0) t ht)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	211 (puthash 2 t ht)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	212 (puthash (cons 1.0 2.0) (gensym) ht)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	213 ;; Override the previous entry.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	214 (puthash (cons 1 2) t ht)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	215 (puthash (cons 3.0 4.0) (gensym) ht)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	216 (puthash (cons 3 4) t ht))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	217 (Assert (eq (hashtable-test-function ht) 'equalp))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	218 (Assert (eq (hash-table-test ht) 'equalp))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	219 (Assert (= 4 (hash-table-count ht)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	220 (Assert (eq t (gethash 1.0 ht)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	221 (Assert (eq t (gethash '(1 . 2) ht)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	222 (check-copy ht)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	223 )
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	224
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	225 ))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	226
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	227 ;; Test that weak hash-tables are properly handled
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	228 (loop for (weakness expected-count expected-k-sum expected-v-sum) in
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	229 '((nil 6 38 25)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	230 (t 3 6 9)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	231 (key 4 38 9)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	232 (value 4 6 25))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	233 do
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	234 (let* ((ht (make-hash-table :weakness weakness))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	235 (my-obj (cons ht ht)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	236 (garbage-collect)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	237 (puthash my-obj 1 ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	238 (puthash 2 my-obj ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	239 (puthash 4 8 ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	240 (puthash (cons ht ht) 16 ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	241 (puthash 32 (cons ht ht) ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	242 (puthash (cons ht ht) (cons ht ht) ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	243 (let ((k-sum 0) (v-sum 0))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	244 (maphash #'(lambda (k v)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	245 (when (integerp k) (incf k-sum k))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	246 (when (integerp v) (incf v-sum v)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	247 ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	248 (Assert (eq 38 k-sum))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	249 (Assert (eq 25 v-sum)))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	250 (Assert (eq 6 (hash-table-count ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	251 (garbage-collect)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	252 (Assert (eq expected-count (hash-table-count ht)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	253 (let ((k-sum 0) (v-sum 0))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	254 (maphash #'(lambda (k v)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	255 (when (integerp k) (incf k-sum k))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	256 (when (integerp v) (incf v-sum v)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	257 ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	258 (Assert (eq expected-k-sum k-sum))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	259 (Assert (eq expected-v-sum v-sum)))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	260
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	261 ;;; Test the ability to puthash and remhash the current elt of a maphash
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	262 (let ((ht (make-hash-table :test 'eql)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	263 (dotimes (j 100) (setf (gethash j ht) (- j)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	264 (maphash #'(lambda (k v)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	265 (if (oddp k) (remhash k ht) (puthash k (- v) ht)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	266 ht)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	267 (let ((k-sum 0) (v-sum 0))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	268 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	269 (Assert (= (* 50 49) k-sum))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	270 (Assert (= v-sum k-sum))))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	271
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	272 ;;; Test reading and printing of hash-table objects
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	273 (let ((h1 #s(hashtable :weakness t :rehash-size 3.0 :rehash-threshold .2 :test eq :data (1 2 3 4)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	274 (h2 #s(hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test eq :data (1 2 3 4)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	275 (h3 (make-hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test 'eq)))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	276 (Assert (equal h1 h2))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	277 (Assert (not (equal h1 h3)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	278 (puthash 1 2 h3)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	279 (puthash 3 4 h3)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	280 (Assert (equal h1 h3)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	281
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	282 ;;; Testing equality of hash tables
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	283 (Assert (equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0)
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	284 (make-hash-table :test 'eql)))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	285 (Assert (not (equal (make-hash-table :test 'eq)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	286 (make-hash-table :test 'equal))))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	287 (let ((h1 (make-hash-table))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	288 (h2 (make-hash-table)))
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	289 (Assert (equal h1 h2))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	290 (Assert (not (eq h1 h2)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	291 (puthash 1 2 h1)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	292 (Assert (not (equal h1 h2)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	293 (puthash 1 2 h2)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	294 (Assert (equal h1 h2))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	295 (puthash 1 3 h2)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	296 (Assert (not (equal h1 h2)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	297 (clrhash h1)
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	298 (Assert (not (equal h1 h2)))
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	299 (clrhash h2)
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	300 (Assert (equal h1 h2))
428 3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	301 )
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	302
3ecd8885ac67 Import from CVS: tag r21-2-22 cvs parents: diff changeset	303 ;;; Test sxhash
5136 0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	304 (Assert (= (sxhash "foo") (sxhash "foo")))
0f66906b6e37 Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically Ben Wing <ben@xemacs.org> parents: 4855 diff changeset	305 (Assert (= (sxhash '(1 2 3)) (sxhash '(1 2 3))))
4398 479443c0f95a Have list hashes depend on the order of the contents, as is the case for vectors. Aidan Kehoe <kehoea@parhasard.net> parents: 1761 diff changeset	306 (Assert (/= (sxhash '(1 2 3)) (sxhash '(3 2 1))))
5191 71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	307
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	308 ;; Test #'define-hash-table-test.
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	309
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	310 (defstruct hash-table-test-structure
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	311 number-identifier padding-zero padding-one padding-two)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	312
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	313 (macrolet
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	314 ((good-hash () 65599)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	315 (hash-modulo-figure ()
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	316 (if (featurep 'bignum)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	317 (1+ (* most-positive-fixnum 2))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	318 most-positive-fixnum))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	319 (hash-table-test-structure-first-hash-figure ()
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	320 (rem* (* 65599 (eq-hash 'hash-table-test-structure))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	321 (if (featurep 'bignum)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	322 (1+ (* most-positive-fixnum 2))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	323 most-positive-fixnum))))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	324 (let ((hash-table-test (gensym))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	325 (no-entry-found (gensym))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	326 (two 2.0)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	327 (equal-function
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	328 #'(lambda (object-one object-two)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	329 (or (equal object-one object-two)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	330 (and (hash-table-test-structure-p object-one)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	331 (hash-table-test-structure-p object-two)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	332 (= (hash-table-test-structure-number-identifier
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	333 object-one)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	334 (hash-table-test-structure-number-identifier
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	335 object-two))))))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	336 (hash-function
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	337 #'(lambda (object)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	338 (if (hash-table-test-structure-p object)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	339 (rem* (+ (hash-table-test-structure-first-hash-figure)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	340 (equalp-hash
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	341 (hash-table-test-structure-number-identifier
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	342 object)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	343 (hash-modulo-figure))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	344 (equal-hash object))))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	345 hash-table-test-hash equal-hash)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	346 (Check-Error wrong-type-argument (define-hash-table-test
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	347 "hi there everyone"
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	348 equal-function hash-function))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	349 (Check-Error wrong-number-of-arguments (define-hash-table-test
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	350 (gensym)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	351 hash-function hash-function))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	352 (Check-Error wrong-number-of-arguments (define-hash-table-test
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	353 (gensym)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	354 equal-function equal-function))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	355 (define-hash-table-test hash-table-test equal-function hash-function)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	356 (Assert (valid-hash-table-test-p hash-table-test))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	357 (setq equal-hash (make-hash-table :test #'equal)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	358 hash-table-test-hash (make-hash-table :test hash-table-test))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	359 (Assert (hash-table-p equal-hash))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	360 (Assert (hash-table-p hash-table-test-hash))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	361 (Assert (eq hash-table-test (hash-table-test hash-table-test-hash)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	362 (loop
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	363 for ii from 200 below 300
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	364 with structure = nil
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	365 do
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	366 (setf structure (make-hash-table-test-structure
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	367 :number-identifier (if (oddp ii) (float (% ii 10))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	368 (% ii 10))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	369 :padding-zero (random)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	370 :padding-one (random)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	371 :padding-two (random))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	372 (gethash structure hash-table-test-hash) t
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	373 (gethash structure equal-hash) t))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	374 (Assert (= (hash-table-count hash-table-test-hash) 10))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	375 (Assert (= (hash-table-count equal-hash) 100))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	376 (Assert (eq t (gethash (make-hash-table-test-structure
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	377 :number-identifier 1
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	378 :padding-zero (random)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	379 :padding-one (random)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	380 :padding-two (random))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	381 hash-table-test-hash)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	382 (Assert (eq t (gethash (make-hash-table-test-structure
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	383 :number-identifier 2.0
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	384 :padding-zero (random)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	385 :padding-one (random)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	386 :padding-two (random))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	387 hash-table-test-hash)))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	388 (Assert (eq no-entry-found (gethash (make-hash-table-test-structure
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	389 :number-identifier (+ two 0.0)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	390 :padding-zero (random)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	391 :padding-one (random)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	392 :padding-two (random))
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	393 equal-hash
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API Aidan Kehoe <kehoea@parhasard.net> parents: 5136 diff changeset	394 no-entry-found)))))

Mercurial > hg > xemacs-beta

annotate tests/automated/hash-table-tests.el @ 5605:cc7f8a0e569a