Mercurial > hg > xemacs-beta

comparison tests/automated/hash-table-tests.el @ 412:697ef44129c6 r21-2-14

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