;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Nov 28 20:08:43 2003
;;;; Contains: Tests of WITH-HASH-TABLE-ITERATOR



(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)
         (%x)
       (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)
          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))))))
  (t t t t))

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

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

(deftest with-hash-table-iterator.9
  (with-hash-table-iterator
   (%x (make-hash-table))
   (macrolet
       ((expand-%x
         (&environment env)
         (let ((expanded-form (macroexpand '(%x) env)))
           (if (equal expanded-form '(%x)) nil t))))
     (expand-%x)))
  t)

(deftest with-hash-table-iterator.10
  (let ((table (make-hash-table)))
    (loop for key from 1 to 100
          for val from 101 to 200
          do (setf (gethash key table) val))
    (let ((pairs nil))
      (with-hash-table-iterator
       (%x table)
       (loop
        (multiple-value-bind (success key val)
            (%x)
          (unless success (return nil))
          (remhash key table)
          (push (cons key val) pairs))))
      (assert (eql (length pairs) 100))
      (setq pairs (sort pairs #'(lambda (p1 p2) (< (car p1) (car p2)))))
      (values
       (hash-table-count table)
       (loop
        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))))))
  0 t)

(deftest with-hash-table-iterator.11
  (let ((table (make-hash-table)))
    (loop for key from 1 to 100
          for val from 101 to 200
          do (setf (gethash key table) val))
    (let ((pairs nil))
      (with-hash-table-iterator
       (%x table)
       (loop
        (multiple-value-bind (success key val)
            (%x)
          (unless success (return nil))
          (setf (gethash key table) (+ 1000 val))
          (push (cons key val) pairs))))
      (assert (eql (length pairs) 100))
      (setq pairs (sort pairs #'(lambda (p1 p2) (< (car p1) (car p2)))))
      (values
       (hash-table-count table)
       (loop
        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))
                    )))))
  100 t)

;;; Free declaration scope

(deftest with-hash-table-iterator.12
  (block done
    (let ((x :bad))
      (declare (special x))
      (let ((x :good))
        (with-hash-table-iterator (m (return-from done x))
                                  (declare (special x))))))
  :good)