with-hash-table-iterator.lsp 4.57 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Nov 28 20:08:43 2003
;;;; Contains: Tests of WITH-HASH-TABLE-ITERATOR

6

7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

(deftest with-hash-table-iterator.1
  (with-hash-table-iterator (x (make-hash-table)))
  nil)

(deftest with-hash-table-iterator.2
  (with-hash-table-iterator (x (make-hash-table)) (values)))

(deftest with-hash-table-iterator.3
  (with-hash-table-iterator (x (make-hash-table)) (values 'a 'b 'c 'd))
  a b c d)

(deftest with-hash-table-iterator.4
  (with-hash-table-iterator
   (%x (make-hash-table))
   (%x))
  nil)

(deftest with-hash-table-iterator.5
  (let ((table (make-hash-table)))
    (setf (gethash 'a table) 'b)
    (with-hash-table-iterator
     (%x table)
     (multiple-value-bind (success-p key val)
sds's avatar
sds committed
31
         (%x)
32 33 34 35 36 37 38 39 40 41 42 43 44 45
       (values (notnot success-p) key val))))
  t a b)

(deftest with-hash-table-iterator.6
  (let ((table (make-hash-table)))
    (setf (gethash 'a table) 'b)
    (with-hash-table-iterator
     (%x table)
     (length (multiple-value-list (%x)))))
  3)

(deftest with-hash-table-iterator.7
  (let ((keys '("a" "b" "c" "d" "e")))
    (loop for test in '(eq eql equal equalp)
sds's avatar
sds committed
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
          for test-fn of-type function = (symbol-function test)
          collect
          (let ((table (make-hash-table :test test)))
            (loop for k in keys
                  for i from 0
                  do (setf (gethash k table) i))
            (let ((count 0) (found-keys))
              (with-hash-table-iterator
               (%x table)
               (block done
                 (loop
                  (multiple-value-bind (success key val)
                      (%x)
                    (unless success (return-from done nil))
                    (incf count)
                    (push key found-keys)
                    (assert (= val (position key keys :test test-fn))))))
               (and (= count (length keys))
                    (every test-fn
                           (sort (remove-duplicates found-keys :test test)
                                 #'string<)
                           keys)
                    t))))))
69 70 71 72 73 74 75 76
  (t t t t))

(deftest with-hash-table-iterator.8
  (with-hash-table-iterator
   (%x (make-hash-table))
   (declare (optimize)))
  nil)

77 78 79 80 81 82 83
(deftest with-hash-table-iterator.8a
  (with-hash-table-iterator
   (%x (make-hash-table))
   (declare (optimize))
   (declare (optimize)))
  nil)

84 85 86 87 88
(deftest with-hash-table-iterator.9
  (with-hash-table-iterator
   (%x (make-hash-table))
   (macrolet
       ((expand-%x
sds's avatar
sds committed
89 90 91
         (&environment env)
         (let ((expanded-form (macroexpand '(%x) env)))
           (if (equal expanded-form '(%x)) nil t))))
92 93 94 95 96 97
     (expand-%x)))
  t)

(deftest with-hash-table-iterator.10
  (let ((table (make-hash-table)))
    (loop for key from 1 to 100
sds's avatar
sds committed
98 99
          for val from 101 to 200
          do (setf (gethash key table) val))
100 101 102 103
    (let ((pairs nil))
      (with-hash-table-iterator
       (%x table)
       (loop
sds's avatar
sds committed
104 105 106 107 108
        (multiple-value-bind (success key val)
            (%x)
          (unless success (return nil))
          (remhash key table)
          (push (cons key val) pairs))))
109 110 111 112 113
      (assert (eql (length pairs) 100))
      (setq pairs (sort pairs #'(lambda (p1 p2) (< (car p1) (car p2)))))
      (values
       (hash-table-count table)
       (loop
sds's avatar
sds committed
114 115 116 117 118
        for (key . val) in pairs
        for expected-key from 1
        for expected-val from 101
        always (and (eql key expected-key)
                    (eql val expected-val))))))
119 120 121 122 123
  0 t)

(deftest with-hash-table-iterator.11
  (let ((table (make-hash-table)))
    (loop for key from 1 to 100
sds's avatar
sds committed
124 125
          for val from 101 to 200
          do (setf (gethash key table) val))
126 127 128 129
    (let ((pairs nil))
      (with-hash-table-iterator
       (%x table)
       (loop
sds's avatar
sds committed
130 131 132 133 134
        (multiple-value-bind (success key val)
            (%x)
          (unless success (return nil))
          (setf (gethash key table) (+ 1000 val))
          (push (cons key val) pairs))))
135 136 137 138 139
      (assert (eql (length pairs) 100))
      (setq pairs (sort pairs #'(lambda (p1 p2) (< (car p1) (car p2)))))
      (values
       (hash-table-count table)
       (loop
sds's avatar
sds committed
140 141 142 143 144 145 146
        for (key . val) in pairs
        for expected-key from 1
        for expected-val from 101
        always (and (eql key expected-key)
                    (eql val expected-val)
                    (eql (gethash key table) (+ 1000 val))
                    )))))
147 148
  100 t)

149 150 151 152 153 154 155
;;; Free declaration scope

(deftest with-hash-table-iterator.12
  (block done
    (let ((x :bad))
      (declare (special x))
      (let ((x :good))
sds's avatar
sds committed
156 157
        (with-hash-table-iterator (m (return-from done x))
                                  (declare (special x))))))
158
  :good)