maphash.lsp 4.07 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
;-*- 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
sds's avatar
sds committed
14
        (maphash #'(lambda (k v) (incf s1 k) (incf s2 v)) table))
15 16 17 18 19 20 21 22 23
       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
sds's avatar
sds committed
24
        (maphash #'(lambda (k v) (incf s1 k) (incf s2 v)) table))
25 26 27 28 29 30 31 32 33
       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
sds's avatar
sds committed
34
        (maphash #'(lambda (k v) (incf s1 k) (incf s2 v)) table))
35 36 37 38 39 40 41 42 43 44 45
       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
sds's avatar
sds committed
46 47 48 49
        (maphash #'(lambda (k v)
                     (incf s1 k) (incf s2 v)
                     (remhash k table))
                 table))
50 51 52 53 54 55 56 57 58
       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
sds's avatar
sds committed
59 60 61 62
        (maphash #'(lambda (k v)
                     (incf s1 k) (incf s2 v)
                     (remhash k table))
                 table))
63 64 65 66 67 68 69 70 71
       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
sds's avatar
sds committed
72 73 74 75
        (maphash #'(lambda (k v)
                     (incf s1 k) (incf s2 v)
                     (remhash k table))
                 table))
76 77 78 79 80 81 82 83
       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))
sds's avatar
sds committed
84
        (table (make-hash-table :test #'eq)))
85
    (loop for sym in symbols
sds's avatar
sds committed
86 87
          for i from 1
          do (setf (gethash sym table) i))
88 89 90
    (let ((sum 0))
      (values
       (multiple-value-list
sds's avatar
sds committed
91 92 93 94
        (maphash #'(lambda (k v)
                     (assert (eq (elt symbols (1- v)) k))
                     (incf sum v))
                 table))
95 96 97 98 99
       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))
sds's avatar
sds committed
100
        (table (make-hash-table :test #'eq)))
101
    (loop for sym in symbols
sds's avatar
sds committed
102 103
          for i from 1
          do (setf (gethash sym table) i))
104 105 106
    (let ((sum 0))
      (values
       (multiple-value-list
sds's avatar
sds committed
107 108 109 110 111
        (maphash #'(lambda (k v)
                     (assert (eq (elt symbols (1- v)) k))
                     (remhash k table)
                     (incf sum v))
                 table))
112 113 114 115 116 117 118 119
       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
sds's avatar
sds committed
120
        (table (make-hash-table)))
121 122 123
    (values
     (multiple-value-list
      (maphash (progn (setf x (incf i))
sds's avatar
sds committed
124 125 126
                      #'(lambda (k v) (setf dummy (list k v))))
               (progn (setf y (incf i))
                      table)))
127 128
     i x y dummy))
  (nil) 2 1 2 nil)
sds's avatar
sds committed
129

130 131 132 133

;;; Error tests

(deftest maphash.error.1
134 135
  (signals-error (maphash) program-error)
  t)
136 137

(deftest maphash.error.2
138 139
  (signals-error (maphash #'list) program-error)
  t)
140 141

(deftest maphash.error.3
142 143
  (signals-error (maphash #'list (make-hash-table) nil) program-error)
  t)