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

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

;; 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 for bugs. 

(deftest bug/macrolet.1
    (multiple-value-bind (_ error)
	(ignore-errors
	  (macroexpand '(iterate
			 (repeat 10)
			 (macrolet ((foo ()
				      1))
			   (collect (foo))))))
      (declare (ignore _))
      (not error))
  nil)

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