;;; Just a few test cases for iterate.

;;; Copyright (c) 2003 Andreas Fuchs <asf@boinkor.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:

;; Currently, this is a collection of test cases for functionality in
;; ITERATE that I hacked on. It would be nice if this could grow into
;; a more thorough test case collection.


(cl:defpackage #:iterate.test
  (:use #:cl #:iterate
	#+sbcl #:sb-rt
	#-sbcl #:rt))

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

(rem-all-tests)

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

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

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

(deftest in-package.internals
    (let ((syms nil))
      (do-symbols (sym '#:cl-user nil)
	(push sym syms))
      (setf syms (nreverse syms))
      (set-difference syms
	     (iterate (for sym in-package #:cl-user external-only nil)
		      (collect sym))))
  nil)

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

(deftest in-packages.external
    (let ((syms nil))
      (do-external-symbols (sym '#:cl-user nil)
	(push sym syms))
      (setf syms (nreverse syms))
      (set-difference syms
		      (iterate (for (sym access package) in-packages (#:cl-user) having-access (:external))
			       (collect sym))))
  nil)

;;; 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 (for (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
    (iterate (for elt in *list-of-lists*)
	     (finding elt maximizing (length elt)))
  #.(reduce #'longest-list *list-of-lists*))

;; 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))


;;;; 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.1
    (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 (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 gives STYLE-WARNINGS for undefined Is. I can't spot where it
;;; differs from its FOR.DO-NEXT counterpart.
(deftest for.do-next.1
    (iterate (initially (setq i 0))
	     (for i do-next (if (> i 10) (terminate) (incf i)))
	     (finally (return i)))
  11)

(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.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 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 first-time.1
    (with-output-to-string (*standard-output*)
      (iter (for i from 200 to 203)
	    (if-first-time (format t "honka"))))
  "honka")

(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 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))))
	  (return (list a b c)))
  (1 b 2))

(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)


;;; FIXME: iterate::declare-variables seems to be ignored. leave it
;;; out?
(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 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 () 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 () 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
  )

(defmacro multiply (expr)
  `(reducing ,expr by #'* initial-value 1))

(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)

(defmacro-clause (MULTIPLY.clause expr &optional INTO var)
  `(reducing ,expr by #'* into ,var initial-value 1))

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

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

(deftest in-whole-vector.1
    (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.2
    (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.driver v)
  "All the elements of a vector (disregards fill-pointer)"
   (let ((vect (gensym))
         (end (gensym))
         (index (gensym))
         (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.1
    (iter (for i in-whole-vector.driver (make-array '(3) :fill-pointer 2
						    :initial-contents '(1 2 3)))
	  (collect i))
  (1 2 3))

(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")

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

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

;;; Tests for bugs. 
;; when these start failing, I have done something right (-:
(deftest bug/macrolet.1
    (multiple-value-bind (_ error)
	(ignore-errors
	  (macroexpand '(iterate
			 (repeat 10)
			 (macrolet ((foo ()
				      1))
			   (collect (foo))))))
      (declare (ignore _))
      (not error))
  nil)

;; related to the above. hashtable iterators are specified to be
;; defined as symbol-macrolets
(deftest bug/hashtable-walk.1
    (let ((ht1 (make-hash-table))
          (ht2 (make-hash-table)))
      (setup-hash-table ht2)
      (setf (gethash 'a ht1) ht2)
      (multiple-value-bind (_ error)
          (ignore-errors
            (macroexpand
             '(iter (for (k1 v1) in-hashtable ht1)
               (iter (for (k2 v2) in-hashtable ht2)
                     (collect k2)))))
        (declare (ignore _))
        (not error)))
  nil)

;;; arch-tag: "b8b1db2d-313c-11d8-abb9-000c76244c24"
