Mercurial > hg > xemacs-beta

comparison tests/automated/hash-table-tests.el @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children 697ef44129c6
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
20 ;; You should have received a copy of the GNU General Public License 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 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 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 ;; 02111-1307, USA. 23 ;; 02111-1307, USA.
24 24
25 ;;; Synched up with: not in FSF Emacs. 25 ;;; Synched up with: Not in FSF.
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;;; Test database functionality 29 ;;; Test hash tables implementation
30 ;;; See test-harness.el 30 ;;; See test-harness.el
31 31
32 (condition-case err 32 (condition-case err
33 (require 'test-harness) 33 (require 'test-harness)
34 (file-error 34 (file-error
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))))