iterate-test.lisp

;;; Test cases for Iterate.

;;; Copyright (c) 2003 Andreas Fuchs <asf@boinkor.net>
;;; Copyright (c) 2004-2007 Joerg Hoehle <hoehle@users.sourceforge.net>

;;; License:
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without
;; restriction, including without limitation the rights to use, copy,
;; modify, merge, publish, distribute, sublicense, and/or sell copies
;; of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:

;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.

;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.


;;; Commentary:

;; Although growing, this testsuite does not yet cover every documented
;; feature of Iterate.

(cl:defpackage #:iterate.test
  (:import-from #+sbcl #:sb-rt
                #-sbcl #:regression-test
                #:*expected-failures*
                #-sbcl #:*expanded-eval*
                #:*compile-tests*)
  (:import-from #:iterate
                #:deprecation-warning)
  (:use #:cl #:iterate
        #+sbcl #:sb-rt
        #-sbcl #:regression-test))

(cl:in-package #:iterate.test)

(rem-all-tests)

;; This is here to document which tests are failing at the time of
;; writing. It's not used directly here, but the tests of the
;; iterate-compat package of hu.dwim.reiterate expect it.
(defvar *tests-expected-to-fail*
  '(always.finally
    never.finally
    thereis.finally
    bug/walk.2
    bug/collect-at-beginning
    #+(or clozure ecl clisp cmucl clasp)
    bug/previously-initially.1
    IN-STREAM.2
    #+(or allegro ecl) code-movement.else
    #+(or allegro ecl) code-movement.finally
    #+(or allegro ecl) code-movement.finally-protected
    #+cmucl DSETQ.3
    #+cmucl FINDING.SUCH-THAT.NEST.2
    #+cmucl UNTIL.1 
    #+cmucl COLLECT.1
    #+clasp SETF.4
    ))

(deftest dsetq.1
    (let (x y)
      (dsetq (x y) (list* 4 5 6))
      (list x y))
  (4 5))

(deftest dsetq.2
    (let (x y)
      (dsetq (x nil y) (list* 4 5 6 7))
      (list x y))
  (4 6))

(deftest dsetq.3
    (let ((a '((1 2) 3)) b)
      (dsetq (a b) a)
      (values a b))
  (1 2) 3)

(deftest dsetq.destructuring.1
    (let (x y)
      (dsetq (x . y) (list* 4 5 6))
      (list x y))
  (4 (5 . 6)))

(deftest dsetq.destructuring.2
    (let (x y z)
      (dsetq (x nil (y . z)) (list* 4 5 '(6 7 . 8) 9))
      (list x y z))
  (4 6 (7 . 8)))

(deftest dsetq.values.1
    (let (x y)
      (dsetq (values x y) (values 1 'a))
      (list x y))
  (1 a))

(deftest dsetq.values.2
    (let (x y)
      (dsetq (values x nil y) (values 1 'a "c"))
      (list x y))
  (1 "c"))

(deftest dsetq.values.3
    (let (x)
      (dsetq (values nil (nil . x)) (values 1 '(a b . c)))
      x)
  (b . c))

(deftest dsetq.values.4
    (let (x y z) (dsetq (values nil x (y z))
                        (values 1 'a '(b c))) (list x y z))
  (a b c))

;;; test that use of the deprecated "COUNT" synonym for "COUNTING"
;;; properly raises a warning, but WON'T raise it twice.
(deftest count-deprecation.1
    (let ((retval (list nil)))
      (declare (special retval))
      (handler-bind ((deprecation-warning
                       #'(lambda (w)
                           (declare (special retval))
                           (setf (car retval) t)
                           (muffle-warning w))))
        (macroexpand '(iter (repeat 9) (count 1))))
      (list retval iterate::*deprecated-clause-names*))
  ((t) nil))

;;; the deprecation warning should only appear once -- this
;;; test checks that.
(deftest count-deprecation.2
    (let ((retval (list nil)))
      (declare (special retval))
      (handler-bind ((deprecation-warning
                       #'(lambda (w)
                           (declare (special retval))
                           (setf (car retval) t)
                           (muffle-warning w))))
        (macroexpand '(iter (repeat 9) (count 1))))
      (list retval iterate::*deprecated-clause-names*))
  ((nil) nil))

(deftest repeat.1
  (iter (repeat 9) (counting 1))
  9)

(deftest repeat.2
    (iter (repeat 2.5s0) (counting t))
  3)

(deftest repeat.3
    (iter (repeat -1.5f0) (counting t))
  0)

(deftest locally.1
    (iterate (for i in '(1 2 3)) (repeat 2)
             (locally (collect i) (collect 0)))
  (1 0 2 0))

(deftest locally.2
    (iterate (for i in '(1 2 3)) (repeat 2)
             (locally
               (declare (optimize safety))
               (declare (fixnum i)) (collect i)))
  (1 2))

(deftest always.1
    (iter (repeat 3) (always 2))
  2)

(deftest always.2
    (iter (repeat 0) (always 2))
  t)

(deftest always.3
    (iter (for i in '()) (always i))
  t)

(deftest always.finally
    (with-output-to-string (*standard-output*)
      (iter (repeat 1)
            ;; When ALWAYS fails, it RETURN-FROM's from the block and
            ;; thus skips FINALLY.
            (always nil)
            (finally (princ 42))))
  "42")

(deftest never.finally
    (with-output-to-string (*standard-output*)
      (iter (repeat 1)
            ;; See comment at ALWAYS.4
            (never t)
            (finally (princ 42))))
  "42")

(deftest thereis.finally
    (with-output-to-string (*standard-output*)
      (iter (repeat 1)
            ;; See comment at ALWAYS.4
            (thereis 43)
            (finally (princ 42))))
  "42")

(deftest always.never.1
    (iterate  (repeat 2)
              (always 2)
              (never nil))
  2)

(deftest always.never.2
    (iter (for x in '(b (2 . a)))
          (if (consp x) (always (car x)) (always x))
          (never nil))
  2)

(deftest thereis.finally.1
    (iter (repeat 3) (thereis nil) (finally (prin1 "hi")))
  nil)

(deftest thereis.finally.2
    (with-output-to-string (*standard-output*) 
      (iter (repeat 3) (thereis nil) (finally (princ "hi"))))
  "hi")

(deftest thereis.finally.3
    (iter (repeat 3) (thereis nil) (finally (return 2)))
  2)

(deftest thereis.finally-protected.1
    (iter (repeat 3) (thereis 4) (finally-protected (prin1 "hi")))
  4)

(deftest thereis.finally-protected.2
    (with-output-to-string (*standard-output*) 
      (iter (repeat 3) (thereis 4) (finally-protected (princ "hi"))))
  "hi")

(deftest finding.such-that.2
    (iter (for i in '(7 -4 2 -3 4))
          (if (plusp i)
              (finding    i  such-that (evenp i))
              (finding (- i) such-that (oddp i))))
  2)

(deftest finding.such-that.nest.1
    (iter (for i in '(1 2 3))
          (finding (1+ i)
                   such-that #'(lambda (x)
                                 (declare (ignore x))
                                 (collect (- i) into m))))
  2) ; not -1 as some old version did

(deftest finding.such-that.nest.2
    (iter (for i in '(1 2 3))
          (finding (1+ i)
                   such-that #'(lambda (x)
                                 (finding (- x)
                                          such-that #'(lambda (x) x nil)
                                          into n)
                                 t)
                   into m)
          (finally (return (values m n))))
  2 nil) ; not -2 nil as some old version did

(deftest finding.thereis.1
    (iterate (for x in '(a 7 (-4 -3)))
             (thereis (consp x))
             (finding x such-that (numberp x)))
  7)

(deftest finding.thereis.2
    (iterate (for x in '(a (-4 -3) 7))
             (thereis (consp x))
             (finding x such-that (numberp x)))
  t)

(deftest finding.thereis.3
    (iterate (for x in '(a #\b))
             (thereis (consp x))
             (finding x such-that (numberp x)))
  nil)

(deftest finding.always.1
    (iterate (for x in '(-4 -2 -3))
             (always (numberp x))
             (finding x such-that (plusp x) on-failure t))
  t)

(deftest finding.always.2
    (iterate (for x in '(-4 7 -2 -3))
             (always (numberp x))
             (finding x such-that (plusp x) on-failure t))
  7)

(deftest finding.always.3
    (iterate (for x in '(-4 c -3))
             (always (numberp x))
             (finding x such-that (plusp x) on-failure t))
  nil)

(defun setup-hash-table (hash)
  (dotimes (i (random 100)) (declare (ignorable i))
        (setf (gethash (random 10000) hash) (random 10000))
        (setf (gethash (gensym) hash) (gensym))))

(deftest in-hashtable.keys
    (let* ((hash (make-hash-table))
           (all-entries (progn (setup-hash-table hash) '()))
           (generated-entries
            (iterate (for (key) in-hashtable hash)
                     (collect key))))
      (maphash (lambda (key value) value (push key all-entries)) hash)
      (= (length all-entries)
         (length generated-entries)
         (length (union all-entries generated-entries
                        :test (hash-table-test hash)))))
  t)

(deftest in-hashtable.items.1
    (let ((items nil)
          (hash (make-hash-table)))
      (setup-hash-table hash)
      (maphash (lambda (key item) key (push item items)) hash)
      (set-difference items
                      (iterate (for (key item) in-hashtable hash)
                               (declare (ignore key))
                               (collect item))))
  nil)

(deftest in-hashtable.items.2
    (let ((items nil)
          (hash (make-hash-table)))
      (setup-hash-table hash)
      (maphash (lambda (key item) key (push item items)) hash)
      (set-difference items
                      (iterate (for (nil item) in-hashtable hash)
                               (collect item))))
  nil)

(deftest in-hashtable.1
    (let* ((hash (make-hash-table))
           (all-entries (progn (setup-hash-table hash) '()))
           (generated-entries
            (iterate (as (key item) in-hashtable hash)
                     (collect (cons key item)))))
      (maphash #'(lambda (key value) (push (cons key value) all-entries)) hash)
      (= (length all-entries)
         (length generated-entries)
         (length (union all-entries generated-entries
                        :key #'car :test (hash-table-test hash)))))
  t)

(deftest in-hashtable.destructuring.1
    (let ((hash (make-hash-table :test #'equal))
          (entries '(((a . b) . (1 . 2)) (("c" . 3) . (6 . "7")))))
      (iterate (for (k . v) in entries)
               (setf (gethash k hash) v))
      (sort
       (iterate (for ((nil . k2) (v1 . v2)) in-hashtable hash)
                (always (numberp v1))
                (while k2)
                (collect (cons v1 k2) into vals)
                (finally (return vals)))
       #'< :key #'car))
  ((1 . b) (6 . 3)))

(deftest in-package.internals
    (let ((syms nil)
          (iter-syms (iterate (for sym in-package *package* :external-only nil)
                              (collect sym))))
      (do-symbols (sym *package* nil)
        (push sym syms))
      (list
       (set-difference syms iter-syms :test #'eq)
       (set-difference iter-syms syms)))
  (()()))

(deftest in-package.externals.1
    (let ((syms nil)
          (iter-syms (iterate (for sym in-package '#:cl-user external-only t)
                              (collect sym))))
      (do-external-symbols (sym '#:cl-user nil)
        (push sym syms))
      (list
       (set-difference syms iter-syms :test #'eq)
       (set-difference iter-syms syms)))
  (()()))

(deftest in-package.externals.2
    (let ((sym-count 0))
      (do-external-symbols (sym '#:iterate) (declare (ignore sym))
        (incf sym-count))
      (= sym-count
         (iterate (for () in-package '#:iterate external-only t)
                  (count 1))))
  t)

(deftest in-package.generator
    (let ((syms nil)
          (iter-syms (iterate (generate sym in-package *package*)
                              (collect (next sym)))))
      (do-symbols (sym *package*)
        (push sym syms))
      (list
       (set-difference syms iter-syms :test #'eq)
       (set-difference iter-syms syms)))
  (()()))

(deftest in-packages.external
    (let ((syms nil)
          (iter-syms (iterate (as (sym access package) in-packages '(#:cl-user)
                                   :having-access (:external))
                              (collect sym))))
      (do-external-symbols (sym '#:cl-user nil)
        (push sym syms))
      (list
       (set-difference syms iter-syms :test #'eq)
       (set-difference iter-syms syms)))
  (()()))

(deftest in-packages.generator-access
    (let ((iter-syms (iterate (generate (sym access) in-packages (list (find-package "COMMON-LISP")))
                              (repeat 1)
                              (next sym)
                              (collect (list sym access)))))
      (equal (multiple-value-list
              (find-symbol (symbol-name (caar iter-syms)) "COMMON-LISP"))
             (car iter-syms)))
  t)

(deftest in-stream.1
    (iter (as x in-stream (make-string-input-stream "#xa()2"))
          (collect x))
  (10 () 2))

(deftest in-stream.previous
    (iter (for x in-stream (make-string-input-stream "#xa()2"))
          (as p previous x :initially 1)
          (collect p))
  (1 10 ()))

(deftest in-stream.2
    ;; This fails in cmucl, sbcl and gcl, because string-input-streams
    ;; are always open, even after close.
    (let ((s (make-string-input-stream "(")))
      (ignore-errors
       (iter (for x in-stream s :using #'read)))
      (open-stream-p s))
  nil)

(deftest in-stream.3
    (iter (for c in-stream (make-string-input-stream "235")
               :using #'read-char)
          (accumulating (digit-char-p c) by #'+ initial-value 0))
  10)

(deftest in-stream.reducing
    (iter (with s = (make-string-input-stream "(+ 2)(+ 10)(- 5)(+ 6)"))
          (for (op num) in-stream s)
          (reducing num :by op :initial-value 0))
  13)

(deftest in-stream.accumulating
    (iter (with s = (make-string-input-stream "(+ 2)(+ 10)(- 5)(+ 6)"))
          (for (op num) in-stream s)
          (accumulating num :by op :initial-value 0))
  -1) ; (6 + (5 - (10 + (2 + 0))))

(deftest in-stream.generate
    (iter (with s = (make-string-input-stream "2 + 10 - 5 + 6"))
      (with start = (read s))
      (generate e in-stream s using #'read)
      (as op = (next e))
      (for arg = (next e))
      (reducing arg by op initial-value start))
  13)

(deftest in-stream.reiter
    (let ((s (make-string-input-stream "1 2 3 4 5")))
      (iter (for n below 2)
            (for line in-stream s))
      (iter (for n below 2)
            (for line in-stream s)
            (collect line)))
  (3 4))

(deftest reducing.0
    (iter (with expr = '(2 + 10 - 5 + 6))
          (with start = (pop expr))
          (for (op arg) on expr by #'cddr)
          (reducing arg by op initial-value start))
  13)

(deftest until.1
    (iter (with rest = 235) (with digit = 0)
          (multiple-value-setq (rest digit) (floor rest 10))
          (sum digit into sum)
          (multiplying digit into product)
          (until (zerop rest))
          (finally (return (values sum product))))
  10 30)
          
(deftest until.2
    (iter (for i in-sequence '#(1 2 -3 6))
          (until (zerop (sum i into x)))
          (multiplying i))
  2)

(deftest while.1
    (iter (for i in-sequence '#(1 2 -3 6))
          (while (< (length (collect i)) 2)))
  (1 2))

(deftest else.1
    (iter (repeat 0)
          (else (return 1)))
  1)

(deftest else.2
    (iter (for i below -3)
          (else (return 2)))
  2)

;;; tests for my examples:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter *an-alist* '((a . 2) (b . 3) (zero . 10) (c . 4) (one . 20) (d . 5) (e . 99)))
  (defparameter *list-of-lists* (loop for i from 0 to 100
                                      collect (loop for len from 0 to (random 20)
                                                    collect len)))
  (defun longest-list (list1 list2)
    (if (< (length list2) (length list1))
        list1
        list2)))

(deftest collect.1
    (iterate (as (key . item) in *an-alist*)
             (collect key into keys)
             (collect item into items)
             (finally (return (values keys items))))
  #.(loop for (key . nil) in *an-alist*
        collect key)
  #.(loop for (key . item) in *an-alist*
        collect item))

(deftest generate.1
    (iterate (generate i from 0 to 6)
             (for (key . value) in *an-alist*)
             (when (>= value 10)
               (collect (cons key (next i)))))
  #.(loop with counter = 0
        for (key . value) in *an-alist*
        when (>= value 10)
           collect (cons key (prog1 counter (incf counter)))))

(deftest find-longest-list.1
    (iterate (for elt in *list-of-lists*)
             (finding elt maximizing (length elt)))
  #.(reduce #'longest-list *list-of-lists*))

(deftest find-longest-list.2
    (iterate (for elt in *list-of-lists*)
             (finding elt maximizing (length elt) into (e m))
             (finally (return m)))
  #.(reduce #'max *list-of-lists* :key #'length))

(deftest find-longest-list.3
    (iterate (for elt in *list-of-lists*)
             (finding elt maximizing #'length))
  #.(reduce #'longest-list *list-of-lists*))

(deftest find-longest-list.4
    (iterate (for elt in *list-of-lists*)
             (finding elt maximizing #'length into (e m))
             (finally (return m)))
  #.(reduce #'max *list-of-lists* :key #'length))

(deftest maximize.1
    (iterate (for elt in *list-of-lists*)
             (maximizing (length elt) into m)
             (finally (return m)))
  #.(reduce #'max *list-of-lists* :key #'length))

(deftest maximize.2
    (iterate (for elt in *list-of-lists*)
             (maximize (length elt)))
  #.(reduce #'max *list-of-lists* :key #'length))

(deftest finding.minimizing.1
    (iterate (for elt in *list-of-lists*)
             (finding elt minimizing #'length into (e m))
             (finally (return m)))
  #.(reduce #'min *list-of-lists* :key #'length))

(deftest minimize.1
    (iterate (for elt in *list-of-lists*)
             (minimizing (length elt) into m)
             (finally (return m)))
  #.(reduce #'min *list-of-lists* :key #'length))

(deftest minimize.2
    (iterate (for elt in *list-of-lists*)
             (minimize (length elt)))
  #.(reduce #'min *list-of-lists* :key #'length))

(deftest subblocks.maximize.1
    (iter outer (for elt in *list-of-lists*)
          (iterate running (for e in elt)
                   (in outer (maximize e)))
          (maximizing (length elt)))
  #.(reduce #'max *list-of-lists* :key #'length))

(deftest subblocks.minimize.1
    (iter outer (for elt in *list-of-lists*)
          (minimizing (length elt))
          (iterate running (for e in elt)
                   (in outer (minimize e))))
  0)

(deftest maximize.3
    (iterate (for i in-vector '#(-3))
             (maximize i))
  -3)

(deftest minimize.3
    (iterate (as i in-vector '#(3))
             (minimize i))
  3)

(deftest maximize.multiple
    (iter (as i from 3 downto -3 by 2) (maximize i)
          (for j from -1)            (maximizing j))
  3)

(deftest minimize.multiple
    (iter (as i from -3 to 3 by 2) (minimize i into x)
          (for j downfrom -1)    (minimizing j into x)
          (finally (return x)))
  -4)

(deftest accumulate.1
    (iter (for c in-string "235")
          (declare (type character c))
          (accumulate (digit-char-p c) by '* initial-value 1))
  30)

(deftest accumulate.2
    (iter (for c in-sequence "235")
          (accumulating (digit-char-p c) by #'* initial-value 1))
  30)

(deftest accumulate.3
    (iter (for c in-sequence "235")
          (accumulate (digit-char-p c) by 'cons initial-value 1))
  (5 3 2 . 1))

(deftest accumulate.4
    (iter (for c in-vector "235")
          (accumulating (digit-char-p c) by #'cons))
  (5 3 2))

(deftest accumulate.5
    (iter (repeat 0)
          (accumulating 1 by #'cons))
  nil)

(deftest accumulate.6
    (iter (repeat 0)
          (accumulate 1 by #'cons initial-value 2))
  2)

(deftest in-string.downto.1
    (iter (for c in-string "235" downto 1)
          (accumulate (digit-char-p c) by 'cons))
  (3 5))

(deftest in-sequence.downto.1
    (iter (for c in-sequence "235" downto 1)
          (accumulate (digit-char-p c) by #'cons))
  (3 5))

(deftest reducing.1
    (iter (for c in-string "235")
          (reducing (digit-char-p c) by 'list initial-value 1))
  (((1 2) 3) 5))

(deftest reducing.2
    (iter (as x index-of-string "235")
          (reducing x :by #'list initial-value -1))
  (((-1 0) 1) 2))

(deftest reducing.3
    (iter (repeat 0)
          (reducing 1 #:by 'cons initial-value -1))
  -1)

(deftest reducing.4
    (iter (for i from 3 to 5)
          (reducing i by #'- :initial-value '0))
  -12)

(deftest reducing.5
    (iter (for x in-vector #(3))
          (reducing (cons x x) by #'list))
  (3 . 3))

(deftest reducing.6
    (iter (for x in-vector (vector 3))
          (reducing (cons x x) by #'list :initial-value nil))
  (nil (3 . 3)))


;; synonyms (e.g. GENERATING, COLLECTING) didn't work

(deftest generate.destructuring.1
    (iter (generate (key . item) in '((a . 1) (b . 2) (c .3)))
          (collect (next key))
          (collect (next item)))
  (a 2 c))

(deftest generating.destructuring.1
    (iter (generating (key . item) in '((a . 1) (b . 2) (c .3)))
          (collect (next key))
          (collect (next item)))
  (a 2 c))

(deftest for.generate-t.destructuring.1
    (iter (for (key . item) in '((a . 1) (b . 2) (c .3)) :generate t)
          (collect (next key))
          (collect (next item)))
  (a 2 c))

(deftest generate.next.1
    (iter (generate c in '(a b c d e f g h i j k l m n o p q))
          (for s in '(1 1 2 3 1 0 1 0 2 1))
          (collect (next c s)))
  (a b d g h h i i k l))

(deftest generate.previous.1
    (iter (generate c in '(a b c d e f g h i j k l m n o p q))
          (for s in '(1 1 2 3 1 0 1 0 2 1))
          (for x = (next c s))
          (as y previous x)
          (collect (list y x)))
  ((nil a) (a b) (b d) (d g) (g h) (h h) (h i) (i i) (i k) (k l)))

(deftest generate.next.2
    (with-output-to-string (*standard-output*)
      (iter (generate i in '(1 2 3 4 5)) (princ (next i 2))))
  "24")

(deftest if.1
    (iter (generate x in-vector '#(t nil nil t))
          (as i from 0)
          (if (next x) (collect i)))
  (0 3))

(deftest if.2
    (iter (generate x in-vector '#(t nil nil t) with-index i)
          (if (next x) (collect i)))
  (0 3))

(deftest or.1
    (iter (generate x in '(a nil nil 1))
          (generate y in-vector '#(2 #\c #\d))
          (collect (or (next x) (next y))))
  (a 2 #\c 1))

(deftest or.2
    (iter (generate x in '(a nil nil 1 nil))
          (generate y in-sequence '#(2 nil #\c #\d))
          (collect (or (next x) (next y) 3)))
  (a 2 3 1 #\c))

(deftest setf.1
    (iter (generate i from 0 to 3)
          (with v = (vector 'a 'b 'c 'd))
          (setf (aref v (next i)) i)
          (finally (return v)))
  #(0 1 2 3))

(deftest setf.2
    ;; These setf tests fail in CormanLisp 2.0 because ccl does
    ;; not respect setf evaluation order rules.
    (iter (generate i from 0 to 3)
          (with v = (vector 'a 'b 'c 'd))
          (setf (aref v (next i)) (next i))
          (finally (return v)))
  #(1 b 3 d))

(deftest setf.3
    (iter (generate i in '(0 1 2 3 4 5))
          (with v = (vector 'a 'b 'c 'd))
          (setf (aref v (next i)) (next i 2))
          (finally (return v)))
  #(2 b c 5))

(deftest setf.4
    (iter (generate i from 0 to 3)
          (with v = (vector 'a 'b 'c 'd))
          (setf (apply #'aref v (list (next i))) (next i))
          (finally (return v)))
  #(1 b 3 d))

(deftest after-each.1
    (iter (after-each (collecting 0))
          (generate i in '(a b c))
          (adjoining (next i)))
  (a 0 b 0 c 0))

(deftest after-each.2
    (iter (with i = 0)
          (while (< i 4))
          (after-each (incf i)) ; the C programmer's for (;;) loop
          (collect i))
  (0 1 2 3))

(deftest after-each.3
    (iter (with i = 0)
          (while (< i 4))
          (collect i)
          (after-each (incf i)))
  (0 1 2 3))

(deftest next-iteration.1
    (iter (for i below 10)
          (when (oddp i) (next-iteration))
          (count t))
  5)

(deftest next-iteration.2
    (iter (for thing in '(var &optional else &key (test #'eql)))
          (collect
           (cond ((consp thing) (first thing))
                 ((not (member thing lambda-list-keywords)) thing)
                 (t (next-iteration)))))
  (var else test))

;;;; tests from the documentation:

(deftest collect.2
    (iter (for i from 1 to 10)
          (collect i))
  (1 2 3 4 5 6 7 8 9 10))

(deftest for-in.2
    (iter (for el in '(1 2 3 4 5 6 f 7 8 9 a 10))
          (if (and (numberp el) (oddp el))
              (collect el)))
  (1 3 5 7 9))

(deftest for.destructuring.1
    (iter (for (key . item) in '((a . 10) (b . 20) (c . 30)))
          (for i from 0)
          (declare (fixnum i))
          (collect (cons i key)))
  ((0 . a) (1 . b) (2 . c)))

(deftest repeat.0
    (with-output-to-string (*standard-output*)
      (iter (repeat 100)
            (print "I will not talk in class.")))
  #.(with-output-to-string (*standard-output*)
      (dotimes (i 100)
        (declare (ignorable i)) ; cmucl/sbcl complain about (ignore i)
        (print "I will not talk in class."))))

;;; for.next.1 and for.do-next.1 used to be broken in older versions;
;;; they didn't WALK their NEXT args.
(deftest for.next.1
    (iterate (initially (setq i 0))
             (for i next (if (> i 10) (terminate) (1+ i)))
             (finally (return i)))
  11)

;;; This gave STYLE-WARNINGS for undefined i in old versions.
(deftest for.do-next.1
    (iterate (initially (setq i 0))
             (as i do-next (if (> i 10) (terminate) (incf i)))
             (finally (return i)))
  11)

(deftest for.do-next.2
    ;; INITIALLY not needed because 0 is inferred from type declaration
    (iterate (for i do-next (if (> i 7) (terminate) (incf i)))
             (declare (type fixnum i))
             (finally (return i)))
  8)

(deftest for.do-next.3
    (iter (for a from 1 to 3)
          (for b = (1+ (* a a)))
          ;; (values ...) is supported, even though (x y) would do
          (for (values x y) do-next (dsetq (values x y) (floor b a)))
          (collect x) (collect y))
  (2 0 2 1 3 1))

(deftest for.next.walk
    (iter (repeat 2)
          (for x next (progn (after-each (collect 1)) 2))
          (collect x))
  (2 1 2 1))

(deftest for.do-next.walk
    (iter (repeat 2)
          (for x do-next (progn (after-each (collect 1)) (dsetq x 2)))
          (collect x))
  (2 1 2 1))

(deftest for.next.previous
    (iter (for i from 2 to 4)
          (for x next (progn (after-each (collect i)) (- i)))
          (for z previous x initially 0)
          (nconcing (list z x)))
  (0 -2 2 -2 -3 3 -3 -4 4))

(deftest for.do-next.previous
    (iter (for i from 2 to 4)
          (for x do-next (progn (setq x (- i)) (after-each (collect i))))
          (for z previous x initially 0)
          (appending (list z x)))
  (0 -2 2 -2 -3 3 -3 -4 4))

(deftest for-nongenerator.1
    (iter (for el in '(a b c d))
          (generate i upfrom 1)
          (if el (collect (cons el (next i)))))
  #.(iter (for el in '(a b c d))
          (for i upfrom 1)
          (if el (collect (cons el i)))))
  

(deftest for.previous.in
    (iter (for el in '(1 2 3 4))
          (for pp-el previous el back 2 initially 0)
          (collect pp-el))
  (0 0 1 2))

(deftest for.previous.type.1
    (iter (for el in '(1 2 3 4))
          (declare (type integer el))
          (for pp-el previous el back 2)
          (collect pp-el))
  (0 0 1 2))

(deftest for.previous.index-of-string.1
    (iter (as x index-of-string "235")
          (as p previous x :initially 9)
          (collecting p))
  (9 0 1))

(deftest for.previous.in-string.with-index
    (iter (as x in-string "235" :with-index y)
          (as p previous y :initially 9)
          (collecting p))
  (9 0 1))

(deftest for.previous.index-of-vector
    (iter (as x index-of-vector '#(2 3 4 5))
          (as p previous x :initially 9 back 2)
          (collecting p))
  (9 9 0 1))

(deftest for.previous.in-vector.with-index
    (iter (as x in-vector '#(2 3 4 5) with-index y)
          (as p previous y :initially 9 back 2)
          (collecting p))
  (9 9 0 1))

(deftest for.previous.var-with-type-declaration
    (iter (for i from 1 to 5)
          (for (the fixnum i-prev) previous i)
          (collect i-prev))
  (nil 1 2 3 4))

(deftest for.first.1
    (iter (for num in '(20 19 18 17 16))
          (for i first num then (1+ i))
          (collect i))
  (20 21 22 23 24))

(deftest for.initially.1
    (iter (with (v z))
          (for i initially (length v) then (1+ i))
          (collect (cons i z))
          (while (evenp i)))
  ((0) (1)))

(deftest sum.1
    (iter (for el in '(100 200 300))
          (sum el into x)
          (declare (fixnum x))
          (finally (return x)))
  600)

(deftest collect.3
    (iter (for i from 1 to 5)
          (collect i))
  (1 2 3 4 5))

(deftest collect.4
    (iter (for i from 1 to 5)
          (collect i at beginning))
  (5 4 3 2 1))

(deftest collect.5
    (iter (for i from 1 to 4)
          (collect i at :end))
  (1 2 3 4))

(deftest collect.6
    (iter (for i from 1 to 3)
          (collect i :at start))
  (3 2 1))

(deftest collect-by.1
    (iter (for i downfrom 10 by 2) (repeat 3)
          (collect i))
  (10 8 6))

(deftest in-vector.by.1
    (iter (for i in-vector '#(0 1 2 3 4) by 2)
          (collect i))
  (0 2 4))

(deftest index-of-vector.by.1
    (iter (for i index-of-vector '#(0 1 2 3 4) by 2)
          (collect i))
  (0 2 4))

(deftest in-vector.downto.1
    (iter (for i in-vector '#(0 1 2 3 4) downto 0)
          (collect i))
  (4 3 2 1 0))

(deftest index-of-vector.downto.1
    (iter (for i index-of-vector #(0 1 2 3 4) downto 0)
          (collect i))
  (4 3 2 1 0))

(deftest in-vector.downto.2
    (iter (for i in-vector '#(0 1 2 3 4) downto 0 by 2)
          (collect i))
  (4 2 0)) ; erroneously got (3 1) in some past

(deftest index-of-vector.downto.2
    (iter (for i index-of-vector #(0 1 2 3 4) downto 0 by 2)
          (collect i))
  (4 2 0))

(deftest generate.in-vector.downto.1
    (iter (generate i in-vector #(0 1 2 3 4) downto 0 by 2)
          (collect (next i)))
  (4 2 0))

(deftest generate.index-of-vector.downto.1
    (iter (generate i index-of-vector '#(0 1 2 3 4) downto 0 by 2)
          (collect (next i)))
  (4 2 0))

(deftest if-first-time.1
    (with-output-to-string (*standard-output*)
      (iter (for i from 200 to 203)
            (if-first-time (format t "honka"))))
  "honka")

(deftest if-first-time.2
    (with-output-to-string (*standard-output*)
      (iter (for i from 200 to 204)
            (if (oddp i) (if-first-time (princ "honka") (princ "tah")))))
  "honkatah")

(deftest if-first-time.3
    (iter (for i to 5)
          (when (oddp i)
            (if-first-time nil (collect -1))
            (collect i)))
  (1 -1 3 -1 5))

(deftest first-time-p.0
    (with-output-to-string (*standard-output*)
      (iter (for el in '(nil 1 2 nil 3))
            (when el
              (unless (first-time-p)
                (princ ", "))
              (princ el))))
  "1, 2, 3")

(deftest first-time-p.1
    (iter (for i to 5)
          (if (first-time-p) (collect -1))
          (if (first-time-p) (collect -2))
          (when (oddp i)
            (if (first-time-p) nil (collect -1))
            (collect i)))
  (-1 -2 1 -1 3 -1 5))

(deftest first-iteration-p.1
    (iter (for i to 5)
          (if (first-iteration-p) (collect -1))
          (if (first-iteration-p) (collect -2))
          (when (oddp i)
            (if (first-iteration-p) nil (collect -1))
            (collect i)))
  (-1 -2 -1 1 -1 3 -1 5))

(deftest collect.multiple.1
    (iter (for i from 1 to 10)
          (collect i into nums)
          (collect (sqrt i) into nums)
          (finally (return nums)))
  #.(loop for i from 1 to 10
          collect i
          collect (sqrt i)))

(deftest collect.type.string.1
    (locally (declare (optimize safety (debug 2) (speed 0) (space 1)))
      (iter (declare (iterate:declare-variables))
            (for s in-vector '#(\a |b| |cD|))
            (collect (char (symbol-name s) 0) :result-type string)))
  "abc")

(deftest collect.type.string.2
    (iter (for c in-stream (make-string-input-stream "aBc") :using #'read-char)
          (when (digit-char-p c 16)
            (collect c :result-type string)))
  "aBc")

(deftest collect.type.string.3
    (iter (for c in-string "235" downfrom 1)
          (collect c into s result-type string)
          (finally (return s)))
  "32")

(deftest collect.type.vector.1
    (locally (declare (optimize safety (debug 2) (speed 0) (space 1)))
      (iter (declare (iterate:declare-variables))
            (for s in-vector '#(\a |b| |cD|))
            (collect (char (symbol-name s) 0) :result-type vector)))
  #(#\a #\b #\c))

(deftest collect.type.vector.2
    (iter (for c in-vector "235" downfrom 1)
          (collect (digit-char-p c) :into v :result-type vector)
          (finally (return v)))
  #(3 2))

(deftest adjoin.1
    (iter (for i in '("ab" "aB" "abc" "AB"))
          (adjoining i at :start :test #'string-equal))
  ("abc" "ab"))

(deftest adjoin.2
    (iter (for i in '("ab" "aB" "abc" "AB"))
          (adjoining i at :start))
  ("AB" "abc" "aB" "ab"))

(deftest adjoin.3
    (iter (for i in '("ab" "aB" "abc" "AB"))
          (adjoining i :at end #:test #'string-equal))
  ("ab" "abc"))

(deftest adjoin.4
    (iter (for i in '("ab" "aB" "abc" "AB"))
          (adjoining i at :end))
  ("ab" "aB" "abc" "AB"))

(deftest adjoin.5
    (iter (for i in '("ab" "aB" "abc" "AB"))
          (adjoining (string-downcase i) at :start :test #'string-equal))
  ("abc" "ab"))

(deftest adjoin.6
    (iter (for i in '("ab" "aB" "abc" "AB"))
          (adjoining (string-upcase i) #:at :end test #'string=))
  ("AB" "ABC"))

(deftest append.1
    (iter (for l on '(1 2 3))
          (appending l at :start))
  (3 2 3 1 2 3))

(deftest nconc.1
    (iter (for l on (list 1 2 3))
          (nconcing (copy-list l) at :beginning))
  (3 2 3 1 2 3))

(deftest append.2
    (iter (for l on '(1 2 3))
          (appending l :at #:end))
  (1 2 3 2 3 3))

(deftest nconc.2
    (iter (for l on (list 1 2 3))
          (nconcing (copy-list l) at end))
  (1 2 3 2 3 3))

(deftest append.3
    (iter (for l on '(1 2 3))
          (appending l into x) (finally (return x)))
  (1 2 3 2 3 3))

(deftest nconc.3
    (iter (for l on (list 1 2 3))
          (nconcing (copy-list l) into x) (finally (return x)))
  (1 2 3 2 3 3))

(deftest append.4
    (iter (for l on '(1 2 3))
          (appending l into x))
  nil)

(deftest nconc.4
    (iter (for l on (list 1 2 3))
          (nconcing (copy-list l) into x))
  nil)

(deftest append.5
    (iter (for l on '(1 2 3))
          (appending l :at #:end)
          (collect (first l)))
  (1 2 3 1 2 3 2 3 3))

(deftest append.6
    (iter (for l on '(1 2 3))
          (appending l :at :end)
          (collect l))
  (1 2 3 (1 2 3) 2 3 (2 3) 3 (3)))

(deftest nconc.5
    (iter (for l on (list 1 2 3))
          (collect (first l))
          (nconcing (copy-list l) at end))
  (1 1 2 3 2 2 3 3 3))

(deftest union.1
    (iter (for l on '(a b c))
          (unioning l)
          (collect (first l)))
  (a b c a b c))

(deftest union.2
    (iter (for l on '(a b c))
          (collecting (first l))
          (unioning l :test #'eql))
  (a b c b c))

(deftest union.3
    (iter (for l in-vector '#("a" "A" "aB" "ab" "AB"))
          (unioning (list l) :test #'string-equal))
  ("a" "aB"))

(deftest nunion.3
    (iter (for l in-vector '#("a" "A" "aB" "ab" "AB"))
          (nunioning (list l) :test #'string-equal :at :start))
  ("aB" "a"))

(deftest value.minimize
    (iter (for i from 4 downto -3 by 3)
          (collect (minimize (* i i) into foo)))
  (16 1 1))

(deftest value.maximize
    (iter (for i from 3 to 5)
          (sum (maximize (- i 2) into foo)))
  6)

(deftest value.finding-maximizing.1
    (iter (for i from 3 to 6)
          (adjoining (finding (* i i) maximizing #'integer-length
                              :into foo) :test #'=))
  (9 16 36))

(deftest value.finding-maximizing.2
    (iter (for i from 3 to 6)
          (adjoining (finding (* i i) maximizing (integer-length i)
                              :into foo) :test #'=))
  (9 16))

(deftest walk.counting
    (iter (for i from 3 to 5)
          (counting (if-first-time nil t)))
  2)

(deftest value.counting
    (iter (for x in-sequence '#(nil t nil t))
          (collect (counting x into foo)))
  (0 1 1 2))

(deftest value.adjoining
    (iter (for i from 3 to 5)
          (sum (length (adjoining i into foo))))
  6)

(deftest value.collecting
    (iter (for i from 3 to 5)
          (collect (copy-list (collecting i :into foo at #:start))
                   :at end))
  ((3) (4 3) (5 4 3)))

(deftest value.accumulate
    (iter (for c in-string "245")
          (collect (accumulate (digit-char-p c) by #'+
                               :initial-value 0 into s) into l)
          (finally (return (cons s l))))
  (11 2 6 11))

(deftest value.always
    (iter (for i from -3 downto -6 by 2)
          (summing (always i) into x)
          (finally (return x)))
  -8)

(deftest dotted.1
    (iter (for l on '(1 2 . 3))
          (collect l))
  ((1 2 . 3) (2 . 3)))

(deftest dotted.2
    (iter (for (e) on '(1 2 . 3))
          (collect e))
  (1 2))

(deftest dotted.3
    (values (ignore-errors (iter (for i in '(1 2 . 3)) (count t))))
  nil)

(deftest dotted.4
    (iter (for i in '(1 1 2 3 . 3)) (thereis (evenp i)))
  t)

(deftest dotted.5
    (iter (for i in '(1 2 . 3)) (thereis (evenp i)))
  t)

(deftest walk.multiple-value-bind
    (string-upcase
     (iter (for name in-vector (vector 'iterate "FoOBaRzOt" '#:repeat))
           (multiple-value-bind (sym access)
               (find-symbol (string name) #.*package*)
             (declare (type symbol sym))
             (collect (if access (char (symbol-name sym) 0) #\-)
                      result-type string))))
  "I-R")

(deftest subblocks.1
    (iter fred
          (for i from 1 to 10)
          (iter barney
                (for j from i to 10)
                (if (> (* i j) 17)
                    (return-from fred j))))
  9)

(deftest subblocks.wrong.1
    (let ((ar #2a((1 2 3)
              (4 5 6)
              (7 8 9))))
      (iter (for i below (array-dimension ar 0))
            (iter (for j below (array-dimension ar 1))
                  (collect (aref ar i j)))))
  nil)
  
(deftest subblocks.2
    (let ((ar #2a((1 2 3)
                  (4 5 6)
                  (7 8 9))))
      (iter outer (for i below (array-dimension ar 0))
            (iter (for j below (array-dimension ar 1))
                  (in outer (collect (aref ar i j))))))
  (1 2 3 4 5 6 7 8 9))

(deftest destructuring.1
    (iter (for (values (a . b) c)
               = (funcall #'(lambda () (values (cons 1 'b) 2))))
          (leave (list a b c)))
  (1 b 2))

(deftest leave
    (iter (for x in '(1 2 3))
          (if (evenp x) (leave x))
          (finally (error "not found")))
  2)

(deftest nil.block.names
    (iter (for x in '(1 2 3))
	  (dolist (y '(5 3 4))
	    (when (= x y)
	      (leave x)))
	  (finally (error "not found")))
  3)

(deftest lambda
    (iter (for i index-of-sequence "ab")
          (collecting ((lambda(n) (cons 1 n)) i)))
  ((1 . 0) (1 . 1)))

(deftest type.1
    (iter (for el in '(1 2 3 4 5))
          (declare (fixnum el))
          (counting (oddp el)))
  3)

(deftest type.2
    (iter (for (the fixnum el) in '(1 2 3 4 5))
          (counting (oddp el)))
  3)

(deftest type.3
    (iter (declare (iterate:declare-variables))
          (for el in '(1 2 3 4 5))
          (count (oddp el) into my-result)
          (declare (integer my-result))
          (finally (return my-result)))
  3)

(deftest type.4
    (iter (declare (iterate:declare-variables))
          (for i from 1 to 10)
          (collect i))
  (1 2 3 4 5 6 7 8 9 10))

(deftest type.5
    (iter (declare (iterate:declare-variables))
          (repeat 0)
          (minimize (the fixnum '1)))
  0)

(deftest type.6
    (iter (declare (iterate:declare-variables))
          (repeat 0)
          (maximize 1))
  0)

(deftest type.7
    (iter (declare (iterate:declare-variables))
          (repeat 0)
          (minimize (the double-float '1.0d0)))
  0.0d0)

;;; this test catches problems with make-initial-value, which cannot find a good initial
;;; value for cases where the initial value should be NIL.  This causes generation of a
;;; spurious warning.
(deftest type.8
    (catch 'warned
      (handler-bind ((simple-warning #'(lambda (w) (throw 'warned (format nil "~a" w))))
                     (error #'(lambda (w) (throw 'warned (format nil "~a" w)))))
        (let ((vec (vector (make-instance 'polar :mag 2) (make-instance 'polar :mag 4))))
          (nth-value 1
                     (iter (for x in-vector vec with-index i)
                       (declare (type (or null polar) x) (type fixnum i))
                       (with-slots (rho) x
                         (finding x such-that (= rho 4) into target))
                       (finally (return (values target i))))))))
  1)

;;; test that counting result-type uses an initform of the appropriate type.
(deftest type.9
    (iter (declare (iterate:declare-variables))
          (repeat 0)
          (counting t result-type double-float))
  0d0)

;;; test that sum result-type uses an accumulator of the appropriate type.
(deftest type.10
    (iter (declare (iterate:declare-variables))
          (repeat 2)
          (sum most-positive-fixnum result-type integer))
  #.(* 2 most-positive-fixnum))

;;; test that multiply result-type uses an accumulator of the appropriate type.
(deftest type.11
    (iter (declare (iterate:declare-variables))
          (for n in (list most-positive-fixnum 2))
          (multiply n result-type integer))
  #.(* 2 most-positive-fixnum))

;;; test that reducing result-type with an initform doesn't error
(deftest type.12
    (iter (declare (iterate:declare-variables))
          (for i from 1 to 4)
          (reducing i by #'+ result-type fixnum))
  10)

;;; test that reducing result-type uses an initform of the appropriate type.
;; the manual says that this behavior is undefined, but it does work, and it's necessary
;; for sbcl to generate efficient numeric reductions without throwing a fit.
(deftest type.13
    (iter (declare (iterate:declare-variables))
          (repeat 0)
          (reducing 0d0 by #'+ result-type double-float))
  0d0)

(deftest static.error.1
    (values
     (ignore-errors ; Iterate complains multiple values make no sense here
      (macroexpand-1 '(iter (for (values a b) in '(1 2 3)))) t))
  nil)

(deftest code-movement.1
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((x 3))
                           (initially (setq x 4))
                           (return x))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  t)

(deftest code-movement.2
        (handler-case (macroexpand '
                       (iter (for i from 1 to 10)
                             (let ((x 3))
                               (collect i into x))))
          (error () t)
          (:no-error (f x) (declare (ignore f x)) nil))
  t)

(deftest code-movement.3
    (iter (with x = 3)
          (for el in '(0 1 2 3))
          (setq x 1)
          (reducing el by #'+ initial-value x))
  9 ; not 7
  )

(deftest code-movement.else
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((x 3))
                           (else (return x)))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  t)

(deftest code-movement.after-each
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((y i))
                           (after-each (princ y)))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  t)

(deftest code-movement.declare.1
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((y i))
                           (declare (optimize safety))
                           (after-each (princ y)))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  t)

(deftest code-movement.declare.2
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((safety i))
                           (after-each
                             (let ()
                               (declare (optimize safety))
                               (princ i))))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  nil)

(deftest code-movement.locally.1
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((y i))
                           (else (locally (princ y))))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  t)

(deftest code-movement.locally.2
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((y i))
                           (else (locally (princ i))))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  nil)

(deftest code-movement.initially
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((y i))
                           (initially (princ y)))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  t)

(deftest code-movement.finally
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((y i))
                           (finally (return y)))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  t)

(deftest code-movement.finally-protected
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (let ((y i))
                           (finally-protected (return y)))))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  t)

(deftest static.conflict.1
    (handler-case (macroexpand '
                   (iter (for i from 1 to 10)
                         (collect i) (sum i)))
      (error () t)
      (:no-error (f x) (declare (ignore f x)) nil))
  t)

;;; 2005: I'm considering making this shadowing feature unspecified (and
;;; removing the test), because it takes away implementation freedom of
;;; choosing to reimplement Iterate's own clauses via macrolet or defmacro.
(deftest macro.shadow.clause
    (macrolet ((multiply (expr)
                 `(reducing ,expr :by #'+ :initial-value 0)))
      (iter (for el in '(1 2 3 4))
            (multiply el)))
  10)

(deftest multiply.1
    (iter (for el in '(1 2 3 4))
          (multiply el))
  24)

(defmacro sum-of-squares (expr)
  (let ((temp (gensym)))
    `(let ((,temp ,expr))
       (sum (* ,temp ,temp)))))

(deftest sum-of-squares.1
    (iter (for el in '(1 2 3))
          (sum-of-squares el))
  14)

(deftest defmacro-clause.1
    (defmacro-clause (multiply.clause expr &optional INTO var)
        "from testsuite"
      `(reducing ,expr by #'* into ,var initial-value 1))
  ;; A better return value would be the exact list usable with remove-clause
  ;; The next version shall do that
  (multiply.clause expr &optional INTO var))

(deftest multiply.clause
    (iter (for el in '(1 2 3 4))
          (multiply.clause el))
  24)

(deftest remove-clause.1
    (iter::remove-clause '(multiply.clause &optional INTO))
  t)

(deftest remove-clause.2
    (values
     (ignore-errors
      (iter::remove-clause '(multiply.clause &optional INTO))))
  nil)

(iter:defmacro-clause (for var IN-WHOLE-VECTOR.clause v)
  "All the elements of a vector (disregards fill-pointer)"
  (let ((vect (gensym "VECTOR"))
        (index (gensym "INDEX")))
    `(progn
       (with ,vect = ,v)
       (for ,index from 0 below (array-dimension ,vect 0))
       (for ,var = (aref ,vect ,index)))))

(deftest in-whole-vector.clause
    (iter (for i IN-WHOLE-VECTOR.clause (make-array 3 :fill-pointer 2
                                         :initial-contents '(1 2 3)))
          (collect i))
  (1 2 3))

(deftest in-vector.fill-pointer
    (iter (for i in-vector (make-array 3 :fill-pointer 2
                            :initial-contents '(1 2 3)))
          (collect i))
  (1 2))

(iter:defmacro-driver (for var IN-WHOLE-VECTOR v)
  "All the elements of a vector (disregards fill-pointer)"
   (let ((vect (gensym "VECTOR"))
         (end (gensym "END"))
         (index (gensym "INDEX"))
         (kwd (if iter:generate 'generate 'for)))
     `(progn
        (with ,vect = ,v)
        (with ,end = (array-dimension ,vect 0))
        (with ,index = -1)
        (,kwd ,var next (progn (incf ,index)
                               (if (>= ,index ,end) (terminate))
                               (aref ,vect ,index))))))

(deftest in-whole-vector.driver
    (iter (for i IN-WHOLE-VECTOR (make-array '(3) :fill-pointer 2
                                             :initial-contents '(1 2 3)))
          (collect i))
  (1 2 3))

(deftest in-whole-vector.generate
    (iter (generating i IN-WHOLE-VECTOR (make-array '(3) :fill-pointer 2
                                                    :initial-contents '(1 2 3)))
          (collect (next i)))
  (1 2 3))

(deftest defclause-sequence
    (progn
      (iter:defclause-sequence IN-WHOLE-VECTOR.seq INDEX-OF-WHOLE-VECTOR
        :access-fn 'aref
        :size-fn '#'(lambda (v) (array-dimension v 0))
        :sequence-type 'vector
        :element-type t
        :element-doc-string 
          "Elements of a vector, disregarding fill-pointer"
        :index-doc-string 
          "Indices of vector, disregarding fill-pointer")
      t)
  t)

(deftest in-whole-vector.seq
    (iter (for i IN-WHOLE-VECTOR.seq (make-array '(3) :fill-pointer 2
                                                 :initial-contents '(1 2 3)))
          (collect i))
  (1 2 3))

(deftest in-whole-vector.seq.index
    (iter (for i INDEX-OF-WHOLE-VECTOR
               (make-array 3 :fill-pointer 2 :initial-contents '(1 2 3)))
          (for j previous i :initially 9)
          (collect (list j i)))
  ((9 0)(0 1)(1 2)))

(deftest in-whole-vector.seq.with-index
    (iter (for e IN-WHOLE-VECTOR.seq
               (make-array '(3) :fill-pointer 2 :initial-contents '(a b c))
               :with-index i)
          (for j previous i :initially 9)
          (collect (list j i e)))
  ((9 0 a)(0 1 b)(1 2 c)))

(deftest in-whole-vector.seq.generate
    (iter (generate e IN-WHOLE-VECTOR.seq
               (make-array 3 :fill-pointer 2 :initial-contents '(a b c))
               :with-index i)
          (collect (list (next e) e i)))
  ((a a 0) (b b 1) (c c 2)))

;; The original example had three bugs:
;; - ,expr and ,func occured twice in expansion
;; - (finally (leave ,winner)) breaks because FINALLY does not walk
;;   its forms, so LEAVE does not work inside FINALLY.
;; - Do not use (finally (RETURN ,winner)) either, as that would
;;   always return accumulated value, even in case of ... INTO nil.
(deftest defmacro-clause.2
    (defmacro-clause (FINDING expr MAXING func &optional INTO var)
      "Iterate paper demo example"
      (let ((max-val (gensym "MAX-VAL"))
            (temp1 (gensym "EL"))
            (temp2 (gensym "VAL"))
            (winner (or var iterate::*result-var*)))
        `(progn 
          (with ,max-val = nil)
          (with ,winner = nil)
          (let* ((,temp1 ,expr)
                 (,temp2 (funcall ,func ,temp1)))
            (when (or (null ,max-val) (> ,temp2 ,max-val))
              (setq ,winner ,temp1 ,max-val ,temp2)))
          #|(finally (return ,winner))|# )))
  (FINDING expr MAXING func &optional INTO var))

(deftest maxing.1
    (iter (for i in-vector #(1 5 3))
          (finding i :maxing #'identity))
  5)

(deftest maxing.2
    (iter (for i in-vector #(1 5 3))
          (finding i maxing #'identity into foo))
  nil)

(deftest maxing.3
    (iter (for i in-vector #(2 5 4))
          (finding i maxing #'identity into foo)
          (when (evenp i) (sum i)))
  6)

(deftest display.1
    (let ((*standard-output* (make-broadcast-stream)))
      (display-iterate-clauses) t)
  t)

(deftest display.2
    (let ((*standard-output* (make-broadcast-stream)))
      (display-iterate-clauses 'for) t)
  t)

(deftest multiple-value-prog1.1
    (iter (for x in '(a b c))
          (collect (multiple-value-prog1 7)))
  (7 7 7))

(deftest ignore-errors.1
    (iter (for x in '(a b c))
          (collect (ignore-errors x)))
  (a b c))

(deftest ignore-errors.2
    (iter (generate x in '(a b c))
          (collect (ignore-errors (next x))))
  (a b c))

(deftest handler-bind.1
    (iter (for i from -1 to 2 by 2)
          (handler-bind ((error (lambda(c) c nil)))
            (collect i)))
  (-1 1))

(deftest destructuring-bind.1
    ;; One version of Iterate would enter endless loop in ACL 7 and SBCL
    ;; reported by Julian Stecklina in early 2005
    (null (macroexpand '(iter (for index in '((1 2)))
                         (collect (destructuring-bind (a b) index
                                    (+ a b))))))
  nil)

(deftest destructuring-bind.2
    (iter (for index in '((1 2)))
          (collect (destructuring-bind (a b) index
                     (+ a b))))
  (3))

(deftest symbol-macrolet
    (iter (for i from -1 downto -3)
          (symbol-macrolet ((x (* i i)))
            (declare (optimize debug))
            (sum x)))
  14)

(defclass polar ()
  ((rho   :initarg :mag)
   (theta :initform 0 :accessor angle)))

(deftest with-slots
    (iter (with v = (vector (make-instance 'polar :mag 2)))
          (for x in-sequence v)
          (with-slots (rho) x
            (multiplying rho)))
  2)

(deftest with-accessors
    (iter (with v = (vector (make-instance 'polar :mag 1)))
          (for x in-sequence v)
          (with-accessors ((alpha angle)) x
            (incf alpha 2)
            (summing alpha)))
  2)

;;; Tests for bugs. 
;; when these start failing, I have done something right (-:

;; The walker ignores function bindings,
;; therefore shadowing is not handled correctly.
(deftest bug/walk.1
    (macrolet ((over(x) `(collect ,x)))
      (iter (for i in '(1 2 3))
            (flet ((over(x)(declare (ignore x)) (collect 1)))
              (over i)))) ; would yield (1 1 1) if correct
  (1 2 3))

(deftest bug/walk.2
    (iter (return (if (oddp 1)
                      (progn)
                      'even)))
  ;; The bug is in emtpy PROGN walking. Due to that the THEN branch is lost
  ;; and it returns 'EVEN instead of NIL.
  nil)

(deftest bug/previously-initially.1
    (values
     (ignore-errors
       ;; It used to silently ignore the entire :previous expression
       ;; and return (0 0). Now it signals a compile-time error.
       (iter (repeat 2)
             (for x :previous (zork foo) :initially 0)
             (collect x))
       'it-should-have-errored))
  nil)

(deftest bug/previously-initially.2
    (let ((first-arg 1)
          (more-args '(2 3 4)))
      (iter outer
            (for rest-args :on more-args)
            (for tmp = (car rest-args))
            (for first :previous tmp :initially first-arg)
            (iter (for second :in rest-args)
                  (in outer (collect (list first second))))))
  ((1 2) (1 3) (1 4) (2 3) (2 4) (3 4)))

(deftest bug/macrolet.2
    (progn
      (format *error-output*
              "~&Note: These tests generate warnings ~
  involving MACROLET within Iterate~%")
      (values
       (ignore-errors ; would yield 1 if correct
         (iterate (repeat 10)
                  (macrolet ((foo () 1))
                    (multiplying (foo)))))))
  nil)

(deftest macrolet.3
    (iterate (repeat 2)
             (multiplying (macrolet ((foo () 1))
                            (foo))))
  1)

(deftest bug/collect-at-beginning
    (iterate
      (for i from 1 to 10)
      (if (oddp i)
          (collect i :at :beginning)
          (collect i)))
  (9 7 5 3 1 2 4 6 8 10))

;; Hashtable iterators are specified to be defined as macrolets.
;; But we handle these by special-casing with-hash-table/package-iterator
(deftest nested-hashtable.1
    (let ((ht1 (make-hash-table))
          (ht2 (make-hash-table)))
      (setup-hash-table ht2)
      (setf (gethash 'a ht1) ht2)
      (= (hash-table-count ht2)
         (length
          (iter outer (for (k1 v1) in-hashtable ht1)
                (iter (for (k2 v2) in-hashtable ht2)
                      (in outer (collect k2)))))))
  t)

(deftest nested.in-hashtable.2
    ;; Here the inner macrolet code does not affect the outer iteration
    (let ((ht1 (make-hash-table))
          (ht2 (make-hash-table)))
      (setup-hash-table ht2)
      (setf (gethash 'a ht1) ht2)
      (iter (for (k1 v1) in-hashtable ht1)
            (counting
             (iter (for (k2 nil) in-hashtable ht2)
                   (count k2)))))
  1)

(deftest nested.in-hashtable.3
    (let ((ht1 (make-hash-table))
          (ht2 (make-hash-table)))
      (setup-hash-table ht2)
      (setf (gethash 'a ht1) ht2)
      (iter (for (k1 v1) in-hashtable ht1)
            (progn
             (iter (for (nil v2) in-hashtable v1)
                   (count v2))
             (collect k1))))
  (a))

(deftest nested.in-package
  (< 6
     (print
      (iter (for scl in-package '#:iterate :external-only t)
            (count ; Iterate exports ~50 symbols
             (iter (for si in-package #.*package*)
                   (thereis (eq si scl))))))
     80)
  t)

(deftest macrolet.loop-finish
    (iter (for l on *an-alist*)
          (loop for e in l
                when (equal (car e) 'zero)
                do (loop-finish)))
  nil)

;; Misc tests to make sure that bugs don't reappear

(defmacro problem-because-i-return-nil (&rest args)
  (declare (ignore args))
  nil)

(deftest tagbody.nil-tags
;;  Allegro (correctly) won't compile when a tag (typically NIL) is used more than once in a tagbody.
    (labels ((find-tagbody (form)
               (cond
                 ((and (consp form)
                       (eq (first form)
                           'tagbody))
                  form)
                 ((consp form)
                  (iter (for x in (rest form))
                        (thereis (find-tagbody x))))
                 (t nil)))
             (all-tagbody-tags (form)
               (iter (for tag-or-form in (rest (find-tagbody form)))
                     (when (symbolp tag-or-form)
                       (collect tag-or-form)))))
      (let* ((form (macroexpand '
                    (iter (for x in '(1 2 3))
                          (problem-because-i-return-nil)
                          (+ x x)
                          (problem-because-i-return-nil))))
             (tags (all-tagbody-tags form)))
         (iter (for tag in tags)
              ;; invoke cl:count, not the Iterate clause:
              (always (= 1 (funcall #'count tag tags :from-end nil))))))
  t)

(deftest walk.tagbody.1
    (iter (tagbody
             (problem-because-i-return-nil)
             3
             (problem-because-i-return-nil)
             (leave 2)))
  2)

(deftest walk.tagbody.2
    (symbol-macrolet ((error-out (error "do not expand me")))
      (iter (tagbody error-out
               (leave 2))))
  2)

#+ccl
(deftest ccl-compiler-let
    (catch 'compiler-warned
      (handler-bind 
          ((ccl:compiler-warning #'(lambda (e)
                                 (declare (ignore e))
                                 (throw 'compiler-warned nil))))
        (let ((def (compile nil '(lambda (list-xs)
                                  (iter (for x in list-xs) (assert x () "~s is not a foo." x))))))
          (when def t))))
  t)

#+allegro
(deftest allegro-compiler-let
    (catch 'compiler-warned
      (handler-bind
          ((warning #'(lambda (e)
                        (declare (ignore e))
                        (throw 'compiler-warned nil))))
        (let ((def (compile nil '(lambda (list-xs)
                                  (iter (for x in list-xs) (assert x () "~s is not a foo." x))))))
          (when def t))))
  t)


(define-condition unexpected-failures-error (error)
  ((failures :initarg :failures))
  (:report (lambda (ufe str)
               (format str "Unexpected failures:~%~{~a~%~}" (slot-value ufe 'failures)))))

(define-condition unexpected-successes-error (error)
  ((successes :initarg :successes))
  (:report (lambda (ufe str)
               (format str "Unexpected successes:~%~{~a~%~}" (slot-value ufe 'successes)))))

(defun do-iterate-tests (&key (on-failure :error))
  (multiple-value-bind (unexpected-failures unexpected-successes)
      (let ((*expected-failures* *tests-expected-to-fail*)
            #-sbcl(*expanded-eval* t)
            (*compile-tests* nil))
        (do-tests)
        (values
         (set-difference (pending-tests) *tests-expected-to-fail*)
         (set-difference *tests-expected-to-fail* (pending-tests))))
    (if (or unexpected-failures unexpected-successes)
     (format t "~&DO-ITERATE-TESTS returned~@[ ~S unexpected failure(s)~]~:[~; and~]~@[ ~S unexpected success(es)~].~%"
             unexpected-failures (and unexpected-failures unexpected-successes) unexpected-successes)
     (format t "~&DO-ITERATE-TESTS ran successfully.~%"))
    (cond
      ((and unexpected-failures
            (eq on-failure :error))
       (error 'unexpected-failures-error :failures unexpected-failures))
      (unexpected-failures
       on-failure)
      ;; no unexpected failures
      ((and unexpected-successes
           (eq on-failure :error))
       (error 'unexpected-successes-error :successes unexpected-successes))
      (unexpected-successes
       on-failure)
      (t t))))

;;; eof