1 ;; Copyright (C) 1998 Free Software Foundation, Inc.
3 ;; Author: Martin Buchholz <martin@xemacs.org>
4 ;; Maintainer: Martin Buchholz <martin@xemacs.org>
6 ;; Keywords: tests, database
8 ;; This file is part of SXEmacs.
10 ;; SXEmacs is free software: you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by the
12 ;; Free Software Foundation, either version 3 of the License, or (at your
13 ;; option) any later version.
15 ;; SXEmacs is distributed in the hope that it will be
16 ;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Synched up with: Not in FSF.
27 ;;; Test hash tables implementation
28 ;;; See test-harness.el
31 (require 'test-harness)
33 (when (and (boundp 'load-file-name) (stringp load-file-name))
34 (push (file-name-directory load-file-name) load-path)
35 (require 'test-harness))))
37 ;; Test all combinations of make-hash-table keywords
38 (dolist (test '(eq eql equal))
39 (dolist (size '(0 1 100))
40 (dolist (rehash-size '(1.1 9.9))
41 (dolist (rehash-threshold '(0.2 .9))
42 (dolist (weakness '(nil key value key-or-value key-and-value))
43 (dolist (data '(() (1 2) (1 2 3 4)))
44 (let ((ht (make-hash-table
47 :rehash-size rehash-size
48 :rehash-threshold rehash-threshold
50 (Assert-Equal ht (car (let ((print-readably t))
51 (read-from-string (prin1-to-string ht)))))
52 (Assert (eq test (hash-table-test ht)))
53 (Assert (<= size (hash-table-size ht)))
54 (Assert (eql rehash-size (hash-table-rehash-size ht)))
55 (Assert (eql rehash-threshold (hash-table-rehash-threshold ht)))
56 (Assert (eq weakness (hash-table-weakness ht))))))))))
58 (loop for (fun weakness) in '((make-hashtable nil)
59 (make-weak-hashtable key-and-value)
60 (make-key-weak-hashtable key)
61 (make-value-weak-hashtable value))
62 do (Assert (eq weakness (hash-table-weakness (funcall fun 10)))))
64 (loop for (type weakness) in '((non-weak nil)
68 do (Assert-Equal (make-hash-table :type type)
69 (make-hash-table :weakness weakness)))
71 (Assert-Not-Equal (make-hash-table :weakness nil)
72 (make-hash-table :weakness t))
74 (let ((ht (make-hash-table :size 20 :rehash-threshold .75 :test 'eq))
76 (Assert (hashtablep ht))
77 (Assert (hash-table-p ht))
78 (Assert (eq 'eq (hash-table-test ht)))
79 (Assert (eq 'non-weak (hash-table-type ht)))
80 (Assert (eq 'non-weak (hashtable-type ht)))
81 (Assert (eq 'nil (hash-table-weakness ht)))
84 (Assert (eq (gethash j ht) (- j)))
85 (Assert (= (hash-table-count ht) (1+ j)))
86 (Assert (= (hashtable-fullness ht) (hash-table-count ht)))
88 (Assert (eq (gethash j ht 'foo) j))
89 (Assert (= (hash-table-count ht) (1+ j)))
90 (setf (gethash j ht) (- j))
91 (Assert (eq (gethash j ht) (- j)))
92 (Assert (= (hash-table-count ht) (1+ j))))
95 (Assert (= 0 (hash-table-count ht)))
99 (Assert (eq (gethash j ht) (- j)))
100 (Assert (= (hash-table-count ht) (1+ j))))
102 (let ((k-sum 0) (v-sum 0))
103 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
104 (Assert (= k-sum (/ (* size (- size 1)) 2)))
105 (Assert (= v-sum (- k-sum))))
110 (Assert (eq (gethash j ht) nil))
111 (Assert (eq (gethash j ht 'foo) 'foo))
112 (Assert (= (hash-table-count ht) (decf count))))))
114 (let ((ht (make-hash-table :size 30 :rehash-threshold .25 :test 'equal))
116 (Assert (hashtablep ht))
117 (Assert (hash-table-p ht))
118 (Assert (>= (hash-table-size ht) (/ 30 .25)))
119 (Assert (eql .25 (hash-table-rehash-threshold ht)))
120 (Assert (eq 'equal (hash-table-test ht)))
121 (Assert (eq (hash-table-test ht) (hashtable-test-function ht)))
122 (Assert (eq 'non-weak (hash-table-type ht)))
124 (puthash (int-to-string j) (- j) ht)
125 (Assert (eq (gethash (int-to-string j) ht) (- j)))
126 (Assert (= (hash-table-count ht) (1+ j)))
127 (puthash (int-to-string j) j ht)
128 (Assert (eq (gethash (int-to-string j) ht 'foo) j))
129 (Assert (= (hash-table-count ht) (1+ j))))
132 (Assert (= 0 (hash-table-count ht)))
133 (Assert-Equal ht (copy-hash-table ht))
136 (setf (gethash (int-to-string j) ht) (- j))
137 (Assert (eq (gethash (int-to-string j) ht) (- j)))
138 (Assert (= (hash-table-count ht) (1+ j))))
142 (remhash (int-to-string j) ht)
143 (Assert (eq (gethash (int-to-string j) ht) nil))
144 (Assert (eq (gethash (int-to-string j) ht 'foo) 'foo))
145 (Assert (= (hash-table-count ht) (decf count))))))
147 (let ((iterations 5) (one 1.0) (two 2.0))
150 (let ((copy-of-ht (copy-hash-table ht)))
151 (Assert-Equal ht copy-of-ht)
152 (Assert (not (eq ht copy-of-ht)))
153 (Assert (eq (hash-table-count ht) (hash-table-count copy-of-ht)))
154 (Assert (eq (hash-table-type ht) (hash-table-type copy-of-ht)))
155 (Assert (eq (hash-table-size ht) (hash-table-size copy-of-ht)))
156 (Assert (eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht)))
157 (Assert (eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht))))))
159 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eq)))
160 (dotimes (j iterations)
161 (puthash (+ one 0.0) t ht)
162 (puthash (+ two 0.0) t ht)
163 (puthash (cons 1 2) t ht)
164 (puthash (cons 3 4) t ht))
165 (Assert (eq (hashtable-test-function ht) 'eq))
166 (Assert (eq (hash-table-test ht) 'eq))
167 (Assert (= (* iterations 4) (hash-table-count ht)))
168 (Assert (eq nil (gethash 1.0 ht)))
169 (Assert (eq nil (gethash '(1 . 2) ht)))
173 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eql)))
174 (dotimes (j iterations)
175 (puthash (+ one 0.0) t ht)
176 (puthash (+ two 0.0) t ht)
177 (puthash (cons 1 2) t ht)
178 (puthash (cons 3 4) t ht))
179 (Assert (eq (hashtable-test-function ht) 'eql))
180 (Assert (eq (hash-table-test ht) 'eql))
181 (Assert (= (+ 2 (* 2 iterations)) (hash-table-count ht)))
182 (Assert (eq t (gethash 1.0 ht)))
183 (Assert (eq nil (gethash '(1 . 2) ht)))
187 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'equal)))
188 (dotimes (j iterations)
189 (puthash (+ one 0.0) t ht)
190 (puthash (+ two 0.0) t ht)
191 (puthash (cons 1 2) t ht)
192 (puthash (cons 3 4) t ht))
193 (Assert (eq (hashtable-test-function ht) 'equal))
194 (Assert (eq (hash-table-test ht) 'equal))
195 (Assert (= 4 (hash-table-count ht)))
196 (Assert (eq t (gethash 1.0 ht)))
197 (Assert (eq t (gethash '(1 . 2) ht)))
203 ;; Test that weak hash-tables are properly handled
204 (unless (featurep 'bdwgc)
205 (loop for (weakness expected-count expected-k-sum expected-v-sum) in
211 (let* ((ht (make-hash-table :weakness weakness))
212 (my-obj (cons ht ht)))
214 (puthash my-obj 1 ht)
215 (puthash 2 my-obj ht)
217 (puthash (cons ht ht) 16 ht)
218 (puthash 32 (cons ht ht) ht)
219 (puthash (cons ht ht) (cons ht ht) ht)
220 (let ((k-sum 0) (v-sum 0))
221 (maphash #'(lambda (k v)
222 (when (integerp k) (incf k-sum k))
223 (when (integerp v) (incf v-sum v)))
225 (Assert (eq 38 k-sum))
226 (Assert (eq 25 v-sum)))
227 (Assert (eq 6 (hash-table-count ht)))
229 (Assert (eq expected-count (hash-table-count ht)))
230 (let ((k-sum 0) (v-sum 0))
231 (maphash #'(lambda (k v)
232 (when (integerp k) (incf k-sum k))
233 (when (integerp v) (incf v-sum v)))
235 (Assert (eq expected-k-sum k-sum))
236 (Assert (eq expected-v-sum v-sum))))))
238 ;;; Test the ability to puthash and remhash the current elt of a maphash
239 (let ((ht (make-hash-table :test 'eql)))
240 (dotimes (j 100) (setf (gethash j ht) (- j)))
241 (maphash #'(lambda (k v)
242 (if (oddp k) (remhash k ht) (puthash k (- v) ht)))
244 (let ((k-sum 0) (v-sum 0))
245 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
246 (Assert (= (* 50 49) k-sum))
247 (Assert (= v-sum k-sum))))
249 ;;; Test reading and printing of hash-table objects
250 (let ((h1 #s(hashtable weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
251 (h2 #s(hash-table weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
252 (h3 (make-hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test 'eq)))
254 (Assert-Not-Equal h1 h3)
257 (Assert-Equal h1 h3))
259 ;;; Testing equality of hash tables
260 (Assert-Equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0)
261 (make-hash-table :test 'eql))
262 (Assert-Not-Equal (make-hash-table :test 'eq)
263 (make-hash-table :test 'equal))
264 (let ((h1 (make-hash-table))
265 (h2 (make-hash-table)))
267 (Assert (not (eq h1 h2)))
269 (Assert-Not-Equal h1 h2)
273 (Assert-Not-Equal h1 h2)
275 (Assert-Not-Equal h1 h2)
281 (Assert (= (sxhash "foo") (sxhash "foo")))
282 (Assert (= (sxhash '(1 2 3)) (sxhash '(1 2 3))))