Mercurial > hg > xemacs-beta

comparison tests/automated/hash-table-tests.el @ 4855:189fb67ca31a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Create Assert-eq, Assert-equal, etc. These are equivalent to (Assert (eq ...)) but display both the actual value and the expected value of the comparison. Use them throughout the test suite.
author Ben Wing <ben@xemacs.org>
date Thu, 14 Jan 2010 02:18:03 -0600
parents 479443c0f95a
children 0f66906b6e37
comparison
equal deleted inserted replaced
4854:95c4ced5c07c 4855:189fb67ca31a
47 :test test 47 :test test
48 :size size 48 :size size
49 :rehash-size rehash-size 49 :rehash-size rehash-size
50 :rehash-threshold rehash-threshold 50 :rehash-threshold rehash-threshold
51 :weakness weakness))) 51 :weakness weakness)))
52 (Assert (equal ht (car (let ((print-readably t)) 52 (Assert-equal ht (car (let ((print-readably t))
53 (read-from-string (prin1-to-string ht)))))) 53 (read-from-string (prin1-to-string ht)))))
54 (Assert (eq test (hash-table-test ht))) 54 (Assert-eq test (hash-table-test ht))
55 (Assert (<= size (hash-table-size ht))) 55 (Assert (<= size (hash-table-size ht)))
56 (Assert (eql rehash-size (hash-table-rehash-size ht))) 56 (Assert-eql rehash-size (hash-table-rehash-size ht))
57 (Assert (eql rehash-threshold (hash-table-rehash-threshold ht))) 57 (Assert-eql rehash-threshold (hash-table-rehash-threshold ht))
58 (Assert (eq weakness (hash-table-weakness ht)))))))))) 58 (Assert-eq weakness (hash-table-weakness ht)))))))))
59 59
60 (loop for (fun weakness) in '((make-hashtable nil) 60 (loop for (fun weakness) in '((make-hashtable nil)
61 (make-weak-hashtable key-and-value) 61 (make-weak-hashtable key-and-value)
62 (make-key-weak-hashtable key) 62 (make-key-weak-hashtable key)
63 (make-value-weak-hashtable value)) 63 (make-value-weak-hashtable value))
64 do (Assert (eq weakness (hash-table-weakness (funcall fun 10))))) 64 do (Assert-eq weakness (hash-table-weakness (funcall fun 10))))
65 65
66 (loop for (type weakness) in '((non-weak nil) 66 (loop for (type weakness) in '((non-weak nil)
67 (weak key-and-value) 67 (weak key-and-value)
68 (key-weak key) 68 (key-weak key)
69 (value-weak value)) 69 (value-weak value))
70 do (Assert (equal (make-hash-table :type type) 70 do (Assert-equal (make-hash-table :type type)
71 (make-hash-table :weakness weakness)))) 71 (make-hash-table :weakness weakness)))
72 72
73 (Assert (not (equal (make-hash-table :weakness nil) 73 (Assert (not (equal (make-hash-table :weakness nil)
74 (make-hash-table :weakness t)))) 74 (make-hash-table :weakness t))))
75 75
76 (let ((ht (make-hash-table :size 20 :rehash-threshold .75 :test 'eq)) 76 (let ((ht (make-hash-table :size 20 :rehash-threshold .75 :test 'eq))
77 (size 80)) 77 (size 80))
78 (Assert (hashtablep ht)) 78 (Assert (hashtablep ht))
79 (Assert (hash-table-p ht)) 79 (Assert (hash-table-p ht))
80 (Assert (eq 'eq (hash-table-test ht))) 80 (Assert-eq 'eq (hash-table-test ht))
81 (Assert (eq 'non-weak (hash-table-type ht))) 81 (Assert-eq 'non-weak (hash-table-type ht))
82 (Assert (eq 'non-weak (hashtable-type ht))) 82 (Assert-eq 'non-weak (hashtable-type ht))
83 (Assert (eq 'nil (hash-table-weakness ht))) 83 (Assert-eq 'nil (hash-table-weakness ht))
84 (dotimes (j size) 84 (dotimes (j size)
85 (puthash j (- j) ht) 85 (puthash j (- j) ht)
86 (Assert (eq (gethash j ht) (- j))) 86 (Assert-eq (gethash j ht) (- j))
87 (Assert (= (hash-table-count ht) (1+ j))) 87 (Assert= (hash-table-count ht) (1+ j))
88 (Assert (= (hashtable-fullness ht) (hash-table-count ht))) 88 (Assert= (hashtable-fullness ht) (hash-table-count ht))
89 (puthash j j ht) 89 (puthash j j ht)
90 (Assert (eq (gethash j ht 'foo) j)) 90 (Assert-eq (gethash j ht 'foo) j)
91 (Assert (= (hash-table-count ht) (1+ j))) 91 (Assert= (hash-table-count ht) (1+ j))
92 (setf (gethash j ht) (- j)) 92 (setf (gethash j ht) (- j))
93 (Assert (eq (gethash j ht) (- j))) 93 (Assert-eq (gethash j ht) (- j))
94 (Assert (= (hash-table-count ht) (1+ j)))) 94 (Assert= (hash-table-count ht) (1+ j)))
95 95
96 (clrhash ht) 96 (clrhash ht)
97 (Assert (= 0 (hash-table-count ht))) 97 (Assert= 0 (hash-table-count ht))
98 98
99 (dotimes (j size) 99 (dotimes (j size)
100 (puthash j (- j) ht) 100 (puthash j (- j) ht)
101 (Assert (eq (gethash j ht) (- j))) 101 (Assert-eq (gethash j ht) (- j))
102 (Assert (= (hash-table-count ht) (1+ j)))) 102 (Assert= (hash-table-count ht) (1+ j)))
103 103
104 (let ((k-sum 0) (v-sum 0)) 104 (let ((k-sum 0) (v-sum 0))
105 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht) 105 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
106 (Assert (= k-sum (/ (* size (- size 1)) 2))) 106 (Assert= k-sum (/ (* size (- size 1)) 2))
107 (Assert (= v-sum (- k-sum)))) 107 (Assert= v-sum (- k-sum)))
108 108
109 (let ((count size)) 109 (let ((count size))
110 (dotimes (j size) 110 (dotimes (j size)
111 (remhash j ht) 111 (remhash j ht)
112 (Assert (eq (gethash j ht) nil)) 112 (Assert-eq (gethash j ht) nil)
113 (Assert (eq (gethash j ht 'foo) 'foo)) 113 (Assert-eq (gethash j ht 'foo) 'foo)
114 (Assert (= (hash-table-count ht) (decf count)))))) 114 (Assert= (hash-table-count ht) (decf count)))))
115 115
116 (let ((ht (make-hash-table :size 30 :rehash-threshold .25 :test 'equal)) 116 (let ((ht (make-hash-table :size 30 :rehash-threshold .25 :test 'equal))
117 (size 70)) 117 (size 70))
118 (Assert (hashtablep ht)) 118 (Assert (hashtablep ht))
119 (Assert (hash-table-p ht)) 119 (Assert (hash-table-p ht))
120 (Assert (>= (hash-table-size ht) (/ 30 .25))) 120 (Assert (>= (hash-table-size ht) (/ 30 .25)))
121 (Assert (eql .25 (hash-table-rehash-threshold ht))) 121 (Assert-eql .25 (hash-table-rehash-threshold ht))
122 (Assert (eq 'equal (hash-table-test ht))) 122 (Assert-eq 'equal (hash-table-test ht))
123 (Assert (eq (hash-table-test ht) (hashtable-test-function ht))) 123 (Assert-eq (hash-table-test ht) (hashtable-test-function ht))
124 (Assert (eq 'non-weak (hash-table-type ht))) 124 (Assert-eq 'non-weak (hash-table-type ht))
125 (dotimes (j size) 125 (dotimes (j size)
126 (puthash (int-to-string j) (- j) ht) 126 (puthash (int-to-string j) (- j) ht)
127 (Assert (eq (gethash (int-to-string j) ht) (- j))) 127 (Assert-eq (gethash (int-to-string j) ht) (- j))
128 (Assert (= (hash-table-count ht) (1+ j))) 128 (Assert= (hash-table-count ht) (1+ j))
129 (puthash (int-to-string j) j ht) 129 (puthash (int-to-string j) j ht)
130 (Assert (eq (gethash (int-to-string j) ht 'foo) j)) 130 (Assert-eq (gethash (int-to-string j) ht 'foo) j)
131 (Assert (= (hash-table-count ht) (1+ j)))) 131 (Assert= (hash-table-count ht) (1+ j)))
132 132
133 (clrhash ht) 133 (clrhash ht)
134 (Assert (= 0 (hash-table-count ht))) 134 (Assert= 0 (hash-table-count ht))
135 (Assert (equal ht (copy-hash-table ht))) 135 (Assert-equal ht (copy-hash-table ht))
136 136
137 (dotimes (j size) 137 (dotimes (j size)
138 (setf (gethash (int-to-string j) ht) (- j)) 138 (setf (gethash (int-to-string j) ht) (- j))
139 (Assert (eq (gethash (int-to-string j) ht) (- j))) 139 (Assert-eq (gethash (int-to-string j) ht) (- j))
140 (Assert (= (hash-table-count ht) (1+ j)))) 140 (Assert= (hash-table-count ht) (1+ j)))
141 141
142 (let ((count size)) 142 (let ((count size))
143 (dotimes (j size) 143 (dotimes (j size)
144 (remhash (int-to-string j) ht) 144 (remhash (int-to-string j) ht)
145 (Assert (eq (gethash (int-to-string j) ht) nil)) 145 (Assert-eq (gethash (int-to-string j) ht) nil)
146 (Assert (eq (gethash (int-to-string j) ht 'foo) 'foo)) 146 (Assert-eq (gethash (int-to-string j) ht 'foo) 'foo)
147 (Assert (= (hash-table-count ht) (decf count)))))) 147 (Assert= (hash-table-count ht) (decf count)))))
148 148
149 (let ((iterations 5) (one 1.0) (two 2.0)) 149 (let ((iterations 5) (one 1.0) (two 2.0))
150 (flet ((check-copy 150 (flet ((check-copy
151 (ht) 151 (ht)
152 (let ((copy-of-ht (copy-hash-table ht))) 152 (let ((copy-of-ht (copy-hash-table ht)))
153 (Assert (equal ht copy-of-ht)) 153 (Assert-equal ht copy-of-ht)
154 (Assert (not (eq ht copy-of-ht))) 154 (Assert (not (eq ht copy-of-ht)))
155 (Assert (eq (hash-table-count ht) (hash-table-count copy-of-ht))) 155 (Assert-eq (hash-table-count ht) (hash-table-count copy-of-ht))
156 (Assert (eq (hash-table-type ht) (hash-table-type copy-of-ht))) 156 (Assert-eq (hash-table-type ht) (hash-table-type copy-of-ht))
157 (Assert (eq (hash-table-size ht) (hash-table-size copy-of-ht))) 157 (Assert-eq (hash-table-size ht) (hash-table-size copy-of-ht))
158 (Assert (eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht))) 158 (Assert-eql (hash-table-rehash-size ht) (hash-table-rehash-size copy-of-ht))
159 (Assert (eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht)))))) 159 (Assert-eql (hash-table-rehash-threshold ht) (hash-table-rehash-threshold copy-of-ht)))))
160 160
161 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eq))) 161 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eq)))
162 (dotimes (j iterations) 162 (dotimes (j iterations)
163 (puthash (+ one 0.0) t ht) 163 (puthash (+ one 0.0) t ht)
164 (puthash (+ two 0.0) t ht) 164 (puthash (+ two 0.0) t ht)
165 (puthash (cons 1 2) t ht) 165 (puthash (cons 1 2) t ht)
166 (puthash (cons 3 4) t ht)) 166 (puthash (cons 3 4) t ht))
167 (Assert (eq (hashtable-test-function ht) 'eq)) 167 (Assert-eq (hashtable-test-function ht) 'eq)
168 (Assert (eq (hash-table-test ht) 'eq)) 168 (Assert-eq (hash-table-test ht) 'eq)
169 (Assert (= (* iterations 4) (hash-table-count ht))) 169 (Assert= (* iterations 4) (hash-table-count ht))
170 (Assert (eq nil (gethash 1.0 ht))) 170 (Assert-eq nil (gethash 1.0 ht))
171 (Assert (eq nil (gethash '(1 . 2) ht))) 171 (Assert-eq nil (gethash '(1 . 2) ht))
172 (check-copy ht) 172 (check-copy ht)
173 ) 173 )
174 174
175 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eql))) 175 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'eql)))
176 (dotimes (j iterations) 176 (dotimes (j iterations)
177 (puthash (+ one 0.0) t ht) 177 (puthash (+ one 0.0) t ht)
178 (puthash (+ two 0.0) t ht) 178 (puthash (+ two 0.0) t ht)
179 (puthash (cons 1 2) t ht) 179 (puthash (cons 1 2) t ht)
180 (puthash (cons 3 4) t ht)) 180 (puthash (cons 3 4) t ht))
181 (Assert (eq (hashtable-test-function ht) 'eql)) 181 (Assert-eq (hashtable-test-function ht) 'eql)
182 (Assert (eq (hash-table-test ht) 'eql)) 182 (Assert-eq (hash-table-test ht) 'eql)
183 (Assert (= (+ 2 (* 2 iterations)) (hash-table-count ht))) 183 (Assert= (+ 2 (* 2 iterations)) (hash-table-count ht))
184 (Assert (eq t (gethash 1.0 ht))) 184 (Assert-eq t (gethash 1.0 ht))
185 (Assert (eq nil (gethash '(1 . 2) ht))) 185 (Assert-eq nil (gethash '(1 . 2) ht))
186 (check-copy ht) 186 (check-copy ht)
187 ) 187 )
188 188
189 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'equal))) 189 (let ((ht (make-hash-table :size 100 :rehash-threshold .6 :test 'equal)))
190 (dotimes (j iterations) 190 (dotimes (j iterations)
191 (puthash (+ one 0.0) t ht) 191 (puthash (+ one 0.0) t ht)
192 (puthash (+ two 0.0) t ht) 192 (puthash (+ two 0.0) t ht)
193 (puthash (cons 1 2) t ht) 193 (puthash (cons 1 2) t ht)
194 (puthash (cons 3 4) t ht)) 194 (puthash (cons 3 4) t ht))
195 (Assert (eq (hashtable-test-function ht) 'equal)) 195 (Assert-eq (hashtable-test-function ht) 'equal)
196 (Assert (eq (hash-table-test ht) 'equal)) 196 (Assert-eq (hash-table-test ht) 'equal)
197 (Assert (= 4 (hash-table-count ht))) 197 (Assert= 4 (hash-table-count ht))
198 (Assert (eq t (gethash 1.0 ht))) 198 (Assert-eq t (gethash 1.0 ht))
199 (Assert (eq t (gethash '(1 . 2) ht))) 199 (Assert-eq t (gethash '(1 . 2) ht))
200 (check-copy ht) 200 (check-copy ht)
201 ) 201 )
202 202
203 )) 203 ))
204 204
221 (let ((k-sum 0) (v-sum 0)) 221 (let ((k-sum 0) (v-sum 0))
222 (maphash #'(lambda (k v) 222 (maphash #'(lambda (k v)
223 (when (integerp k) (incf k-sum k)) 223 (when (integerp k) (incf k-sum k))
224 (when (integerp v) (incf v-sum v))) 224 (when (integerp v) (incf v-sum v)))
225 ht) 225 ht)
226 (Assert (eq 38 k-sum)) 226 (Assert-eq 38 k-sum)
227 (Assert (eq 25 v-sum))) 227 (Assert-eq 25 v-sum))
228 (Assert (eq 6 (hash-table-count ht))) 228 (Assert-eq 6 (hash-table-count ht))
229 (garbage-collect) 229 (garbage-collect)
230 (Assert (eq expected-count (hash-table-count ht))) 230 (Assert-eq expected-count (hash-table-count ht))
231 (let ((k-sum 0) (v-sum 0)) 231 (let ((k-sum 0) (v-sum 0))
232 (maphash #'(lambda (k v) 232 (maphash #'(lambda (k v)
233 (when (integerp k) (incf k-sum k)) 233 (when (integerp k) (incf k-sum k))
234 (when (integerp v) (incf v-sum v))) 234 (when (integerp v) (incf v-sum v)))
235 ht) 235 ht)
236 (Assert (eq expected-k-sum k-sum)) 236 (Assert-eq expected-k-sum k-sum)
237 (Assert (eq expected-v-sum v-sum))))) 237 (Assert-eq expected-v-sum v-sum))))
238 238
239 ;;; Test the ability to puthash and remhash the current elt of a maphash 239 ;;; Test the ability to puthash and remhash the current elt of a maphash
240 (let ((ht (make-hash-table :test 'eql))) 240 (let ((ht (make-hash-table :test 'eql)))
241 (dotimes (j 100) (setf (gethash j ht) (- j))) 241 (dotimes (j 100) (setf (gethash j ht) (- j)))
242 (maphash #'(lambda (k v) 242 (maphash #'(lambda (k v)
243 (if (oddp k) (remhash k ht) (puthash k (- v) ht))) 243 (if (oddp k) (remhash k ht) (puthash k (- v) ht)))
244 ht) 244 ht)
245 (let ((k-sum 0) (v-sum 0)) 245 (let ((k-sum 0) (v-sum 0))
246 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht) 246 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
247 (Assert (= (* 50 49) k-sum)) 247 (Assert= (* 50 49) k-sum)
248 (Assert (= v-sum k-sum)))) 248 (Assert= v-sum k-sum)))
249 249
250 ;;; Test reading and printing of hash-table objects 250 ;;; Test reading and printing of hash-table objects
251 (let ((h1 #s(hashtable weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) 251 (let ((h1 #s(hashtable weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
252 (h2 #s(hash-table weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4))) 252 (h2 #s(hash-table weakness t rehash-size 3.0 rehash-threshold .2 test eq data (1 2 3 4)))
253 (h3 (make-hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test 'eq))) 253 (h3 (make-hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test 'eq)))
254 (Assert (equal h1 h2)) 254 (Assert-equal h1 h2)
255 (Assert (not (equal h1 h3))) 255 (Assert (not (equal h1 h3)))
256 (puthash 1 2 h3) 256 (puthash 1 2 h3)
257 (puthash 3 4 h3) 257 (puthash 3 4 h3)
258 (Assert (equal h1 h3))) 258 (Assert-equal h1 h3))
259 259
260 ;;; Testing equality of hash tables 260 ;;; Testing equality of hash tables
261 (Assert (equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0) 261 (Assert-equal (make-hash-table :test 'eql :size 300 :rehash-threshold .9 :rehash-size 3.0)
262 (make-hash-table :test 'eql))) 262 (make-hash-table :test 'eql))
263 (Assert (not (equal (make-hash-table :test 'eq) 263 (Assert (not (equal (make-hash-table :test 'eq)
264 (make-hash-table :test 'equal)))) 264 (make-hash-table :test 'equal))))
265 (let ((h1 (make-hash-table)) 265 (let ((h1 (make-hash-table))
266 (h2 (make-hash-table))) 266 (h2 (make-hash-table)))
267 (Assert (equal h1 h2)) 267 (Assert-equal h1 h2)
268 (Assert (not (eq h1 h2))) 268 (Assert (not (eq h1 h2)))
269 (puthash 1 2 h1) 269 (puthash 1 2 h1)
270 (Assert (not (equal h1 h2))) 270 (Assert (not (equal h1 h2)))
271 (puthash 1 2 h2) 271 (puthash 1 2 h2)
272 (Assert (equal h1 h2)) 272 (Assert-equal h1 h2)
273 (puthash 1 3 h2) 273 (puthash 1 3 h2)
274 (Assert (not (equal h1 h2))) 274 (Assert (not (equal h1 h2)))
275 (clrhash h1) 275 (clrhash h1)
276 (Assert (not (equal h1 h2))) 276 (Assert (not (equal h1 h2)))
277 (clrhash h2) 277 (clrhash h2)
278 (Assert (equal h1 h2)) 278 (Assert-equal h1 h2)
279 ) 279 )
280 280
281 ;;; Test sxhash 281 ;;; Test sxhash
282 (Assert (= (sxhash "foo") (sxhash "foo"))) 282 (Assert= (sxhash "foo") (sxhash "foo"))
283 (Assert (= (sxhash '(1 2 3)) (sxhash '(1 2 3)))) 283 (Assert= (sxhash '(1 2 3)) (sxhash '(1 2 3)))
284 (Assert (/= (sxhash '(1 2 3)) (sxhash '(3 2 1)))) 284 (Assert (/= (sxhash '(1 2 3)) (sxhash '(3 2 1))))