Commit 4b3e98ce authored by pfdietz's avatar pfdietz

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

parent ecac5093
;-*- 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 @@
(gethash 'x table)))
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
(classify-error (gethash))
program-error)
......@@ -47,4 +93,3 @@
(deftest gethash.error.3
(classify-error (gethash 'foo (make-hash-table) nil nil))
program-error)
......@@ -9,3 +9,7 @@
(load "hash-table-rehash-threshold.lsp")
(load "hash-table-test.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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment