Skip to content
Snippets Groups Projects
Commit 4b3e98ce authored by pfdietz's avatar pfdietz
Browse files

Add order tests for gethash, and tests for clrhash, remhash, and maphash.

parent ecac5093
No related branches found
No related tags found
No related merge requests found
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Nov 28 09:33:40 2003
;;;; Contains: Tests of CLRHASH
(in-package :cl-test)
(deftest clrhash.1
(let ((table (make-hash-table)))
(setf (gethash 'a table) 'b)
(values
(hash-table-count table)
(equalt (multiple-value-list (clrhash table))
(list table))
(hash-table-count table)))
1 t 0)
(deftest clrhash.2
(let ((table (make-hash-table :test 'eq)))
(setf (gethash 'a table) 'b)
(values
(hash-table-count table)
(equalt (multiple-value-list (clrhash table))
(list table))
(hash-table-count table)))
1 t 0)
(deftest clrhash.3
(let ((table (make-hash-table :test 'equal)))
(setf (gethash 'a table) 'b)
(values
(hash-table-count table)
(equalt (multiple-value-list (clrhash table))
(list table))
(hash-table-count table)))
1 t 0)
(deftest clrhash.4
(let ((table (make-hash-table :test 'equalp)))
(setf (gethash 'a table) 'b)
(values
(hash-table-count table)
(equalt (multiple-value-list (clrhash table))
(list table))
(hash-table-count table)))
1 t 0)
(deftest clrhash.5
(let ((table (make-hash-table :test 'eql)))
(setf (gethash 'a table) 'b)
(values
(hash-table-count table)
(equalt (multiple-value-list (clrhash table))
(list table))
(hash-table-count table)))
1 t 0)
;;;
(deftest clrhash.error.1
(classify-error (clrhash))
program-error)
(deftest clrhash.error.2
(classify-error (clrhash (make-hash-table) nil))
program-error)
...@@ -36,6 +36,52 @@ ...@@ -36,6 +36,52 @@
(gethash 'x table))) (gethash 'x table)))
y 1 y) y 1 y)
(deftest gethash.order.1
(let ((i 0) x y
(table (make-hash-table)))
(setf (gethash 'a table) 'b)
(values
(gethash (progn (setf x (incf i)) 'a)
(progn (setf y (incf i)) table))
i x y))
b 2 1 2)
(deftest gethash.order.2
(let ((i 0) x y z
(table (make-hash-table)))
(setf (gethash 'a table) 'b)
(values
(gethash (progn (setf x (incf i)) 'a)
(progn (setf y (incf i)) table)
(progn (setf z (incf i)) 'missing))
i x y z))
b 3 1 2 3)
(deftest gethash.order.3
(let ((i 0) x y
(table (make-hash-table)))
(values
(setf (gethash (progn (setf x (incf i)) 'a)
(progn (setf y (incf i)) table))
'b)
i x y
(gethash 'a table)))
b 2 1 2 b)
(deftest gethash.order.4
(let ((i 0) x y z
(table (make-hash-table)))
(values
(setf (gethash (progn (setf x (incf i)) 'a)
(progn (setf y (incf i)) table)
(setf z (incf i)))
'b)
i x y z
(gethash 'a table)))
b 3 1 2 3 b)
;;;; Error tests
(deftest gethash.error.1 (deftest gethash.error.1
(classify-error (gethash)) (classify-error (gethash))
program-error) program-error)
...@@ -47,4 +93,3 @@ ...@@ -47,4 +93,3 @@
(deftest gethash.error.3 (deftest gethash.error.3
(classify-error (gethash 'foo (make-hash-table) nil nil)) (classify-error (gethash 'foo (make-hash-table) nil nil))
program-error) program-error)
...@@ -9,3 +9,7 @@ ...@@ -9,3 +9,7 @@
(load "hash-table-rehash-threshold.lsp") (load "hash-table-rehash-threshold.lsp")
(load "hash-table-test.lsp") (load "hash-table-test.lsp")
(load "gethash.lsp") (load "gethash.lsp")
(load "remhash.lsp")
(load "clrhash.lsp")
(load "maphash.lsp")
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Nov 28 09:36:58 2003
;;;; Contains: Test of MAPHASH
(in-package :cl-test)
(deftest maphash.1
(let ((table (make-hash-table)))
(loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
(let ((s1 0) (s2 0))
(values
(multiple-value-list
(maphash #'(lambda (k v) (incf s1 k) (incf s2 v)) table))
s1 s2)))
(nil) #.(* 500 1001) #.(* 1000 1001))
(deftest maphash.2
(let ((table (make-hash-table :test 'equal)))
(loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
(let ((s1 0) (s2 0))
(values
(multiple-value-list
(maphash #'(lambda (k v) (incf s1 k) (incf s2 v)) table))
s1 s2)))
(nil) #.(* 500 1001) #.(* 1000 1001))
(deftest maphash.3
(let ((table (make-hash-table :test 'equalp)))
(loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
(let ((s1 0) (s2 0))
(values
(multiple-value-list
(maphash #'(lambda (k v) (incf s1 k) (incf s2 v)) table))
s1 s2)))
(nil) #.(* 500 1001) #.(* 1000 1001))
;;; Test that REMHASH on the key being traversed is allowed
(deftest maphash.4
(let ((table (make-hash-table)))
(loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
(let ((s1 0) (s2 0))
(values
(multiple-value-list
(maphash #'(lambda (k v)
(incf s1 k) (incf s2 v)
(remhash k table))
table))
s1 s2 (hash-table-count table))))
(nil) #.(* 500 1001) #.(* 1000 1001) 0)
(deftest maphash.5
(let ((table (make-hash-table :test 'equal)))
(loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
(let ((s1 0) (s2 0))
(values
(multiple-value-list
(maphash #'(lambda (k v)
(incf s1 k) (incf s2 v)
(remhash k table))
table))
s1 s2 (hash-table-count table))))
(nil) #.(* 500 1001) #.(* 1000 1001) 0)
(deftest maphash.6
(let ((table (make-hash-table :test 'equalp)))
(loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
(let ((s1 0) (s2 0))
(values
(multiple-value-list
(maphash #'(lambda (k v)
(incf s1 k) (incf s2 v)
(remhash k table))
table))
s1 s2 (hash-table-count table))))
(nil) #.(* 500 1001) #.(* 1000 1001) 0)
;;; EQ hash tables
(deftest maphash.7
(let ((symbols '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
(table (make-hash-table :test #'eq)))
(loop for sym in symbols
for i from 1
do (setf (gethash sym table) i))
(let ((sum 0))
(values
(multiple-value-list
(maphash #'(lambda (k v)
(assert (eq (elt symbols (1- v)) k))
(incf sum v))
table))
sum)))
(nil) #.(* 13 27))
(deftest maphash.8
(let ((symbols '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
(table (make-hash-table :test #'eq)))
(loop for sym in symbols
for i from 1
do (setf (gethash sym table) i))
(let ((sum 0))
(values
(multiple-value-list
(maphash #'(lambda (k v)
(assert (eq (elt symbols (1- v)) k))
(remhash k table)
(incf sum v))
table))
sum
(hash-table-count table))))
(nil) #.(* 13 27) 0)
;;; Need to add tests where things are setf'd during traversal
(deftest maphash.order.1
(let ((i 0) x y dummy
(table (make-hash-table)))
(values
(multiple-value-list
(maphash (progn (setf x (incf i))
#'(lambda (k v) (setf dummy (list k v))))
(progn (setf y (incf i))
table)))
i x y dummy))
(nil) 2 1 2 nil)
;;; Error tests
(deftest maphash.error.1
(classify-error (maphash))
program-error)
(deftest maphash.error.2
(classify-error (maphash #'list))
program-error)
(deftest maphash.error.3
(classify-error (maphash #'list (make-hash-table) nil))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Nov 28 08:58:06 2003
;;;; Contains: Tests of REMHASH
(in-package :cl-test)
(deftest remhash.1
(let ((table (make-hash-table)))
(values (gethash 'a table)
(remhash 'a table)
(setf (gethash 'a table) 'b)
(gethash 'a table)
(notnot (remhash 'a table))
(gethash 'a table)))
nil nil b b t nil)
(deftest remhash.2
(let ((table (make-hash-table :test 'eq)))
(values (gethash 'a table)
(remhash 'a table)
(setf (gethash 'a table) 'b)
(gethash 'a table)
(notnot (remhash 'a table))
(gethash 'a table)))
nil nil b b t nil)
(deftest remhash.3
(let ((table (make-hash-table :test 'equal)))
(values (gethash 'a table)
(remhash 'a table)
(setf (gethash 'a table) 'b)
(gethash 'a table)
(notnot (remhash 'a table))
(gethash 'a table)))
nil nil b b t nil)
(deftest remhash.4
(let ((table (make-hash-table :test 'equalp)))
(values (gethash 'a table)
(remhash 'a table)
(setf (gethash 'a table) 'b)
(gethash 'a table)
(notnot (remhash 'a table))
(gethash 'a table)))
nil nil b b t nil)
(deftest remhash.5
(remhash 'a (make-hash-table))
nil)
(deftest remhash.6
(notnot-mv (remhash nil (let ((table (make-hash-table)))
(setf (gethash nil table) t)
table)))
t)
(deftest remhash.order.1
(let ((i 0) x y)
(values
(remhash (progn (setf x (incf i)) 'a)
(progn (setf y (incf i)) (make-hash-table)))
i x y))
nil 2 1 2)
;;; Error tests
(deftest remhash.error.1
(classify-error (remhash))
program-error)
(deftest remhash.error.2
(classify-error (remhash 'a))
program-error)
(deftest remhash.error.3
(classify-error (remhash 'a (make-hash-table) nil))
program-error)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment