Mercurial > hg > xemacs-beta

comparison tests/automated/hash-table-tests.el @ 424:11054d720c21 r21-2-20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-20
author cvs
date Mon, 13 Aug 2007 11:26:11 +0200
parents 697ef44129c6
children
comparison
equal deleted inserted replaced
423:28d9c139be4c 424:11054d720c21
35 (when (and (boundp 'load-file-name) (stringp load-file-name)) 35 (when (and (boundp 'load-file-name) (stringp load-file-name))
36 (push (file-name-directory load-file-name) load-path) 36 (push (file-name-directory load-file-name) load-path)
37 (require 'test-harness)))) 37 (require 'test-harness))))
38 38
39 ;; Test all combinations of make-hash-table keywords 39 ;; Test all combinations of make-hash-table keywords
40 (dolist (type '(non-weak weak key-weak value-weak)) 40 (dolist (test '(eq eql equal))
41 (dolist (test '(eq eql equal)) 41 (dolist (size '(0 1 100))
42 (dolist (size '(0 1 100)) 42 (dolist (rehash-size '(1.1 9.9))
43 (dolist (rehash-size '(1.1 9.9)) 43 (dolist (rehash-threshold '(0.2 .9))
44 (dolist (rehash-threshold '(0.2 .9)) 44 (dolist (weakness '(nil t key value))
45 (dolist (data '(() (1 2) (1 2 3 4))) 45 (dolist (data '(() (1 2) (1 2 3 4)))
46 (let ((ht (make-hash-table :test test 46 (let ((ht (make-hash-table
47 :type type 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 (Assert (equal ht (car (let ((print-readably t)) 52 (Assert (equal ht (car (let ((print-readably t))
52 (read-from-string (prin1-to-string ht)))))) 53 (read-from-string (prin1-to-string ht))))))
53 (Assert (eq test (hash-table-test ht))) 54 (Assert (eq test (hash-table-test ht)))
54 (Assert (eq type (hash-table-type 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 58 (Assert (eq weakness (hash-table-weakness ht))))))))))
59 (loop for (fun type) in '((make-hashtable non-weak) 59
60 (make-weak-hashtable weak) 60 (loop for (fun weakness) in '((make-hashtable nil)
61 (make-key-weak-hashtable key-weak) 61 (make-weak-hashtable t)
62 (make-value-weak-hashtable value-weak)) 62 (make-key-weak-hashtable key)
63 do (Assert (eq type (hash-table-type (funcall fun 10))))) 63 (make-value-weak-hashtable value))
64 do (Assert (eq weakness (hash-table-weakness (funcall fun 10)))))
65
66 (loop for (type weakness) in '((non-weak nil)
67 (weak t)
68 (key-weak key)
69 (value-weak value))
70 do (Assert (equal (make-hash-table :type type)
71 (make-hash-table :weakness weakness))))
72
73 (Assert (not (equal (make-hash-table :weakness nil)
74 (make-hash-table :weakness t))))
64 75
65 (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))
66 (size 80)) 77 (size 80))
67 (Assert (hashtablep ht)) 78 (Assert (hashtablep ht))
68 (Assert (hash-table-p ht)) 79 (Assert (hash-table-p ht))
69 (Assert (eq 'eq (hash-table-test ht))) 80 (Assert (eq 'eq (hash-table-test ht)))
70 (Assert (eq 'non-weak (hash-table-type ht))) 81 (Assert (eq 'non-weak (hash-table-type ht)))
71 (Assert (eq 'non-weak (hashtable-type ht))) 82 (Assert (eq 'non-weak (hashtable-type ht)))
83 (Assert (eq 'nil (hash-table-weakness ht)))
72 (dotimes (j size) 84 (dotimes (j size)
73 (puthash j (- j) ht) 85 (puthash j (- j) ht)
74 (Assert (eq (gethash j ht) (- j))) 86 (Assert (eq (gethash j ht) (- j)))
75 (Assert (= (hash-table-count ht) (1+ j))) 87 (Assert (= (hash-table-count ht) (1+ j)))
76 (Assert (= (hashtable-fullness ht) (hash-table-count ht))) 88 (Assert (= (hashtable-fullness ht) (hash-table-count ht)))
191 ) 203 )
192 204
193 )) 205 ))
194 206
195 ;; Test that weak hash-tables are properly handled 207 ;; Test that weak hash-tables are properly handled
196 (loop for (type expected-count expected-k-sum expected-v-sum) in 208 (loop for (weakness expected-count expected-k-sum expected-v-sum) in
197 '((non-weak 6 38 25) 209 '((nil 6 38 25)
198 (weak 3 6 9) 210 (t 3 6 9)
199 (key-weak 4 38 9) 211 (key 4 38 9)
200 (value-weak 4 6 25)) 212 (value 4 6 25))
201 do 213 do
202 (let* ((ht (make-hash-table :type type)) 214 (let* ((ht (make-hash-table :weakness weakness))
203 (my-obj (cons ht ht))) 215 (my-obj (cons ht ht)))
204 (garbage-collect) 216 (garbage-collect)
205 (puthash my-obj 1 ht) 217 (puthash my-obj 1 ht)
206 (puthash 2 my-obj ht) 218 (puthash 2 my-obj ht)
207 (puthash 4 8 ht) 219 (puthash 4 8 ht)
236 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht) 248 (maphash #'(lambda (k v) (incf k-sum k) (incf v-sum v)) ht)
237 (Assert (= (* 50 49) k-sum)) 249 (Assert (= (* 50 49) k-sum))
238 (Assert (= v-sum k-sum)))) 250 (Assert (= v-sum k-sum))))
239 251
240 ;;; Test reading and printing of hash-table objects 252 ;;; 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))) 253 (let ((h1 #s(hashtable weakness t 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))) 254 (h2 #s(hash-table weakness t 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))) 255 (h3 (make-hash-table :weakness t :rehash-size 3.0 :rehash-threshold .2 :test 'eq)))
244 (Assert (equal h1 h2)) 256 (Assert (equal h1 h2))
245 (Assert (not (equal h1 h3))) 257 (Assert (not (equal h1 h3)))
246 (puthash 1 2 h3) 258 (puthash 1 2 h3)
247 (puthash 3 4 h3) 259 (puthash 3 4 h3)
248 (Assert (equal h1 h3))) 260 (Assert (equal h1 h3)))
265 (clrhash h1) 277 (clrhash h1)
266 (Assert (not (equal h1 h2))) 278 (Assert (not (equal h1 h2)))
267 (clrhash h2) 279 (clrhash h2)
268 (Assert (equal h1 h2)) 280 (Assert (equal h1 h2))
269 ) 281 )
282
283 ;;; Test sxhash
284 (Assert (= (sxhash "foo") (sxhash "foo")))
285 (Assert (= (sxhash '(1 2 3)) (sxhash '(1 2 3))))