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

annotate tests/automated/hash-table-tests.el @ 5576:071b810ceb18

Declare labels as line where appropriate; use #'labels, not #'flet, tests. lisp/ChangeLog addition: 2011-10-03 Aidan Kehoe <kehoea@parhasard.net> * simple.el (handle-pre-motion-command-current-command-is-motion): Implement #'keysyms-equal with #'labels + (declare (inline ...)), instead of abusing macrolet to the same end. * specifier.el (let-specifier): * mule/mule-cmds.el (describe-language-environment): * mule/mule-cmds.el (set-language-environment-coding-systems): * mule/mule-x-init.el (x-use-halfwidth-roman-font): * faces.el (Face-frob-property): * keymap.el (key-sequence-list-description): * lisp-mode.el (construct-lisp-mode-menu): * loadhist.el (unload-feature): * mouse.el (default-mouse-track-check-for-activation): Declare various labels inline in dumped files when that reduces the size of the dumped image. Declaring labels inline is normally only worthwhile for inner loops and so on, but it's reasonable exercise of the related code to have these changes in core. tests/ChangeLog addition: 2011-10-03 Aidan Kehoe <kehoea@parhasard.net> * automated/case-tests.el (uni-mappings): * automated/database-tests.el (delete-database-files): * automated/hash-table-tests.el (iterations): * automated/lisp-tests.el (test1): * automated/lisp-tests.el (a): * automated/lisp-tests.el (cl-floor): * automated/lisp-tests.el (foo): * automated/lisp-tests.el (list-nreverse): * automated/lisp-tests.el (needs-lexical-context): * automated/mule-tests.el (featurep): * automated/os-tests.el (original-string): * automated/os-tests.el (with): * automated/symbol-tests.el (check-weak-list-unique): Replace #'flet with #'labels where appropriate in these tests, following my own advice on style in the docstrings of those functions.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Mon, 03 Oct 2011 20:16:14 +0100
parents	308d34e9f07d
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 @ 5576:071b810ceb18