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 XEmacs.
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; 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 XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 ;;; Synched up with: Not in FSF.
29 ;;; Test hash tables implementation
30 ;;; See test-harness.el
33 (require 'test-harness)
35 (when (and (boundp 'load-file-name) (stringp load-file-name))
36 (push (file-name-directory load-file-name) load-path)
37 (require 'test-harness))))
39 ;; Test all combinations of make-hash-table keywords
40 (dolist (type '(non-weak weak key-weak value-weak))
41 (dolist (test '(eq eql equal))
42 (dolist (size '(0 1 100))
43 (dolist (rehash-size '(1.1 9.9))
44 (dolist (rehash-threshold '(0.2 .9))
45 (dolist (data '(() (1 2) (1 2 3 4)))
46 (let ((ht (make-hash-table :test test
49 :rehash-size rehash-size
50 :rehash-threshold rehash-threshold)))
51 (Assert (equal ht (car (let ((print-readably t))
52 (read-from-string (prin1-to-string ht))))))
53 (Assert (eq test (hash-table-test ht)))
54 (Assert (eq type (hash-table-type ht)))
55 (Assert (<= size (hash-table-size ht)))
56 (Assert (eql rehash-size (hash-table-rehash-size ht)))
57 (Assert (eql rehash-threshold (hash-table-rehash-threshold ht))))))))))
59 (loop for (fun type) in '((make-hashtable non-weak)
60 (make-weak-hashtable weak)
61 (make-key-weak-hashtable key-weak)
62 (make-value-weak-hashtable value-weak))
63 do (Assert (eq type (hash-table-type (funcall fun 10)))))
65 (let ((ht (make-hash-table :size 20 :rehash-threshold .75 :test 'eq))
67 (Assert (hashtablep ht))
68 (Assert (hash-table-p ht))
69 (Assert (eq 'eq (hash-table-test ht)))
70 (Assert (eq 'non-weak (hash-table-type ht)))
71 (Assert (eq 'non-weak (hashtable-type ht)))
74 (Assert (eq (gethash j ht) (- j)))
75 (Assert (= (hash-table-count ht) (1+ j)))
76 (Assert (= (hashtable-fullness ht) (hash-table-count ht)))
78 (Assert (eq (gethash j ht 'foo) j))
79 (Assert (= (hash-table-count ht) (1+ j)))
80 (setf (gethash j ht) (- j))
81 (Assert (eq (gethash j ht) (- j)))
82 (Assert (= (hash-table-count ht) (1+ j))))
85 (Assert (= 0 (hash-table-count ht)))
89 (Assert (eq (gethash j ht) (- j)))
90 (Assert (= (hash-table-count ht) (1+ j))))
92 (let ((k-sum 0) (v-sum 0))
93 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
96 (Assert (= k-sum (/ (* size (- size 1)) 2)))
97 (Assert (= v-sum (- k-sum))))
102 (Assert (eq (gethash j ht) nil))
103 (Assert (eq (gethash j ht 'foo) 'foo))
104 (Assert (= (hash-table-count ht) (decf count))))))
106 (let ((ht (make-hash-table :size 30 :rehash-threshold .25 :test 'equal))
108 (Assert (hashtablep ht))
109 (Assert (hash-table-p ht))
110 (Assert (>= (hash-table-size ht) (/ 30 .25)))
111 (Assert (eql .25 (hash-table-rehash-threshold ht)))
112 (Assert (eq 'equal (hash-table-test ht)))
113 (Assert (eq (hash-table-test ht) (hashtable-test-function ht)))
114 (Assert (eq 'non-weak (hash-table-type ht)))
116 (puthash (int-to-string j) (- j) ht)
117 (Assert (eq (gethash (int-to-string j) ht) (- j)))
118 (Assert (= (hash-table-count ht) (1+ j)))
119 (puthash (int-to-string j) j ht)
120 (Assert (eq (gethash (int-to-string j) ht 'foo) j))
121 (Assert (= (hash-table-count ht) (1+ j))))
124 (Assert (= 0 (hash-table-count ht)))
125 (Assert (equal ht (copy-hash-table ht)))
128 (setf (gethash (int-to-string j) ht) (- j))
129 (Assert (eq (gethash (int-to-string j) ht) (- j)))
130 (Assert (= (hash-table-count ht) (1+ j))))
134 (remhash (int-to-string j) ht)
135 (Assert (eq (gethash (int-to-string j) ht) nil))
136 (Assert (eq (gethash (int-to-string j) ht 'foo) 'foo))
137 (Assert (= (hash-table-count ht) (decf count))))))
139 (let ((iterations 5) (one 1.0) (two 2.0))
142 (let ((copy-of-ht (copy-hash-table ht)))
143 (Assert (equal ht copy-of-ht))
144 (Assert (not (eq ht copy-of-ht)))
145 (Assert (eq (hash-table-count ht) (hash-table-count copy-of-ht)))
146 (Assert (eq (hash-table-type ht) (hash-table-type copy-of-ht)))
147 (Assert (eq (hash-table-size ht) (hash-table-size copy-of-ht)))
148 (Assert (eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht)))
149 (Assert (eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht))))))
151 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eq)))
152 (dotimes (j iterations)
153 (puthash (+ one 0.0) t ht)
154 (puthash (+ two 0.0) t ht)
155 (puthash (concat "1" "2") t ht)
156 (puthash (concat "3" "4") t ht))
157 (Assert (eq (hashtable-test-function ht) 'eq))
158 (Assert (eq (hash-table-test ht) 'eq))
159 (Assert (= (* iterations 4) (hash-table-count ht)))
160 (Assert (eq nil (gethash 1.0 ht)))
161 (Assert (eq nil (gethash "12" ht)))
165 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eql)))
166 (dotimes (j iterations)
167 (puthash (+ one 0.0) t ht)
168 (puthash (+ two 0.0) t ht)
169 (puthash (concat "1" "2") t ht)
170 (puthash (concat "3" "4") t ht))
171 (Assert (eq (hashtable-test-function ht) 'eql))
172 (Assert (eq (hash-table-test ht) 'eql))
173 (Assert (= (+ 2 (* 2 iterations)) (hash-table-count ht)))
174 (Assert (eq t (gethash 1.0 ht)))
175 (Assert (eq nil (gethash "12" ht)))
179 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'equal)))
180 (dotimes (j iterations)
181 (puthash (+ one 0.0) t ht)
182 (puthash (+ two 0.0) t ht)
183 (puthash (concat "1" "2") t ht)
184 (puthash (concat "3" "4") t ht))
185 (Assert (eq (hashtable-test-function ht) 'equal))
186 (Assert (eq (hash-table-test ht) 'equal))
187 (Assert (= 4 (hash-table-count ht)))
188 (Assert (eq t (gethash 1.0 ht)))
189 (Assert (eq t (gethash "12" ht)))
195 ;; Test that weak hash-tables are properly handled
196 (loop for (type expected-count expected-k-sum expected-v-sum) in
202 (let* ((ht (make-hash-table :type type))
203 (my-obj (cons ht ht)))
205 (puthash my-obj 1 ht)
206 (puthash 2 my-obj ht)
208 (puthash (cons ht ht) 16 ht)
209 (puthash 32 (cons ht ht) ht)
210 (puthash (cons ht ht) (cons ht ht) ht)
211 (let ((k-sum 0) (v-sum 0))
212 (maphash #'(lambda (k v)
213 (when (integerp k) (incf k-sum k))
214 (when (integerp v) (incf v-sum v)))
216 (Assert (eq 38 k-sum))
217 (Assert (eq 25 v-sum)))
218 (Assert (eq 6 (hash-table-count ht)))
220 (Assert (eq expected-count (hash-table-count ht)))
221 (let ((k-sum 0) (v-sum 0))
222 (maphash #'(lambda (k v)
223 (when (integerp k) (incf k-sum k))
224 (when (integerp v) (incf v-sum v)))
226 (Assert (eq expected-k-sum k-sum))
227 (Assert (eq expected-v-sum v-sum)))))
229 ;;; Test the ability to puthash and remhash the current elt of a maphash
230 (let ((ht (make-hash-table :test 'eql)))
231 (dotimes (j 100) (setf (gethash j ht) (- j)))
232 (maphash #'(lambda (k v)
233 (if (oddp k) (remhash k ht) (puthash k (- v) ht)))
235 (let ((k-sum 0) (v-sum 0))
236 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
237 (Assert (= (* 50 49) k-sum))
238 (Assert (= v-sum k-sum))))
240 ;;; Test reading and printing of hash-table objects
241 (let ((h1 #s(hashtable type weak rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
242 (h2 #s(hash-table type weak rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
243 (h3 (make-hash-table :type 'weak :rehash-size 3.0 :rehash-threshold .2 :test 'eq)))
244 (Assert (equal h1 h2))
245 (Assert (not (equal h1 h3)))
248 (Assert (equal h1 h3)))
250 ;;; Testing equality of hash tables
251 (Assert (equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0)
252 (make-hash-table :test 'eql)))
253 (Assert (not (equal (make-hash-table :test 'eq)
254 (make-hash-table :test 'equal))))
255 (let ((h1 (make-hash-table))
256 (h2 (make-hash-table)))
257 (Assert (equal h1 h2))
258 (Assert (not (eq h1 h2)))
260 (Assert (not (equal h1 h2)))
262 (Assert (equal h1 h2))
264 (Assert (not (equal h1 h2)))
266 (Assert (not (equal h1 h2)))
268 (Assert (equal h1 h2))