;-*- Syntax:COMMON-LISP -*-

;------------------------------------------------------------------------

;Copyright 1982,1983,1984,1985,1986,1987,1988,1989, and 1990
;by the Massachusetts Institute of Technology, Cambridge, Massachusetts.

;Permission to use, copy, modify, and distribute this software and its
;documentation for any purpose and without fee is hereby granted,
;provided that this copyright and permission notice appear in all
;copies and supporting documentation, and that the name of M.I.T. not
;be used in advertising or publicity pertaining to distribution of the
;software without specific, written prior permission. M.I.T. makes no
;representations about the suitability of this software for any
;purpose.  It is provided "as is" without express or implied warranty.

;    M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
;    ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
;    M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
;    ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
;    WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
;    ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
;    SOFTWARE.

;------------------------------------------------------------------------

;  This is a file of test cases to test SERIES.  Just load it and run the
;function (DO-TESTS).  It prompts you for the name of a scratch file to use when
;testing.  You must type a string "..." containing the path name.  It then
;prints out identifying numbers of tests as it performs one test after another.
;When all of the tests have been run a summary line is printed saying how many
;tests failed.
;  Whenever a test fails for any reason, an error is signalled.  To continue
;testing call the function (MORE) either within the break, or at top level after
;aborting the execution of a test.  (The latter is useful if a test leads to an
;infinite loop.)  When all of the tests have been completed, the variable
;FAILED-TESTS contains a list of the numbers of the tests that failed.  (You can
;look at the tests themselves by evaluating (NTH N TEST-LIST) for any test
;number.)
;  After running the tests and fixing problems which arise you may wish to run
;some or all of the tests again.  Calling (DO-TESTS) runs all of the tests
;again.  Calling (DO-FAILED-TESTS) runs just the tests which failed the first
;time.  (The variable FAILED-TESTS is updated to reflect the new state of
;affairs in either case.)  Calling (DO-TEST n) runs just the test with the given
;number.  (In some lisps, if you run the tests more than once without rstarting
;the lisp, you can get some warnings about redefining functions called FOOn.
;These do not indicate any problem.)

(in-package "USER")
(series::install)
(proclaim '(special form test-list failed-tests *x*))
(defvar in-tester nil)
(defvar tests nil)
(defvar test-file nil)
(defvar *compile-tests* T)

(defun do-tests ()
  (format T "~% Running the suite of ~S test cases~%" (length test-list))
  (setq tests (do ((i (1- (length test-list)) (1- i))
		   (r nil (cons i r)))
		  ((minusp i) r))
	failed-tests nil)
  (do-many-tests))

(defun do-failed-tests ()
  (format T "~% Running the ~S failed tests~%" (length failed-tests))
  (setq tests failed-tests failed-tests nil)
  (do-many-tests))

(defun do-many-tests ()
  (loop (when (null tests)
	  (setq failed-tests (nreverse failed-tests))
	  (if (zerop (length failed-tests))
	      (format T "~2% SERIES passed all tests.")
	      (format T "~2% SERIES failed ~A tests." (length failed-tests)))
	  (return (values)))
	(format T " ~A" (car tests))
	(do-test (pop tests))))

(defun more ()
  (if in-tester (throw 'in-tester nil) (do-many-tests)))

(defun do-test (n)
  (loop (if test-file (return nil))
    (format T "~%Type a string representing a pathname of a scratch disk file: ")
    (setq test-file (read))
    (if (not (stringp test-file)) (setq test-file nil)))
  (catch 'in-tester
    (let* ((info (nth n test-list))
	   (*break-on-warnings* T)
	   (tester (if (symbolp (car info)) (pop info) 'test-ordinary))
	   (value (cadr info))
	   (pop-if-no-failure nil)
	   (in-tester T))
      (setq series:*last-series-loop* nil)
      (setq form (car info))
      (when (not (member n failed-tests))
	(push n failed-tests)
	(setq pop-if-no-failure T))
      (let ((result (funcall tester (series::iterative-copy-tree form))))
	(when (not (equal result value))
	  (format t "~%form: ~S~% desired value ~S~% actual value ~S~%"
		  form value result)
	  (let ((*print-length* nil) (*print-level* nil))
	    (pprint series:*last-series-loop*))
	  (error "failed test"))
	(when pop-if-no-failure
	  (pop failed-tests)))))  ;doesn't happen when abort out of test error
  'test-successful)

;This is useful for special test cases, and rerunning the last test case.

(defmacro r (&optional (f nil))
  (if f (setq form f))
  (setq f (series::iterative-copy-tree form))
  (gensym 1)
  (setq f (macroexpand f))
  (let ((*print-length* nil) (*print-level* nil) #+symbolics(*print-lines* nil))
    (pprint f))
  (cond ((Y-or-N-p "continue") f)))

(defun o ()
  (setq series::*optimize-series-expressions*
	(not series::*optimize-series-expressions*)))

;Helper functions for tests.

(defun test-ordinary (form)
  (let* ((series::*series-implicit-map* nil)
	 (non-opt (let ((series::*optimize-series-expressions* nil))
		    (eval (series::iterative-copy-tree form))))
	 (opt (test-opt form)))
   (if (equal non-opt opt) opt
       (list "opt and non-opt disagree" opt non-opt))))

(defun test-opt (form)
  (let ((series::*series-implicit-map* nil)
	(series::*optimize-series-expressions* T))
  (if *compile-tests*
      (funcall (compile nil `(lambda () ,form)))
      (eval form))))

(defun test-non-opt (form)
  (let ((series::*series-implicit-map* nil)
	(series::*optimize-series-expressions* nil))
    (eval form)))

(defun test-def (form)
  (let ((series::*series-implicit-map* nil))
    (eval (car form))
#+symbolics(compile (cadar form)) ;does not work in all lisps
    (test-ordinary (cadr form))))

(defun test-wrs (form)
  (let ((v nil)
	(series::*series-implicit-map* nil)
	(series::*optimize-series-expressions* T)
	(series::*testing-errors* T))
    (setq series:*last-series-error* nil)
    (with-output-to-string (*error-output*)
      (setq v (eval form)))
    (list v (cadr series:*last-series-error*))))

(defun test-rrs (form)
  (let ((v nil)
	(series::*series-implicit-map* nil)
	(series::*testing-errors* T)
	(series::*optimize-series-expressions* T)
	(*suppress-series-warnings* nil))
    (setq series:*last-series-error* nil)
    (with-output-to-string (*error-output*)
      (setq v (eval form)))
    (list v (cadr series:*last-series-error*))))

(defun test-ers (form)
  (let* ((series::*series-implicit-map* nil)
	 (series::*testing-errors* T)
	 (opt (catch :testing-errors
		(let ((series::*optimize-series-expressions* T))
		  (eval form))))
	 (non-opt (catch :testing-errors
		    (let ((series::*optimize-series-expressions* nil))
		      (eval form)))))
   (if (equal non-opt opt) opt
       (list "opt and non-opt disagree" opt non-opt))))

(defun test-ers-opt (form)
  (let* ((series::*series-implicit-map* nil)
	 (series::*testing-errors* T))
    (catch :testing-errors
      (let ((series::*optimize-series-expressions* T))
	(eval form)))))

(defun testm (form)
  (let ((series::*series-implicit-map* T)
        (*suppress-series-warnings* nil))
  (if *compile-tests*
      (funcall (compile nil `(lambda () ,form)))
      (eval form))))

(defun decls (arg) (declare (ignore arg)) (decls0 series:*last-series-loop*))
(defun decls0 (tree)
  (cond ((not (consp tree)) nil)
	((eq (car tree) 'declare) tree)
	(T (do ((l tree (cdr l))) ((not (consp l)) nil)
	     (let ((x (decls0 (car l))))
	       (if x (return x)))))))

(defun phys-scan-list (l)
  (scan l))

(proclaim '(special *x*))

(defun incx (&optional (val *x*))
  (incf *x*) val)

(defvar *c1* 1)
(defvar *c2* 2)

(defmacro c1-c2-macro (value)
  `(list ,*c1* ,*c2* ,value))

;the first few pages of tests attempt to test each of the different
;series operations in the series function library.

(setq test-list '(

;first are individual tests of all the exported series functions
    ((collect #Z(a b c)) (a b c))
    ((collect #Z()) ())

    ((collect (#Mlist (series 'a0) #Z(a b))) ((a0 a) (a0 b)))
    ((collect (#1Mlist (series 'a0 'a1) #Z(a b c))) ((a0 a) (a1 b) (a0 c)))

    ((collect (make-series 'b 'c)) (b c))
    ((collect (make-series 'b)) (b))

    ((collect (#Mcar (scan-fn T #'(lambda () '(a b c)) #'cdr #'null))) (a b c))
    ((collect (#Mcar (scan-fn '(values T) #'(lambda () '(a b c)) #'cdr #'null)))
     (a b c))
    ((collect (#Mcar (scan-fn T #'(lambda () '(a b c))
			      'cdr #'(lambda (x) (null x)))))
     (a b c))
    ((collect (#M(lambda (x y) (list x (car y)))
	       #Z(a b c)
	       (scan-fn T #'(lambda () '(1 2)) #'cdr)))
     ((a 1) (b 2) (c nil)))
    ((let* ((lst (list 'a 'b 'c)))
       (multiple-value-bind (e l)
	   (scan-fn '(values T T) #'(lambda () (values (car lst) lst))
		    #'(lambda (element parent)
			(declare (ignore element))
			(values (cadr parent) (cdr parent)))
		    #'(lambda (element parent)
			(declare (ignore element))
			(null parent)))
	   (list (collect e) (collect l))))
     ((a b c) ((a b c) (b c) (c))))

    ((collect
       (encapsulated #'(lambda (b) `(lisp:let ((xx 0)) ,b))
		     (scan-fn T #'(lambda () 0)
			      #'(lambda (sum)
				  (incf xx)
				  (+ sum xx))
			      #'(lambda (x) (> x 10))))) (0 1 3 6 10))
    ((multiple-value-bind (a b)
       (encapsulated #'(lambda (b) `(lisp:let ((xx 0)) ,b))
		     (scan-fn '(values T T)
			      #'(lambda () (values 0 1))
			      #'(lambda (sum prod)
				  (incf xx)
				  (values (+ sum xx) (* prod xx)))
			      #'(lambda (x y) (> (min x y) 10))))
       (list (collect a) (collect b)))
     ((0 1 3 6 10) (1 1 2 6 24)))

    ((collect (#Mcar (scan-fn-inclusive T #'(lambda () '(a b c)) #'cdr #'null)))
     (a b c nil))
    ((collect (#Mcar (scan-fn-inclusive T #'(lambda () ()) #'cdr #'null))) (nil))
    ((let* ((lst (list 1 2 3 -4 5)))
       (multiple-value-bind (e l)
	   (scan-fn-inclusive '(values T T) #'(lambda () (values (car lst) lst))
			      #'(lambda (element parent)
				  (declare (ignore element))
				  (values (cadr parent) (cdr parent)))
			      #'(lambda (element parent)
				  (declare (ignore parent))
				  (minusp element)))
	 (list (collect e) (collect l))))
     ((1 2 3 -4) ((1 2 3 -4 5) (2 3 -4 5) (3 -4 5) (-4 5))))

    ((collect
       (encapsulated #'(lambda (b) `(lisp:let ((xx 0)) ,b))
		     (scan-fn-inclusive T #'(lambda () 0)
					#'(lambda (sum)
					    (incf xx)
					    (+ sum xx))
					#'(lambda (x) (> x 10))))) (0 1 3 6 10 15))
    ((multiple-value-bind (a b)
       (encapsulated #'(lambda (b) `(lisp:let ((xx 0)) ,b))
		     (scan-fn-inclusive '(values T T)
					#'(lambda () (values 0 1))
					#'(lambda (sum prod)
					    (incf xx)
					    (values (+ sum xx) (* prod xx)))
					#'(lambda (x y) (> (min x y) 10))))
       (list (collect a) (collect b)))
     ((0 1 3 6 10 15) (1 1 2 6 24 120)))
    ((collect (scan ())) ())
    ((let* ((x (list 'a 'b 'c)) (e (scan 'list x)))
       (list (collect e) (alter e (scan-range)) (collect e) x))
     ((a b c) nil (a b c) (0 1 2)))
    ((collect (scan 'vector '#())) ())
    ((let* ((v (copy-seq "FOO")) (e (scan 'vector v)))
       (list (collect e) (alter e (series #\-)) v))
     ((#\F #\O #\O) nil "---"))
    ((let* ((v (copy-seq "FOO")) (e (scan 'sequence v)))
       (list (collect e) (alter e (series #\-)) v))
     ((#\F #\O #\O) nil "---"))
    ((let* ((v (copy-seq '(1 2 3))) (e (scan 'sequence v)))
       (list (collect e) (alter e (series 0)) v))
     ((1 2 3) nil (0 0 0)))
    ((let* ((type 'string) (v (copy-seq "FOO")) (e (scan type v)))
       (list (collect e) (alter e (series #\-)) v))
     ((#\F #\O #\O) nil "---"))
    ((let* ((v (copy-seq "FOOBAR")) (e (scan '(simple-vector 3) v)))
       (list (collect e) (alter e (series #\-)) v))
     ((#\F #\O #\O) nil "---BAR"))

    ((multiple-value-bind (a b) (scan-multiple 'list '(1 2 3) '(3 4 5 6))
       (list (collect a) (collect b)))
     ((1 2 3) (3 4 5)))
    ((multiple-value-bind (a b)
	 (scan-multiple '(values vector list) '#(1 2 3) '(3 4))
       (list (collect a) (collect b)))
     ((1 2 3) (3 4 nil)))
    ((collect (until-if #'null (scan-multiple (cadr '(values list)) '(1 2 nil 3))))
     (1 2))
    ((let* ((x (list 'a 'b nil 'c))
	    (e (scan-multiple 'list x)))
       (list (collect e) (alter e (scan-range)) x))
     ((a b nil c) nil (0 1 2 3)))
    ((let* ((x (list 'a 'b nil 'c))
	    (e (until-if #'null (scan-multiple 'list x))))
       (list (collect e) (alter e (scan-range)) (collect e) x))
     ((a b) nil (a b) (0 1 nil c)))

    ((collect (scan-sublists '(a b c))) ((a b c) (b c) (c)))
    ((collect (scan-sublists ())) ())

    ((collect (#Mlist (scan-range) #Z(a b c))) ((0 a) (1 b) (2 c)))
    ((collect (#Mlist (scan-range :from 4 :by 3) #Z(a b c)))
     ((4 a) (7 b) (10 c)))
    ((collect (scan-range :upto 3)) (0 1 2 3))
    ((collect (scan-range :below 3)) (0 1 2))
    ((collect (scan-range :length 3)) (0 1 2))
    ((collect (scan-range :from 2 :upto 3)) (2 3))
    ((collect (scan-range :from 2 :below 3)) (2))
    ((collect (scan-range :from 2 :length 3)) (2 3 4))
    ((collect (scan-range :from 4 :upto 3)) ())
    ((collect (scan-range :from 4 :below 3)) ())
    ((collect (scan-range :from 4 :length 3)) (4 5 6))
    ((collect (scan-range :upto 3 :by 2)) (0 2))
    ((collect (scan-range :upto 4 :by 2)) (0 2 4))
    ((collect (scan-range :below 3 :by 2)) (0 2))
    ((collect (scan-range :below 4 :by 2)) (0 2))
    ((collect (scan-range :length 3 :by 2)) (0 2 4))
    ((collect (#M(lambda (x) (round (* 10. x)))
	       (scan-range :from 1.5 :by .2 :below 2.0)))
     (15 17 19))
    ((collect (#Mlist (scan-range :from 4 :by -3) #Z(a b c)))
     ((4 a) (1 b) (-2 c)))
    ((collect (scan-range :by -1 :downto -3)) (0 -1 -2 -3))
    ((collect (scan-range :by -1 :above -3)) (0 -1 -2))
    ((collect (scan-range :by -1 :length 3)) (0 -1 -2))
    ((collect (scan-range :from 4 :by -1 :downto 3)) (4 3))
    ((collect (scan-range :from 4 :by -1 :above 3)) (4))
    ((collect (scan-range :from 4 :by -1 :length 3)) (4 3 2))
    ((collect (scan-range :downto -3 :by -2)) (0 -2))
    ((collect (scan-range :downto -4 :by -2)) (0 -2 -4))
    ((collect (scan-range :above -3 :by -2)) (0 -2))
    ((collect (scan-range :above -4 :by -2)) (0 -2))
    ((collect (scan-range :length 3 :by -2)) (0 -2 -4))

    ((collect (scan-lists-of-lists '(1 (2 3) 4))) ((1 (2 3) 4) 1 (2 3) 2 3 4))
    ((collect (scan-lists-of-lists '(1 (2 3) 4) #'atom))
     ((1 (2 3) 4) 1 (2 3) 2 3 4))
    ((collect (scan-lists-of-lists '(1 (2 3) 4)
			 #'(lambda (n) (not (and (consp n) (cddr n))))))
     ((1 (2 3) 4) 1 (2 3) 4))
    ((collect (scan-lists-of-lists nil)) (nil))

    ((collect (scan-lists-of-lists-fringe '((1 2 ((3 . 4) 4) (5) () (((6)))))))
     (1 2 3 4 5 nil 6))
    ((collect (scan-lists-of-lists-fringe '(1 2 ((3 . 4) 4) (5) () (((6))))
			   #'(lambda (n) (not (and (consp n) (cdr n))))))
     (1 2 3 4 (5) nil (((6)))))
    ((collect (scan-lists-of-lists-fringe '((2) (nil))
					  #'(lambda (e) (numberp (car e)))))
     ((2) nil))

    ((collect (scan-lists-of-lists-fringe ())) (nil))
    ((let ((tree (list (list 3) 4)))
       (let ((leaf (choose-if #'evenp (scan-lists-of-lists-fringe tree))))
	 (alter leaf (#M- leaf)))
       tree) ((3) -4))
    ((let ((z (list 'a 'b (cons 3 'e) 'd)))
       (let* ((x (scan-lists-of-lists-fringe z)))
	 (alter x (#Mlist x)))
       z) ((a) (b) ((3) . e) (d)))

    ((collect (scan-alist '((1 . a) () (2) (1 . c)))) (1 2))
    ((collect (scan-alist ())) ())
    ((multiple-value-bind (key value)
				 (scan-alist '((1 . a) () (2) (1 . c)))
       (collect (#Mlist key value))) ((1 a) (2 nil)))
    ((let ((alist (list (cons 'a  1) (cons 'b 2))))
       (multiple-value-bind (key val) (scan-alist alist)
         (alter key (#Mlist key))
	 (alter val (#Mlist val)))
       alist) (((a) . (1)) ((b) . (2))))

    ((collect (scan-plist '(P1 1 P2 2 P1 3 P3 4))) (P1 P2 P3))
    ((collect (scan-plist ())) ())
    ((multiple-value-bind (key value) (scan-plist '(P1 1 P2 2 P1 3))
       (collect (#Mlist key value))) ((P1 1) (P2 2)))
    ((let ((plist (list 'a 1 'b 2)))
       (multiple-value-bind (key val) (scan-plist plist)
	 (alter key (#Mlist key))
	 (alter val (#Mlist val)))
       plist) ((a) (1) (b) (2)))

    ((multiple-value-bind (key val)
	 (scan-hash (let ((x (make-hash-table)))
		      (setf (gethash 'color x) 'brown)
		      (setf (gethash 'name x) 'fred)
		      x))
       (sort (collect (#Mcons key val))
	     #'(lambda (x y) (string-lessp (string (car x)) (string (car y))))))
     ((color . brown) (name . fred)))

    ((progn (collect-first (scan-symbols)) nil) nil) ;grotesquely weak tests
    ((progn (collect-first (scan-symbols (find-package "SERIES"))) nil) nil)

;scan-file tested in conjunction with collect-file.

    ((collect (previous #Z(a b c))) (nil a b))
    ((collect (previous #Z(a b c) 'fill 2)) (fill fill a))
    ((collect (previous #Z(a b c) 0)) (0 a b))

    ((collect (latch #Z(nil 3 nil 4 5))) (nil 3 nil nil nil))
    ((collect (latch #Z(nil 3 nil 4 5) :after 2)) (nil 3 nil 4 nil))
    ((collect (latch #Z(nil 3 nil 4 5) :after 0)) (nil nil nil nil nil))
    ((collect (latch #Z(nil 3 nil 4 5) :after 2 :pre 'a)) (A A A A 5))
    ((collect (latch #Z(nil 3 nil 4 5) :after 2 :pre 'a :post 'b))
     (A A A A B))
    ((collect (latch #Z(nil 3 nil 4 5) :after 2 :post 'b)) (nil 3 nil 4 B))
    ((collect (latch #Z(nil 3 nil 4 5) :before 2)) (nil 3 nil nil nil))
    ((collect (latch #Z(nil 3 nil 4 5) :before 0)) (nil nil nil nil nil))
    ((collect (latch #Z(nil 3 nil 4 5) :before 2 :pre 'a)) (A A A 4 5))
    ((collect (latch #Z(nil 3 nil 4 5) :before 2 :pre 'a :post 'b))
     (A A A B B))
    ((collect (latch #Z(nil 3 nil 4 5) :before 2 :post 'b)) (nil 3 nil B B))

    ((collect (until #Z(nil nil T nil T) #Z(1 2 3))) (1 2))
    ((multiple-value-bind (x y)
	 (until #Z(nil nil T nil T) #Z(1 2 3) #Z(a b c d))
       (list (collect x) (collect y))) ((1 2) (a b)))
    ((multiple-value-bind (x y)
	 (until #Z(nil nil) #Z(1 2 3) #Z(a b c d))
       (list (collect x) (collect y))) ((1 2) (a b)))
    ((multiple-value-bind (x y)
	 (until #Z(nil nil nil nil T) #Z(1 2 3) #Z(a b c d))
       (list (collect x) (collect y))) ((1 2 3) (a b c)))
    ((multiple-value-bind (x y)
	 (until #Z(nil nil nil nil T) #Z(a b c d) #Z(1 2 3))
       (list (collect x) (collect y))) ((a b c) (1 2 3)))
    ((multiple-value-bind (x y z)
	 (until #Z(nil nil T nil T) #Z(a b c d) #Z(1 2 3) #Z(5 6 7))
       (list (collect x) (collect y) (collect z))) ((a b) (1 2) (5 6)))
    ((collect (until #Z() #Z(1 2 3))) ())
    ((let ((x #Z(1 2 3 nil nil)))
       (collect (until (previous (#Mnull x)) x)))
     (1 2 3 nil))

    ((collect (until-if #'null #Z(1 2 3 nil nil))) (1 2 3))
    ((multiple-value-bind (x y)
	 (until-if #'listp #Z(1 2 (3)) #Z(a b c d))
       (list (collect x) (collect y))) ((1 2) (a b)))
    ((let ((z #'listp))
       (multiple-value-bind (x y)
	   (until-if z #Z(1 2 (3)) #Z(a b c d))
	 (list (collect x) (collect y)))) ((1 2) (a b)))
    ((multiple-value-bind (x y)
	 (until-if #'listp #Z(1 2) #Z(a b c d))
       (list (collect x) (collect y))) ((1 2) (a b)))
    ((multiple-value-bind (x y)
	 (until-if #'listp #Z(a b c d) #Z(1 2))
       (list (collect x) (collect y))) ((a b) (1 2)))
    ((multiple-value-bind (x y z)
	 (until-if #'listp #Z(a b (c) d) #Z(1 2 3) #Z(5 6 7))
       (list (collect x) (collect y) (collect z))) ((a b) (1 2) (5 6)))
    ((let ((fn #'null))
       (collect (until-if fn #Z(1 2 3 nil nil)))) (1 2 3))
    ((let ((v (list 1 -2 3)))
       (let ((x (until-if #'minusp (scan v))))
	 (collect-sum x)
	 (alter x (#M- x)))
       v) (-1 -2 3))

    ((collect (map-fn T #'list #Z(1 2 3))) ((1) (2) (3)))
    ((collect (map-fn 'integer #'list #Z(1 2 3))) ((1) (2) (3)))
    ((collect (map-fn '(values integer) #'list #Z(1 2 3))) ((1) (2) (3)))
    ((collect (map-fn '(values *) #'list #Z(1 2 3))) ((1) (2) (3)))
    ((collect (map-fn T 'list #Z(1 2 3))) ((1) (2) (3)))
    ((collect (map-fn T #'(lambda (z) (list z)) #Z(1 2 3))) ((1) (2) (3)))
    ((multiple-value-bind (a b)
         (map-fn '(values integer integer) #'(lambda (x) (values x (1+ x)))
		 #Z(1 2 3))
       (collect (#Mlist a b))) ((1 2) (2 3) (3 4)))
    ((let ((z 2))
       (collect (map-fn T #'(lambda (x) (+ x z)) #Z(1 2 3)))) (3 4 5))
    ((let ((z 2))
       (collect (map-fn T #'(lambda (x) (+ x z)) #Z(1 2 3)))) (3 4 5))

    ((collect (mapping ((e #Z(1 2 3))) (1+ e))) (2 3 4))
    ((collect (mapping (((e f) (scan-plist '(a 1 b 2))))
		(cons e f))) ((a . 1) (b . 2)))
    ((collect (mapping ((d #Z(10 20 30 40))
			((e f) (scan-plist '(a 1 b 2))))
		(list* d e f))) ((10 a . 1) (20 b . 2)))

    ((let ((c 1))
       (collect (#Mcons #Z(a b c) (#M(lambda () (incf c))))))
     ((a . 2) (b . 3) (c . 4)))
    ((let* ((tt '((1 2) (3 4)))
	     (e (scan tt)))
	 (collect (#M(lambda (x y) (list (collect 'bag (scan x)) y)) e e)))
     (((2 1) (1 2)) ((4 3) (3 4))))
    ((let ((e #Z((1 2) (3 4))))
       (collect (#M(lambda (x) (collect-sum (scan x))) e))) (3 7))

    ((collect (collecting-fn T #'(lambda () 0) #'+ #Z(1 2 3))) (1 3 6))
    ((collect (collecting-fn 'integer #'(lambda () 0) #'+ #Z(1 2 3))) (1 3 6))
    ((collect (collecting-fn T #'(lambda () 0) '+ #Z(1 2 3))) (1 3 6))
    ((collect (collecting-fn T #'(lambda () 0) #'(lambda (s z) (+ s z)) #Z(1 2 3)))
     (1 3 6))
    ((collect (collecting-fn '(values T T) #'(lambda () (values nil T))
			     #'(lambda (max flag n)
				 (values (if flag n (max max n)) nil))
			     #Z(1 4 2))) (1 4 4))
    ((collect 'list
       (collecting-fn '(values list integer) #'(lambda () (values nil 0))
		      #'(lambda (a b x y) (values (cons (list x y b) a) (1+ b)))
		      #Z(A B C) #Z(1 2 3)))
     (((a 1 0)) ((b 2 1) (a 1 0)) ((c 3 2) (b 2 1) (a 1 0))))
    ((collect (collecting-fn T #'(lambda () 0) #'- #Z(1 2 3))) (-1 -3 -6))

    ((multiple-value-bind (x y) (cotruncate #Z(1 2 3) #Z(4 5))
       (list (collect-sum x) (collect-sum y))) (3 9))
    ((multiple-value-bind (x y z) (cotruncate #Z(1 2 3) #Z(4 5) #Z(9 8 7))
       (list (collect-sum x) (collect-sum y) (collect-sum z))) (3 9 17))
    ((multiple-value-bind (x y) (cotruncate #Z() #Z(4 5))
       (list (collect-sum x) (collect-sum y))) (0 0))
    ((multiple-value-bind (x y) (cotruncate #Z(1 2 3) #Z(4 5))
       (list (collect-sum (#M+ x y)) (collect-sum y))) (12 9))
    ((let ((ll (list 1 2 3 4)))
       (multiple-value-bind (x y) (cotruncate (scan ll) #Z(4 5))
	 (list (collect x) (alter x y) ll (collect-sum y))))
     ((1 2) nil (4 5 3 4) 9))

    ((let ((x '(b c)))
       (collect (catenate (scan (cons 'a x)) #Z(1 2 3))))
     (a b c 1 2 3))
    ((collect (catenate #Z() #Z(a b c) #Z() #Z(a b c)))
     (a b c a b c))
    ((let ((x #Z(1 2)) (y #Z(3 4)))
       (collect (catenate x y))) (1 2 3 4))

    ((let ((x '(b c)))
       (collect (subseries (scan (cons 'a x)) 1 2))) (b))
    ((collect (subseries #Z(a b c) 1)) (b c))
    ((let ((v (list 1 -2 3)))
       (let ((x (subseries (scan v) 1)))
	 (alter x (#M- x)))
       v) (1 2 -3))

    ((collect (positions #Z(a nil 3 nil T nil))) (0 2 4))
    ((let ((x '(3 T nil)))
       (collect (positions (scan  (cons nil x))))) (1 2))
    ((collect (positions #Z(nil nil))) ())

    ((collect (subseries (mask #Z()) 0 6)) (nil nil nil nil nil nil))
    ((collect (subseries (mask #Z(0 2 4)) 0 6)) (T nil T nil T nil))

    ((collect (mingle #Z(1 3 7 9) #Z(4 5 8) #'<)) (1 3 4 5 7 8 9))
    ((collect (mingle #Z(4 5 8) #Z(1 3 7 9) #'<)) (1 3 4 5 7 8 9))
    ((collect (mingle #Z((1 a) (2 b)) #Z((1 c) (3 d))
	      #'(lambda (x y) (< (car x) (car y)))))
     ((1 a) (1 c) (2 b) (3 d)))

    ((collect (choose #Z(t t nil nil t) #Z(1 2 nil nil -4)))
     (1 2 -4))
    ((collect (choose #Z(1 2 nil nil -4))) (1 2 -4))
    ((let ((x #Z(1 -1 2 -2)))
       (collect (choose (#Mplusp x) x))) (1 2))
    ((let ((x #Z(1 -1 2 -2)))
       (collect (#M(lambda (x) (if (plusp x) x)) x))) (1 nil 2 nil))
    ((let ((x #Z(1 -1 2 -2)))
       (collect (#M(lambda (x) (if (plusp x) x (- x))) x))) (1 1 2 2))
    ((let ((x #Z(0 1 -1 2 -2)))
       (collect (#Mlist (choose (#Mplusp x) x) (scan-range)))) ((1 0) (2 1)))
    ((let ((x #Z(0 1 -1 2 -2))
	    (tag (scan-range)))
       (collect (#Mlist (choose (#Mplusp x) x) tag))) ((1 0) (2 1)))
    ((let* ((l (list 1 2 nil nil -4))
	    (e (choose #Z(t t nil nil t) (scan l))))
       (list (collect e) (alter e (#Mlist e)) l))
     ((1 2 -4) nil ((1) (2) nil nil (-4))))

    ((collect (choose-if #'minusp #Z(1 2 -2 3 -4))) (-2 -4))
    ((let ((fn #'minusp))
       (collect (choose-if fn #Z(1 2 -2 3 -4)))) (-2 -4))
    ((let ((v (list 1 -2 3)))
       (let ((x (choose-if #'minusp (scan v))))
	 (alter x (#M- x)))
       v) (1 2 3))

    ((collect (expand #Z(nil T nil T nil) #Z(a b c)))
     (nil a nil b nil))
    ((collect (expand #Z(nil T nil T) #Z(a b c) T)) (T a T b))

    ((collect (spread #Z(1 1) #Z(2 4) -1)) (-1 2 -1 4))
    ((collect (spread #Z(0 2 4) #Z(a b))) (a nil nil b))
    ((collect (spread #Z(1) #Z(a b))) (nil a))

    ((let* ((x #Z(1 -1 2 -2)))
       (multiple-value-bind (y+ y-) (split x (series t nil t nil))
	 (list (collect x) (collect y+) (collect y-))))
     ((1 -1 2 -2) (1 2) (-1 -2)))
    ((let* ((x #Z(1 0 -1 2 0 -2)))
       (multiple-value-bind (y+ y- y0) (split x (series t nil nil t nil nil)
					       (series nil nil t nil nil t))
	 (list (collect y+) (collect y-) (collect y0) (collect x))))
     ((1 2) (-1 -2) (0 0) (1 0 -1 2 0 -2)))
    ((let* ((l (list 1 -1 2 -2))
	    (x (scan l)))
       (multiple-value-bind (y+ y-) (split x (series t nil t nil))
	 (list (collect x) (alter y+ (#Mlist y+)) (collect y+) (collect y-) l)))
     ((1 -1 2 -2) nil (1 2) (-1 -2) ((1) -1 (2) -2)))

    ((let* ((x #Z(1 -1 2 -2)))
       (multiple-value-bind (y+ y-) (split-if x #'plusp)
	 (list (collect x) (collect y+) (collect y-))))
     ((1 -1 2 -2) (1 2) (-1 -2)))
    ((let* ((x #Z(1 -1 2 -2))
	     (y+ (split-if x #'plusp)))
       (collect (#M+ y+ y+)))
     (2 4))
    ((let* ((x #Z(1 -1 2 -2))
	     (y+ (split-if x #'plusp)))
       (list (collect y+) (collect-sum y+)))
     ((1 2) 3))
    ((let* ((x #Z(1 -1 2 -2))
	     (y+ (split-if x #'plusp)))
       (collect (catenate y+ #Z(5 6))))
     (1 2 5 6))
    ((let* ((x #Z(1 0 -1 2 0 -2)))
       (multiple-value-bind (y+ y- y0) (split-if x #'plusp #'minusp)
	 (list (collect y+) (collect y-) (collect y0) (collect x))))
     ((1 2) (-1 -2) (0 0) (1 0 -1 2 0 -2)))
    ((let* ((x #Z(1 (nil) (3))))
       (multiple-value-bind (y+ y- y0) (split-if x #'numberp #'car)
	 (list (collect y+) (collect y-) (collect y0))))
     ((1) ((3)) ((nil))))

    ((multiple-value-bind (x y) (chunk 2 #Z(1 2 3 4))
       (list (collect x) (collect y)))
     ((1 2 3) (2 3 4)))
    ((multiple-value-bind (x y) (chunk 2 2 #Z(1 2 3 4))
       (list (collect x) (collect y)))
     ((1 3) (2 4)))
    ((multiple-value-bind (x y) (chunk 2 3 #Z(1 2 3 4 5))
       (list (collect x) (collect y)))
     ((1 4) (2 5)))
    ((multiple-value-bind (x y) (chunk 2 #Z(1 2))
       (list (collect x) (collect y)))
     ((1) (2)))
    ((multiple-value-bind (x y) (chunk 2 #Z(1))
       (list (collect x) (collect y)))
     (() ()))
    ((collect (chunk 1 2 #Z(1 2 3))) (1 3))
    ((multiple-value-bind (x y z) (chunk 3 2 #Z(1 2 3 4 5))
       (list (collect x) (collect y) (collect z)))
     ((1 3) (2 4) (3 5)))

    ((collect #Z(a b c)) (a b c))

    ((collect 'bag #Z(a b c)) (c b a))
    ((collect-append 'list #Z((a b c) (a b c))) (a b c a b c))
    ((collect-append (car '(list)) #Z((a b c) (a b c))) (a b c a b c))
    ((collect-append 'list #Z()) ())
    ((let ((a (list 1 2)) (b '(3 4)))
       (collect-append (scan (list a b)))
       a) (1 2))

    ((collect-nconc (scan (list nil (list 'a 'b) nil
				      (list 'c 'd) (list 'e) nil)))
     (a b c d e))
    ((collect-nconc #Z()) ())
    ((let ((a (list 1 2)) (b '(3 4)))
       (collect-nconc (scan (list a b)))
       a) (1 2 3 4))

    ((collect-alist #Z(d e d) #Z(a b c)) ((d . c) (e . b) (d . a)))
    ((collect-alist #Z(d e d) #Z()) ())

    ((collect-plist #Z(d e d) #Z(a b c)) (d c e b d a))
    ((collect-plist #Z(d e d) #Z()) ())

    ((let ((h (collect-hash #Z(color name) #Z(brown fred))))
       (multiple-value-bind (key val) (scan-hash h)
	 (sort (collect (#Mcons key val))
	       #'(lambda (x y)
		   (string-lessp (string (car x)) (string (car y)))))))
     ((color . brown) (name . fred)))

    ((coerce (collect 'vector #Z(a b c)) 'list) (a b c))
    ((coerce (collect 'vector #Z()) 'list) ())
    ((collect '(simple-string 3) #Z(#\B #\A #\R)) "BAR")
    ((coerce (collect '(vector * 3) #Z(a b c)) 'list) (a b c))

    ((progn (if (probe-file test-file) (delete-file test-file))
	    (collect-file test-file #Z(a b c))
	    (collect (scan-file test-file))) (a b c))

    ((progn (if (probe-file test-file) (delete-file test-file))
	    (collect-file test-file #Z(#\a #\space #\newline #\c) #'write-char)
	    (collect (scan-file test-file #'read-line)))
     ("a " "c"))

    ((collect-last #Z(a b c)) c)
    ((collect-last #Z()) nil)
    ((collect-last #Z() 'fill) fill)

    ((collect-length #Z(a b c)) 3)
    ((collect-length #Z()) 0)
    ((collect-length (choose (#Mplusp #Z(1 -1 2 -2)))) 2)

    ((collect-sum #Z(1 2 3)) 6)
    ((collect-sum #Z(1 2 3) 'float) 6.0)
    ((collect-sum #Z() 'float) 0.0)

    ((collect-min #Z(1 2 3)) 1)
    ((collect-min #Z(2 1 3) #Z(a b c) 4) b)
    ((collect-min #Z()) nil)
    ((collect-min #Z() #Z(a b c) 4) 4)
    ((collect-min #Z(a b c) #Z() 4) 4)

    ((collect-max #Z(1 2 3)) 3)
    ((collect-max #Z(1 3 2) #Z(a b c)) b)
    ((collect-max #Z()) nil)
    ((collect-max #Z() #Z(a b c) 4) 4)

    ((collect-fn T #'(lambda () 0) #'+ #Z(1 2 3)) 6)
    ((collect-fn 'integer #'(lambda () 0) #'+ #Z(1 2 3)) 6)
    ((collect-fn 'integer #'(lambda () 0) #'(lambda (x y) (+ x y)) #Z(1 2 3)) 6)
    ((collect-fn T #'(lambda () 0) #'(lambda (&rest args) (apply #'+ args))
		 #Z(1 2 3)) 6)
    ((collect-fn T #'(lambda () 0) #'- #Z(1 2 3)) -6)
    ((collect-fn T #'(lambda () 0) #'+ #Z()) 0)
    ((collect-fn T #'(lambda () T) #'+ #Z()) T)
    ((multiple-value-list
       (collect-fn ' (values list integer) #'(lambda () (values nil 0))
		   #'(lambda (a b x y) (values (cons (list x y b) a) (1+ b)))
		   #Z(A B C) #Z(1 2 3)))
     (((c 3 2) (b 2 1) (a 1 0)) 3))
    ((multiple-value-list
       (collect-fn '(values list integer) #'(lambda () (values nil 0))
		   #'(lambda (a b x y) (values (cons (list x y b) a) (1+ b)))
		   #Z(A B C) #Z(1 2 3)))
     (((c 3 2) (b 2 1) (a 1 0)) 3))

    ((encapsulated #'(lambda (b) `(lisp:let ((xx 0)) ,b))
		   (collect-fn T #'(lambda () 0)
			       #'(lambda (sum x)
				   (incf xx)
				   (+ sum x xx))
			       #Z(10 20 30))) 66)
    ((multiple-value-list
       (encapsulated #'(lambda (b) `(lisp:let ((xx 0)) ,b))
		     (collect-fn '(values t t)
				 #'(lambda () (values 0 1))
				 #'(lambda (sum prod x)
				     (incf xx)
				     (values (+ sum x xx) (* prod x xx)))
				 #Z(10 20 30)))) (66 36000))

    ((collect-first #Z(a b c)) a)
    ((collect-first #Z()) nil)
    ((collect-first #Z() 'T) T)
    ((collect-first (#Mcar #Z((T) (nil) 4))) T)
    ((collect-first (positions (#Mplusp #Z(-3 1 -1 3 -2)))) 1)
    ((collect-first (choose #Z(nil t nil) #Z(0 1 -1 3 -2))) 1)

    ((collect-nth 1 #Z(a b c)) b)
    ((collect-nth 1 #Z()) nil)
    ((collect-nth 1 #Z() 'T) T)
    ((collect-nth 1 (#Mcar #Z((T) (nil) 4))) nil)

    ((collect-and #Z(1 2)) 2)
    ((collect-and (#Mcar #Z((T) (nil) 4))) nil)
    ((collect-and #Z()) T)

    ((collect-or #Z(nil)) nil)
    ((collect-or (#Mcar #Z((T) (nil) 4))) T)
    ((collect-or #Z()) nil)

;this contains tests of the various special forms supported.
    ((let* ((lst (list 'a 'b 'c))
	    (l (scan-sublists lst))
	    (e (to-alter (#Mcar l)
			 #'(lambda (new parent)
			     (rplaca parent new))
			 l)))
       (list (collect e)
	     (alter e (#Mlist e))
	     (collect e)
	     lst))
     ((a b c) nil (a b c) ((a) (b) (c))))
    ((let* ((lst (list 1 2 3))
	    (l (scan-sublists lst))
	    (e (to-alter (#Mcar l)
			 #'(lambda (new parent num)
			     (rplaca parent (+ new num)))
			 l (series 10))))
       (alter e (#M1+ e))
       lst)
     (12 13 14))

    ((let* ((x #Z(a b c))
	     (xx (#Mlist x)))
       (collect (#Mlist x xx))) ((a (a)) (b (b)) (c (c))))
    ((let* ((x #Z(a b c))
	     (x (#Mlist x)))
       (collect x)) ((a) (b) (c)))
    ((let ((x 9))
       (let ((x #Z(a b c))
	      (xx (series (list x))))
	 (collect (#Mlist x xx)))) ((a (9)) (b (9)) (c (9))))
    ((let () (collect #Z(a b c))) (a b c))
    ((let* ((e 3)
	     (f #Z(a b c))
	     (g (collect f))
	     (h (collect #Z(a b c))))
       (list e g h)) (3 (a b c) (a b c)))
    ((let ((x (collect #Z(1 2 3))))
       (list x)
       x) (1 2 3))
    ((let ()) nil)
    ((multiple-value-bind (key value) (scan-alist '((a . 1) (b . 2)))
       (collect (#Mlist key value))) ((a 1) (b 2)))
    ((let ((key (scan-alist '((a . 1) (b . 2)))))
       (collect key)) (a b))

    ((collect-alist #Z(a b) (series (* 2 3))) ((b . 6) (a . 6)))
    ((let ((x 1))
       (collect-alist #Z(a b) (series (setq x (1+ x))))) ((b . 2) (a . 2)))

    ((collect-sum (#Mcar #Z((1) (2)))) 3)
    ((collect-sum (#M(lambda (x) (* 2 x)) #Z(1 2))) 6)
    ((let ((x 1))
       (collect (#M(lambda (y) (list y (setq x (1+ x)))) #Z(a b)))) ((a 2) (b 3)))
    ((let ((x 1))
       (collect (#Mlist #Z(a b) (series (setq x (1+ x)))))) ((a 2) (b 2)))
    ((collect (#M(lambda (x y) (if (plusp x) y))
	       #Z(10 -11 12) (scan-range))) (0 nil 2))
    ((collect (choose (#Mplusp #Z(10 -11 12)) (scan-range))) (0 2))

    ((let ((z #Z(1 2)))
       (collect (#M(lambda (z) (do ((x 1 (1+ x)) (sum 0 (+ sum x)))
				   ((> x z) sum))) z)))
     (1 3))
    ((let ((z #Z((1 2) (3 4))))
       (collect (#M(lambda (x) (collect (scan x))) z))) ((1 2) (3 4)))

    (test-def ((defun foo (list) "doc"
		   (declare (optimizable-series-function))
		 (#Mcar (scan list)))
	       (list #+symbolics(documentation 'foo 'function)
		     (collect (foo '((a) (b) (c))))))
     (#+symbolics"doc" (a b c)))
    (test-def ((defun foo02 (v)
		 (declare (optimizable-series-function) ((vector *) v))
		   "doc"
		 (#Mcar (scan 'vector v)))
	       (list #+symbolics(documentation 'foo02 'function)
		     (collect (foo02 '#((a) (b) (c))))))
     (#+symbolics"doc" (a b c)))

    (test-def ((defun foo1 (list &optional (plus 1))
		   (declare (optimizable-series-function))
		 (#M(lambda (x) (+ x plus)) (scan list)))
	       (list (collect (foo1 '(1 2 3) 3))
		     (collect (foo1 '(1 2 3)))))
     ((4 5 6) (2 3 4)))

    (test-def ((defun foo2 (list &optional (plus 1 p?))
		   (declare (ignore plus) (optimizable-series-function))
		 (#M(lambda (x) (list x p?)) (scan list)))
	       (list (collect (foo2 '(1 2 3) 3))
		     (collect (foo2 '(1 2 3)))))
     (((1 T) (2 T) (3 T)) ((1 nil) (2 nil) (3 nil))))

    (test-def ((defun foo3 (numbers)
		   (declare (optimizable-series-function))
		 (collect-sum (#M1+ numbers)))
	       (foo3 (mapping ((x (scan '(1 2 3)))) (1+ x))))
	      12)

    (test-def ((defun my-collect-last (items &optional (default nil))
		 (declare (optimizable-series-function))
		 (collect-fn '(series-element-type items)
			     #'(lambda () default)
			     #'(lambda (old new) (declare (ignore old)) new)
			     items))
	      (list (my-collect-last #Z()) (my-collect-last #Z(1 2))))
	      (nil 2))
    (test-def ((defun my-collect-last2 (items &optional (default nil))
		 (declare (optimizable-series-function))
		 (collect-fn '(series-element-type foo)
			     #'(lambda () default)
			     #'(lambda (old new) (declare (ignore old)) new)
			     items))
	      (list (my-collect-last2 #Z()) (my-collect-last2 #Z(1 2))))
	      (nil 2))

    ((multiple-value-list
       (let ((x #Z(a b))) (values (collect x) (collect 'bag x))))
     ((a b) (b a)))

    ((multiple-value-bind (a b)
         (#2M(lambda (x) (let ((*package* (find-package "USER")))
			   (intern (string x))))
	  #Z(x y))
       (collect (#Mlist a b))) ((x :internal) (y :internal)))

    ((let ((v (list 1 -2 3)))
       (let ((x (choose-if #'minusp (scan v))))
	 (alter x (#M- x)))
       v) (1 2 3))
    ((let ((x (list 'a 'b 'c)))
       (alter (scan x) (scan-range))
       x) (0 1 2))
    ((let ((x '((a) (b) (c))))
       (iterate ((a (scan x)) (b (scan-range)))
	 (setf (car a) b))
       x) ((0) (1) (2)))

    ((let ((e (scan (list 1 2)))) (alter e (#M1+ e)) (collect e)) (1 2))
    ((let ((x #Z(1 2 3))
		  (y #Z(4 5)))
       (list (collect-sum x) (collect-sum y))) (6 9))
    ((list (collect-sum #Z(1 2 3)) (collect-sum #Z(4 5))) (6 9))

    ((collect (producing (y) ((x #Z((1) (2))) (item nil))
		(loop
		 (tagbody
		  (setq item (next-in x (terminate-producing)))
		  (next-out y (car item)))))) (1 2))
    ((producing ((number 0)) ((numbers #Z(1 2)) num)
         (declare ((series integer) numbers) (integer number num))
       (loop
	(tagbody
	 (setq num (next-in numbers (terminate-producing)))
	 (setq num (1+ num))
	 (setq number (+ number num))))) 5)
    ((multiple-value-bind (sum y)
	 (producing ((number 0) y) ((numbers #Z(1 2)) num)
	   (loop
	     (tagbody
	       (setq num (next-in numbers (terminate-producing)))
	       (setq num (1+ num))
	       (setq number (+ number num))
	       (next-out y num))))
       (list sum (collect y)))
       (5 (2 3)))
    ((multiple-value-bind (sum y)
	 (producing ((number 0) y) ((numbers #Z(1 2)) num)
	   (loop
	     (tagbody
	       (setq num (next-in numbers (terminate-producing)))
	       (setq num (1+ num))
	       (if (evenp num) (go J))
	       (next-out y num)
	     J (setq number (+ number num)))))
       (list sum (collect y)))
       (5 (3)))
    ((let ((list nil))
       (producing ((x nil)) ((numbers #Z(1 2)) num)
	 (loop
	  (tagbody
	   (setq num (next-in numbers (terminate-producing)))
	   (push num list))))
       list) (2 1))
    ((nreverse (producing ((list nil)) ((items #Z(1 2)) item)
		    (declare (list list))
		  (loop
		   (tagbody
		    (setq item (next-in items (terminate-producing)))
		    (setq list (cons item list)))))) (1 2))
    ((collect (producing (items) ((list '(1 2)) item)
	        (loop
		 (tagbody
		  (if (endp list) (terminate-producing))
		  (setq item (car list))
		  (setq list (cdr list))
		  (next-out items item))))) (1 2))
    ((collect (producing (items) ((Nitems1 #Z(1 2)) (Nitems2 #Z(3 4))
				  (done nil) item)
		(loop
		 (tagbody
		    (if done (go D))
		    (setq item (next-in Nitems1 (setq done T) (go D)))
		    (go F)
		  D (setq item (next-in Nitems2 (terminate-producing)))
		    (setq item (1+ item))
		  F (next-out items item))))) (1 2 4 5))
    ((multiple-value-bind (x+ x-)
         (producing (Nitems1 Nitems2) ((items #Z(1 -2 3 -4)) (pred #'plusp) item)
	   (loop
	    (tagbody
	       (setq item (next-in items (terminate-producing)))
	       (if (not (funcall pred item)) (go D))
	       (next-out Nitems1 item)
	       (go F)
	     D (next-out Nitems2 item)
	     F)))
       (list (collect-sum x+) (collect-sum x-))) (4 -6))
    ((collect (producing (items) ((Nitems #Z(1 -2 3)) item)
		   (declare (type (series integer) Nitems))
		 (loop
		  (tagbody
		     L (setq item (next-in Nitems (terminate-producing)))
		       (if (not (plusp item)) (go L))
		       (next-out items item))))) (1 3))
    ((let*
        ((lst (list 1 2 3))
	 (e (producing (items) ((Nitems (scan lst)) item)
	        (declare (type (series integer) Nitems)
			 (propagate-alterability Nitems items))
	      (loop
	       (tagbody
		  L (setq item (next-in Nitems (terminate-producing)))
		    (if (not (plusp item)) (go L))
		    (next-out items item))))))
       (list (collect e) (alter e (#M1+ e)) (collect e) lst))
     ((1 2 3) nil (1 2 3) (2 3 4)))
    ((let*
        ((lst (list 1 2 -3 4))
	 (y (producing (items) ((Nitems (scan lst)) item)
	        (declare (type (series integer) Nitems)
			 (propagate-alterability Nitems items))
	      (loop
	       (tagbody
		  L (setq item (next-in Nitems (terminate-producing)))
		    (if (not (plusp item)) (go L))
		    (next-out items item))))))
       (alter y (#M1+ y))
       lst) (2 3 -3 5))
    ((let ((x '(1 2 3)))
       (producing ((xx nil)) ()
	 (loop
	   (tagbody
	     (setq xx (if (null x) (terminate-producing) (pop x)))))))
     3)
    (test-def ((defmacro Rcount (items)
		 (let ((counter (gensym)))
		   `(encapsulated #'(lambda (body)
				      (list 'let '((,counter 0))
					    body))
				  (collect-fn 'fixnum
					      #'(lambda () 0)
					      #'(lambda (count x)
						  (declare (ignore count x))
						  (incf ,counter))
					      ,items))))
	       (Rcount #Z(1 2 3))) 3)

;
;the following tests all kinds of wierd combinations
;mg1
    ((funcall #'(lambda (x) (let ((z (list x))) (list z))) 4)
     ((4)))
    ((funcall #'(lambda (x) (nreverse (collect 'bag x))) #Z(a b c))
     (a b c))
    ((funcall #'(lambda (x) (collect (#Mlist x))) #Z(a b c))
     ((a) (b) (c)))
;mg2
    ((funcall #'(lambda (x y)
		   (list (collect x) (collect (choose (#Mplusp y) y))))
	       #Z(a b c) #Z(1 -2 3))
     ((a b c) (1 3)))
    ((funcall #'(lambda (x y)
		   (list (collect (choose (#Mplusp y) y)) (collect x)))
	       #Z(a b c) #Z(1 -2 3))
     ((1 3) (a b c)))

;mg3
    ((collect (funcall #'(lambda (x y z) (catenate (mingle x y #'<) z))
		      #Z(1 2 4) #Z(1 3 3) #Z(0)))
     (1 1 2 3 3 4 0))
    ((multiple-value-bind (a b) (scan-plist '(k1 2 k2 4))
       (list (collect b)
	     (collect (expand (series nil nil T nil T nil nil nil T)
			     a nil))))
     ((2 4) (nil nil k1 nil k2 nil nil nil)))
    ((collect (funcall #'(lambda (x)
			    (multiple-value-bind (a b) (scan-plist x)
			      (expand #Z(nil nil T nil T nil nil nil T)
				      a nil)
			      b))
		      '(k1 2 k2 4)))
     (2 4))
    ((collect (funcall #'(lambda (x) (catenate (#Mlist x) #Z(5 6)))
		      #Z(1 2 3)))
     ((1) (2) (3) 5 6))
    ((collect (funcall #'(lambda (x) (catenate (choose (#Mplusp x) x) #Z(5 6)))
		      #Z(1 -2 3)))
     (1 3 5 6))
    ((collect (funcall #'(lambda (x) (choose-if #'evenp (split-if x #'plusp)))
		      #Z(1 2 -2 3 4)))
     (2 4))
    ((collect (funcall #'(lambda (x) (#Mlist (split-if x #'plusp)))
		      #Z(1 2 -2 3 4)))
     ((1) (2) (3) (4)))
;mg4
    ((multiple-value-bind (a b) (scan-plist '(k1 1 k2 -2))
       (list (collect a) (collect (choose-if #'plusp b))))
     ((k1 k2) (1)))
    ((collect (funcall #'(lambda (x)
			  (multiple-value-bind (a b) (scan-plist x)
			    (collect (choose-if #'plusp b)) a))
		      '(k1 1 k2 -2)))
     (k1 k2))
    ((let (z)
       (list (collect (funcall #'(lambda (x)
				  (multiple-value-bind (a b) (scan-plist x)
				    (setq z (collect  'bag (choose-if #'plusp b)))
				    (#Mlist a)))
			      '(k1 1 k2 -2)))
	     z))
     (((k1) (k2)) (1)))
;mg5
    ((multiple-value-bind (A B)
	     (funcall #'(lambda (x y)
			   (cotruncate (choose (#Mplusp x) x) (scan y)))
		       #Z(1 -2 3) '(a b c))
       (list (collect a) (collect b)))
     ((1 3) (a b)))

    ((multiple-value-bind (A B)
	     (funcall #'(lambda (x y)
			   (cotruncate (choose (#Mplusp x) x) (scan y)))
		       #Z(1 -2 3) '(a b c))
       (list (collect a) (collect b)))
     ((1 3) (a b)))

;these are weird tests checking for particular bugs in old versions
    ((multiple-value-list
       (let ((strings (choose-if #'stringp (scan '(1 2 "COND" 4)))))
	 (find-symbol (collect-first strings))))
     (cond :inherited))
    (test-def ((defun weighted-sum (numbers weights)
		 (declare (optimizable-series-function 2) (off-line-port weights))
		 (values (collect-sum numbers) (collect-sum (#M* numbers weights))))
	       (list (multiple-value-list (weighted-sum #Z(1 2 3) #Z(3 2)))
		     (multiple-value-list (weighted-sum #Z(1 2) #Z(3 2)))
		     (multiple-value-list (weighted-sum #Z(1) #Z(3 2)))))
	      ((6 7) (3 7) (1 3)))
    (test-def ((defun non-series-used-twice (x)
		 (declare (optimizable-series-function))
		 (let ((s (scan-range)))
		   (scan (list (collect-nth x s) (+ x (collect-nth x s))))))
	       (collect (non-series-used-twice (1+ 2))))
	      (3 6))
    (test-def ((defun baz (items)
		 (declare (optimizable-series-function))
		 (let ((items items))
		   (collect items)))
	       (baz #Z(1 2 3)))
	      (1 2 3))
   ((let ((z -1))
      (let ((e #Z(1 2 3)))
        (setq z (collect-last e))
	z)) 3)
    ((let ((x (list 1 2 3)))
       (collect-last
	 (#M(lambda (x y) (list (setf (car x) y)))
	  (scan-sublists x) #Z(a b c d))) x)
     (a b c)) ;don't want to have any complaints from setf here.
    ((collect-first (choose-if #'(lambda (x) (and (car x) (cdr x)))
			#Z((a) (nil . b) (a . b) (c)))) (a . b))
    ((let ((l (car '((1 2 3 4)))))
       (collect (#Mlist (scan l) (scan l)))) ((1 1) (2 2) (3 3) (4 4)))
    ((let ((x nil))
       (iterate ((y #Z(1 2)))
         (push y x)) x) (2 1))

;now obsolete, because PROG and PROG* are macros.
     (identity)(identity)(identity)(identity)
;    ((let ((series::*renames* '((x . 2) (y . 3))) series::*env*)
;       (series::m-&-r '(prog (x) (list x y)))) (prog (x) (list x 3)))
;    ((let ((series::*renames* '((x . 2) (y . 3))) series::*env*)
;       (series::m-&-r '(prog a (x) (list x y)))) (prog a (x) (list x 3)))
;    ((let ((series::*renames* '((x . 2) (y . 3))) series::*env*)
;       (series::m-&-r '(prog* (x) (list x y)))) (prog* (x) (list x 3)))
;    ((let ((series::*renames* '((x . 2) (y . 3))) series::*env*)
;       (series::m-&-r '(prog* a (x) (list x y)))) (prog* a (x) (list x 3)))	

    ((let ((x #Z(2 -1 0 1 -2)))
       (list (collect-sum (choose-if #'plusp x))
	     (collect-sum (choose-if #'minusp x)))) (3 -3))
    ((let ((x #Z(2 -1 0 1 -2)))
       (list (collect-sum (choose-if #'plusp x))
	     (collect-sum (choose (#Mminusp x) x))))
     (3 -3))
    ((let ((x (split-if #Z(2 -1 a 0 b 1 -2) #'numberp)))
       (list (collect-sum x) (collect-sum (choose-if #'minusp x)))) (0 -3))
    ((let ((x (split-if #Z(2 -1 a 0 b 1 -2) #'numberp)))
       (list (collect-sum x) (collect 'bag (choose-if #'plusp x)))) (0 (1 2)))
    ((let ((x (split-if #Z(2 -1 a 0 b 1 -2) #'numberp)))
       (list (collect-sum x)
	     (collect 'bag (choose-if #'plusp x))
	     (collect-sum (choose-if #'plusp x))))
     (0 (1 2) 3))
    ((let ((x (split-if #Z(2 -1 a 0 b 1 -2) #'numberp)))
       (list (collect-sum (choose-if #'plusp x))
	     (collect-sum (choose-if #'minusp x)))) (3 -3))
    ((let ((x (split-if #Z(2 -1 a 0 b 1 -2) #'numberp)))
       (list (collect-sum (choose-if #'plusp x))
	     (collect-sum (choose (#Mminusp x) x))))
     (3 -3))
    ((let ((x (split-if #Z(2 -1 a 0 b 1 -2) #'numberp)))
       (list (collect-sum (choose-if #'plusp x))
	     (collect 'bag (choose-if #'plusp x))))
     (3 (1 2)))
    ((let ((x (split-if #Z(2 -1 a 0 b 1 -2) #'numberp)))
       (list (collect-sum (choose-if #'plusp x))
	     (collect 'bag (choose-if #'plusp x))
	     (collect-sum (choose-if #'plusp x))))
     (3 (1 2) 3))

    ((let ((v (list 1 -2 3)))
       (let* ((e (scan v))
	       (x (until-if #'minusp e)))
	 (alter x (#M- x)))
       v) (-1 -2 3))
     ((collect (subseries (mask (positions #Z(t nil t nil))) 0 5))
      (t nil t nil nil))
     ((let ((x '(1 2 3)))
	(macrolet ((bab (z) `(list ,z)))
	  (collect (scan (bab x))))) ((1 2 3)))
     ((let (xx)
	(list (collect (let ((x (car '(1))) (y (scan '(1 2))))
			 (when x (setq xx x))
			 (#M+ y (scan-range :upto x))))
	      xx)) ((1 3) 1))
     ((let (xx)
	(list (collect (let ((x (car '(1))) (y (scan '(1 2))))
			 (when x (setq xx (collect (scan-range :upto x))))
			 (#M+ y (scan-range :upto x))))
	      xx)) ((1 3) (0 1)))
     ((let (xx)
	(list (collect (let ((x (car '(1))) (y (scan '(1 2))))
			 (when t (setq xx (collect (scan-range :upto 2))))
			 (#M+ y (scan-range :upto x))))
	      xx)) ((1 3) (0 1 2)))
     ((let ((x #Z(1 2)))
	(if (collect-sum x) 1 2)) 1)

    ((let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (list a (collect z) b)) (nil (1 2) (1 2)))
    ((let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (list a (setq a (length a)) a (collect z) b))
     (nil 0 0 (1 2) (1 2)))
    ((let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (list a (setq a 3) a (collect z) b))
     (nil 3 3 (1 2) (1 2)))
    ((let ((zz nil))
       (let* ((a nil) (z (scan '(1 2))) (b (collect z)))
	 (list a (multiple-value-setq (zz a) (truncate 5 2))
	       a zz (collect z) b)))
     (nil 2 1 2 (1 2) (1 2)))
    ((let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (setq z (#M1+ z))
       (list a (collect z) b)) (nil (2 3) (1 2)))
    ((let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (list b (setq b 4) a (collect z) b))
     ((1 2) 4 nil (1 2) 4))
    ((let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (setq a (#M1+ z))
       (list (collect a) (collect z) b))
     ((2 3) (1 2) (1 2)))
    ((let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (setq z (collect-sum z))
       (list a z b))
     (nil 3 (1 2)))
    ((let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (when (not a) (setq b 3))
       (list a (collect z) b))
     (nil (1 2) 3))
    ((let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (list a (collect z) b (when (not a) (setq b 3)) b))
     (nil (1 2) (1 2) 3 3))
    ((let* ((a 2) (z (scan '(1 2))) (b (collect z)))
       (list a (collect z) b (when a (setq a 3)) a))
     (2 (1 2) (1 2) 3 3))
    ((let* ((a 3) (z (scan '(1 2))) (b (collect z)))
       (list a (collect (#M(lambda (y) (setq a (1+ a)) (+ a y)) z))
	     a (collect z) b))
     (3 (5 7) 5 (1 2) (1 2)))
    ((let* ((a 3) (z (scan '(1 2))) (b (collect z)))
       (list (collect z)
	     (collect (#M(lambda (y) (setq z -3) (1+ y)) z))
	     a z b))
     ((1 2) (2 3) 3 -3 (1 2)))
    ((let* ((z 0))
       (list z
	     (collect (scan-fn t #'(lambda () (car (setq z (list '(1 2 3)))))
			       #'(lambda (l) (car (push (cdr l) z)))
			       #'(lambda (l) (push (car l) z) (null l))))
	     (reverse z)))
     (0 ((1 2 3) (2 3) (3)) ((1 2 3) 1 (2 3) 2 (3) 3 nil nil)))

    ((let ((z nil))
       (let* ((x #Z(1 2 3)))
	 (setq z (cons (collect-sum x) z))
	 (setq z (cons 'a z))
	 (cons 'b z)))
     (b a 6))
    ((let ((z nil))
       (let* ((x #Z(1 2 3)))
	 (setq z (cons 'a z))
	 (setq z (cons (collect-sum x) z))
	 (cons 'b z)))
     (b 6 a))
    ((let ((z nil))
       (let* ((x (scan (progn (push 1 z) '(1 2))))
	      (y (scan (progn (push 2 z) '(1 3)))))
	 (setq z (cons (collect-sum x) z))
	 (setq z (cons (collect-sum y) z))
	 (cons 'b z)))
     (b 4 3 2 1))
    ((let ((*print-length* nil) (*print-level* nil))
       (with-output-to-string (s)
	 (prin1 #Z(1 2) s)))
     "\#Z(1 2)")
    ((let ((*print-length* 1) (*print-level* 3))
       (with-output-to-string (s)
	 (prin1 #Z(1 2) s)))
     "\#Z(1 ...)")
    ((let ((x #Z(1 2 3)) (y 4))
       (setq y (collect (#M+ (series y) x))))
     (5 6 7))
    ((collect (let ((x #Z(1 2 3 4)) (y (series 4)))
		(setq y (split-if (#M+ y x) #'evenp))))
     (6 8))
    (test-def ((defun pip1 (x)
		 (declare (optimizable-series-function) (off-line-port 0))
		 (push 3 x)
		 (values (scan x) (scan (cdr x))))
		(multiple-value-bind (a b) (pip1 '(a b))
		  (list (collect a) (collect b))))
	      ((3 a b) (a b)))

;tests of places where some termination points are not connected to every output
    ((let ((x #Z(1 2 3)))
       (list (collect-first x) (collect-sum x)))
     (1 6))
    ((let ((x #Z(foo nil bar)))
       (list (collect-and x) (collect x)))
     (nil (foo nil bar)))
    ((let ((z 0))
       (list (let ((x #Z(1 2 3)))
	       (iterate ((v x))
		 (setq z (+ z v)))
	       (collect-first x))
	     z))
     (1 6))
    ((let ((z 0))
       (list (let ((x #Z(1 2 3)))
	       (mapping ((v x))
		 (setq z (+ z v)))
	       (collect-first x))
	     z))
     (1 0))
    ((multiple-value-list
       (let* ((x (list 'a 'b 'c 'd))
		     (e (scan x)))
	 (values (collect e)	
		 (let () (alter e (scan '(1 2))) (collect e))
		 x)))
     ((a b c d) (a b c d) (1 2 c d)))
    ((let ((x #Z(1 2 3))
		  (y #Z(4 5 6 7)))
       (list (collect-sum (#M+ x y)) (collect-sum y)))
     (21 22))
    ((let ((x #Z(1 2 3))
		  (y #Z(4 5 6 7)))
       (list (collect-sum (#M+ x y)) (collect-sum y) (collect-sum y)))
     (21 22 22))
    ((let* ((e #Z(1 -2 -4 3))
		   (f #Z(a)))
       (multiple-value-bind (w x) (split-if e #'plusp)
	 (list (collect (#Mlist w))
	       (collect (#Mlist x f)))))
     (((1) (3)) ((-2 a))))
    ((let ((e #Z(1 -2 -4 3 5 6)))
       (list (collect e) (collect (subseries e 1 3))))
     ((1 -2 -4 3 5 6) (-2 -4)))
    ((let ((e #Z(1 -2 -4 3 5 6)))
       (list (collect e) (collect (#Mlist (subseries e 1 3) #Z(a)))))
     ((1 -2 -4 3 5 6) ((-2 a))))
    ((let* ((e1 #Z(1 -2 -4 3)) (e2 #Z(1 -2 -4 3)) (e3 #Z(1 -2 -4 3))
		   (w1 (split-if e2 #'plusp)))
       (multiple-value-bind (x1 x2) (split-if e3 #'plusp)
	   (declare (ignore x1))
	 (list (collect (#Mlist e1 w1)) (collect (#Mlist w1 x2)))))
     (((1 1) (-2 3)) ((1 -2) (3 -4))))
    (test-def ((defun bar1 (numbers)
		   (declare (optimizable-series-function) (off-line-port numbers))
		 (scan (collect numbers)))
	       (collect-sum (bar1 (scan-range :upto 3))))
	      6)
    (test-def ((defun bar2 (numbers others)
 		   (declare (optimizable-series-function)
			    (type (series integer) numbers)
			    (off-line-port numbers others))
		 (list (collect-sum numbers) (collect-sum others)))
	       (bar2 (scan-range :upto 3) (scan-range :upto -1)))
	      (6 0))
    (test-def ((defun bar3 (numbers others)
		   (declare (type series numbers others)
			    (optimizable-series-function)
			    (off-line-port numbers others))
		 (iterate ((n numbers))
		   (setq *x* n))
		 (collect-sum others))
	       (list (bar3 (scan-range :upto 3) (scan-range :upto 0)) *x*))
	      (0 3))
    (test-def ((defun bar4 (numbers others)
		   (declare (optimizable-series-function 2)
			    (type (series nil) y others)
			    (off-line-port numbers others))
		 (values (collect-sum numbers) (collect-sum others)))
	       (multiple-value-list
		 (bar4 (scan-range :upto 3) (scan-range :upto -1))))
	      (6 0))
    (test-def ((defun bar5 (numbers)
		   (declare (optimizable-series-function 2)
			    (type (series t) numbers))
		 (floor (collect-sum numbers) 4))
	       (multiple-value-list (bar5 (scan-range :upto 3))))
	      (1 2))

;tests of declarations and the like that only apply to optimization

    (test-opt
      (not (null (member '(type integer x)
			 (decls (let ((x #Z(1 2 3)))
				  (declare (type (series integer) x))
				  (collect-sum x))) :test #'equal))) T)
    (test-opt
      (not (null (member '(type integer x)
			 (decls (let* ((y #Z(1 2))
				       (x (the integer (collect-sum y))))
				  (list x x))) :test #'equal))) T)
    (test-opt
      (not (null (member '(type integer y)
			 (decls (let* ((y (the (series *) #Z(1 2)))
				       (x (collect-sum y)))
				  (list x x))) :test #'equal))) nil)
    (test-opt
      (not (null (member '(type integer y)
			 (decls (let* ((y (the (series integer) #Z(1 2)))
				       (x (collect-sum y)))
				  (list x x))) :test #'equal))) T)

;tests of some otherwise hard to test internal functions
;these would probably have to be changed a good deal if there were any
;significant internal modifications in the way things worked.

     ((series::nsubst-inline nil 1 (list 3 1 2)) (3 2))
     ((series::nsubst-inline nil 4 (list 3 1 2)) (3 1 2))
     ((series::nsubst-inline nil 2 (list 3 1 2)) (3 1))

     ((series::active-terminator-p
	(series::make-frag :prolog `((if (car x) (go ,series::end))))) T)
     ((series::active-terminator-p
	(series::make-frag :prolog `((tagbody ,series::end
					      (if (car x) (go ,series::end)))))) nil)
     ((series::active-terminator-p
	(series::make-frag :prolog `((tagbody (if (car x) (go ,series::end)))))) t)

     ((series::vars-of '((:foo bar) 1 bar-p)) (bar bar-p))

     ((series::make-general-setq '(x y) '(values 1 2)) (psetq x 1 y 2))
     ((series::make-general-setq '(x y) '(values 1 2 3))
      (multiple-value-setq (x y) (values 1 2 3)))

     ((let ((code (copy-tree '((setq x 3) (setq y 4)))))
	(series::clean-code1 '(x) code) code) ((setq y 4)))
     ((let ((code (copy-tree '((setq x 3)))))
	(series::clean-code1 '(x) code) code) (3))
     ((let ((code (copy-tree  '((progn (setq x 3) . 4)))))
	(series::clean-code1 '(x) code) code) ((progn . 4)))
     ((let ((code (copy-tree '((progn (setq x 3))))))
	(series::clean-code1 '(x) code) code) ((progn)))

     ((series::make-test nil) t)
     ((series::make-test '((x y) (x))) x)
     ((series::make-test '((x z) (x y w))) (or x (and z (or y w))))
     ((series::make-test '((x z) (x y w) (z))) (and (or x y w) z))

;tests of generators and gatherers.

     ((let ((l nil)
	    (x (generator (scan '(1 2 3 4)))))
	(loop (push (next-in x (return nil)) l)
	      (push (next-in x (return nil)) l)
	      (push '+ l))
	(nreverse l)) (1 2 + 3 4 +))
     ((let ((l nil)
	    (x (generator (scan '(1 2 3 4)))))
	(loop (push (next-in x (next-in x (return nil))) l)
	      (push (next-in x (return nil)) l)
	      (push '+ l))
	(nreverse l)) (1 2 + 3 4 +))
     ((let ((l nil)
	    (x (generator (scan '(1 2 3 4)))))
	(loop (push (next-in x 44) l)
	      (if (= 44 (car l)) (return nil))
	      (push (next-in x 55) l)
	      (if (= 55 (car l)) (return nil))
	      (push '+ l))
	(nreverse l)) (1 2 + 3 4 + 44))

     ((let ((g (gatherer #'collect-sum)))
	(next-out g 3)
	(next-out g 4)
	(result-of g)) 7)
     ((let ((g (gatherer #'(lambda (x) (collect x)))))
	(result-of g)) nil)
     ((let ((g (gatherer #'(lambda (x) (collect (choose-if #'plusp x))))))
	(next-out g 3)
	(next-out g -3)
	(next-out g 4)
	(result-of g)) (3 4))
     ((let ((g (gatherer #'(lambda (x) (collect (choose (#Mplusp x) x))))))
	(next-out g 3)
	(next-out g -3)
	(next-out g 4)
	(result-of g)) (3 4))
     ((progn (if (probe-file test-file) (delete-file test-file))
	     (let ((g (gatherer #'(lambda (x) (collect-file test-file x)))))
	       (next-out g 3)
	       (next-out g 4)
	       (list (result-of g) (collect (scan-file test-file))))) (T (3 4)))
     ((let ((x (gatherer #'(lambda (x) (collect x))))
	    (y (gatherer #'(lambda (ns) (collect-sum (choose-if #'oddp ns))))))
	(dotimes (i 4)
	  (next-out x i)
	  (next-out y i)
	  (if (evenp i) (next-out x (* i 10))))
	(list (result-of x) (result-of y))) ((0 0 1 2 20 3) 4))

     ((gathering ((y collect-sum))
	(next-out y 1) (next-out y 2)) 3)
     ((progn (if (probe-file test-file) (delete-file test-file))
	     (prog1 (list (gathering ((g (lambda (x) (collect-file test-file x))))
		            (next-out g 3)
			    (next-out g 4))
			  (collect (scan-file test-file)))
	            (if (probe-file test-file) (delete-file test-file)))) (T (3 4)))
     ((multiple-value-list
	(gathering ((x (lambda (x) (collect x)))
		    (y collect-sum))
	  (dotimes (i 3)
	    (next-out y i)
	    (if (evenp i) (next-out x (* i 10)))))) ((0 20) 3))

;the following tests were introduced to insure that every control path
;in the system is exercised by atleast one test.

    ((let ((xx 0))
       (list (let ((x #Z(1 2 3)))
	       (producing ((number 0) y) ((numbers x) num)
		 (loop
		   (tagbody
		     (setq num (next-in numbers (terminate-producing)))
		     (setq num (1+ num))
		     #-CLISP nil
		     (setq xx (cons num '(1)))
		     (setq number (+ number num))
		     (next-out y num))))
	       (collect x))
	     xx))
     ((1 2 3) (4 1)))
    (test-non-opt (typep #Z(1 2 3) 'series) t)
    (test-non-opt (typep (cotruncate #Z(1 2 3) #Z(1 2)) 'series) t)

    ((collect (funcall #'scan '(1 2))) (1 2))
    (test-opt (funcall #'collect #Z(1 2)) (1 2))
    ((funcall #'(lambda (x &optional (y 2)) (list x y)) 1) (1 2))

    ((let ((x #Z(1 2 3)))
       (multiple-value-bind (a b) (collect x)
	 (list a b)))
     ((1 2 3) nil))

    ((let ((x #Z(a b c)))
       (list (collect x) (collect (catenate x #Z(1 2)))))
     ((a b c) (a b c 1 2)))
    ((let ((xx nil))
       (list (collect
	       (catenate (producing (a (b nil)) ((x #Z(1 2 3)))
			   (loop (tagbody (setq b (next-in x (terminate-producing)))
					  (setq xx b)
					  (next-out a (list b)))))
			 #Z(1 2)))
	     xx))
     (((1) (2) (3) 1 2) 3))

    ((let ((x #Z(1 2 3)))
       (list (collect x)
	     (collect (producing (a) ((xx x) (yy #Z(0 0 0 0 1)) (flag nil) xval yval)
			(loop (tagbody
				(setq yval (next-in yy (terminate-producing)))
				(if (plusp yval) (terminate-producing))
				(if flag (go j))
				(setq xval (next-in xx (go f)))
				(if (minusp xval) (terminate-producing))
				(go j)
			      f (setq flag T)
			      j (next-out a xval)))))))
     ((1 2 3) (1 2 3 3)))
    ((let ((x #Z(1 2 3)))
       (list (collect x)
	     (collect (producing (a) ((xx x) (yy #Z(0 0 1)) (flag nil) xval yval)
			(loop (tagbody
				(setq yval (next-in yy (terminate-producing)))
				(if (plusp yval) (terminate-producing))
				(if flag (go j))
				(setq xval (next-in xx (go f)))
				(if (minusp xval) (terminate-producing))
				(go j)
			      f (setq flag T)
			      j (next-out a xval)))))))
     ((1 2 3) (1 2)))
    ((let ((x #Z(1 2 -3)))
       (list (collect x)
	     (collect (producing (a) ((xx x) (yy #Z(0 0 0 0 1)) (flag nil) xval yval)
			(loop (tagbody
				(setq yval (next-in yy (terminate-producing)))
				(if (plusp yval) (terminate-producing))
				(if flag (go j))
				(setq xval (next-in xx (go f)))
				(if (minusp xval) (terminate-producing))
				(go j)
			      f (setq flag T)
			      j (next-out a xval)))))))
     ((1 2 -3) (1 2)))

    ((let ((x #Z(a b c)) (y #Z(0)))
       (list (collect x) (collect y) (collect (catenate x y #Z(1 2)))))
     ((a b c) (0) (a b c 0 1 2)))
    (test-def ((defun comp5 (numbers)
		   (declare (optimizable-series-function) (off-line-port numbers))
		 (let ((x #Z(a b c)))
		   (list (collect x) (collect (catenate x numbers)))))
	       (comp5 #Z(1 2)))
	      ((a b c) (a b c 1 2)))
    ((let ((x #Z(a b c)))
       (list (collect (catenate x #Z(-1 -2))) (collect (catenate x #Z(1 2)))))
     ((a b c -1 -2) (a b c 1 2)))
    (test-def ((defun comp6 (numbers)
		   (declare (optimizable-series-function))
		 (let ((numbers (split-if numbers #'plusp)))
		   (list (collect numbers) (collect (subseries numbers 1)))))
	       (comp6 #Z(1 -1 2)))
	      ((1 2) (2)))
    (test-def ((defun comp7 (x)
		   (declare (optimizable-series-function))
		 (let ((numbers (split-if #Z(1 -1 2) #'plusp)))
		   (collect (#Mlist numbers x))))
	       (comp7 #Z(a b c)))
	      ((1 a) (2 b)))

    ((let ((x #Z(1 2 3)) (y #Z(2)))
       (list (collect-sum x) (collect-sum (#M* x (catenate y #Z(1))))))
     (6 4))

    ((collect (mapping ((x #Z(1 2)))
		(do* ((i 1 (1+ i))
		      (r 0 (+ x r)))
		    ((> i x) r))))
     (1 4))

    ((collect (mapping ((x #Z(1 2)))
		((lambda (i) (list i)) (1+ x))))
     ((2) (3)))

    ((let (a b)
       (collect (mapping ((x #Z(1 2 3)))
		  (multiple-value-setq (a b) (floor x 2))
		  (list a b))))
     ((0 1) (1 0) (1 1)))
    ((let (a b)
       (let ((x #Z(1 2 3)))
	 (multiple-value-setq (a b) (floor 1 1))
	 (list a b (collect x))))
     (1 0 (1 2 3)))

    ((let ((x #Z(1 2 3)))
       (multiple-value-bind (x y)
	   (collect-fn '(values t t)
		       #'(lambda () (values 1 2))
		       #'(lambda (x y z) (values (+ x z) (+ y z)))
		       x)
	 (list (list x) (list y))))
     ((7) (8)))

    (test-def ((defun zz () 2)
	       (zz))
	      2)
    (test-def ((defun zz1 (x) (declare (ignore x)) "foo")
	       (zz1 1))
	      "foo")

;here more special tests

;The following test error checking.
;Some must be tested only when optimized, because they
;cause ordinary errors when non-optmized

    (test-ers (generator 3) 60)

    (test-ers (gatherer #'(lambda (x) (values (collect x) (collect x)))) 61)
    (test-ers (gatherer #'(lambda (x y) (collect (#M+ x y)))) 61)
    (test-ers (gatherer #'(lambda (x) (scan x))) 61)
    (test-ers (gatherer #'scan) 61)
    (test-ers (gatherer #'positions) 61)
    (test-ers (test-rrs (gatherer #'scan)) 61)

    (test-ers (map-fn '(values) #'1+ #Z(1 2 3)) 62)

    (test-ers (chunk -1 #Z(1 2 3)) 63)

    (test-ers (chunk 1 -1 #Z(1 2 3)) 64)

    (test-ers (alter (scan-range :upto 4) (series 5)) 65)
    (test-ers (alter (#Mcar (scan '((1)))) (series 5)) 65)
    (test-ers (alter (positions (scan '(1))) (series 5)) 65)

    (test-ers-opt (let ((t #Z(1))) a) 66)
    (test-ers-opt (multiple-value-bind ((a)) #Z(1) a) 66)
    (test-ers-opt (multiple-value-bind (t b) #Z(1) a) 66)
    (test-ers-opt (let ((2 #Z(1))) nil) 66)
    (test-ers-opt (let ((a #Z(1) nil)) nil) 66)

    (test-ers-opt (funcall #'(lambda (a b) (car a)) #Z(1)) 67)
    (test-ers-opt (funcall #'(lambda (a) (car a)) #Z(1) #Z(2)) 67)

    (test-ers (encapsulated foo (collect-fn t #'f #'cons #Z(1 2 3))) 68)

    (test-ers (encapsulated #'foo (collecting-fn t #'f #'cons #Z(1 2 3))) 69)

    (test-ers (map-fn #'car #Z(1 2 3)) 70)

    (test-ers-opt (defun ff (&foo b)
		    (declare (optimizable-series-function))
		    (car a)) 71)
    (test-ers (defun ff (a &rest b)
		(declare (optimizable-series-function))
		(list a b)) 71)
    (test-ers (defun ff (a &allow-other-keys b)
		(declare (optimizable-series-function))
		(list a b)) 71)

    (test-ers-opt (defun ff ((a) b)
		    (declare (optimizable-series-function))
		    (car a)) 72)
    (test-ers-opt (defun ff (t b)
		    (declare (optimizable-series-function))
		    (car a)) 72)
    (test-ers-opt (defun ff (nil b)
		    (declare (optimizable-series-function))
		    (car a)) 72)

    (test-ers (producing (x) (y z) (print y)) 73)

    (test-ers (producing () (y z) (loop (tagbody (print y)))) 74)

    (test-ers (producing (x) ((y #Z(1 2)) z) (loop (tagbody (setq z (next-in))))) 75)

    (test-ers (producing (x) ((y #Z(1 2)) z) (loop (tagbody (next-out z)))) 76)

    (test-ers (collect (scan-range :upto 5 :below 6)) 77)

    (test-ers (scan-multiple '(values list) '(1 2) '(3 4)) 78)

    (test-ers (collect (latch #Z(1 2) :after 2 :before 3)) 79)

;These test warnings

    (test-wrs (let ((x (scan '(1 2 3))))
		(declare (integer x))
		(collect x))
	      ((1 2 3) 30))
    (test-wrs (let ((x (scan '(1 2 3))) (y 3))
		(declare (series y))
		(collect (#M+ (series y) x)))
	      ((4 5 6) 31))
    (test-wrs (defun ugh1 (a b)
		(declare (optimizable-series-function))
		(collect (#Mcons a (choose-if #'plusp b))))
	      (ugh1 40))
    (test-wrs (defun ugh2 (a b) "doc"
		(declare (optimizable-series-function) (off-line-port b) (integer a))
		(collect (#Mcons a b)))
	      (ugh2 41))
    (test-wrs (defun ugh3 (a b)
		(declare (optimizable-series-function))
		(choose a b))
	      (ugh3 42))
    (test-wrs (defun ugh4 (a b)
		(declare (optimizable-series-function) (off-line-port 0))
		(collect (#Mcons a b)))
	      (ugh4 43))
    (test-wrs (defun ugh44 (a)
		(declare (optimizable-series-function))
		(collect-sum (scan a)))
	      (ugh44 44))
;here temporarily not working, due to bug in code.
    (identity)
;    (test-wrs (let ((e #Z(1 2 3))) (collect #Z(1 2)))
;	      ((1 2) 52))
    (test-wrs (let ((e #Z(1 2 3))) (declare (ignore e)) (collect e))
	      ((1 2 3) 53))

;things that are half way from warnings to resriction violations.

    (test-wrs (collect (phys-scan-list '(1 2 3)))
	      ((1 2 3) 28))
    (test-wrs (let ((f #'(lambda (x) (collect-sum x))))
		(let ((g (gatherer f)))
		  (next-out g 3)
		  (next-out g 4)
		  (result-of g))) (7 28))

    (test-wrs (block bar
		(iterate ((x (series -1 2 3)))
		  (if (plusp x) (return-from bar x)))) (2 29))
    (test-wrs (compiler-let ((*suppress-series-warnings* T))
		 (block bar
		    (iterate ((x (series -1 2 3)))
		      (if (plusp x) (return-from bar x)))))
	      (2 nil))

;These test restriction violation checks

    (test-rrs (let ((*print-length* 2) (x #Z(1 2 3 4 5)))
		(declare (special *print-length*))
                (collect x))
	      ((1 2 3 4 5) 1))
    (test-rrs (let ((*print-length* 2) (x #Z(1 2 3 4 5)))
		(declare (off-line-port 2))
                (collect x))
	      ((1 2 3 4 5) 1))
    (identity)
    (test-rrs (progn (eval '(defun zzt (x) "doc"
			      (declare (optimizable-series-function 2) (special x))
			      (values (null x) (collect x))))
		     (multiple-value-list (zzt #Z(1 2 3))))
	      ((nil (1 2 3)) 1))
    (test-rrs (progn (eval '(defun zzt (x) "doc"
			      (declare (optimizable-series-function 2)
				       (propagate-alterability x y))
			      (values (null x) (collect x))))
		     (multiple-value-list (zzt #Z(1 2 3))))
	      ((nil (1 2 3)) 1))
    (test-rrs (let ((x #Z(1 2 3)))
		(declare (optimizable-series-function))
		(collect x))
	      ((1 2 3) 1))

    (test-rrs (let ((x '(values t t)))
		(multiple-value-bind (a b)
		    (map-fn x #'(lambda (z) (values (- z) z)) #Z(1 2 3))
		  (list (collect a) (collect b))))
	      (((-1 -2 -3) (1 2 3)) 2))

    (test-rrs (let ((x 2))
		(multiple-value-bind (a b)
		    (chunk x 2 #Z(a b c d e f))
		  (list (collect a) (collect b))))
	      (((a c e) (b d f)) 3))

    (test-rrs (let ((x 2))
		(multiple-value-bind (a b)
		    (chunk 2 x #Z(a b c d e f))
		  (list (collect a) (collect b))))
	      (((a c e) (b d f)) 4))

    (test-rrs (let ((l (list 1 2 3)))
		(alter (phys-scan-list l) #Z(a b))
		l)
	      ((a b 3) 5))

    (test-rrs (let ((x #Z(1)))
		(flet ((a (b) (car b)))
		  (a (collect x)))) (1 6))

    (test-rrs (multiple-value-bind (x y) (values #Z(1 2 3) #Z(4 5))
		(list (collect x) (collect y)))
	      (((1 2 3) (4 5)) 7))

    (test-rrs (not (let ((x #Z(1 2)))
		     (#M1+ x))) (nil 10))

    (test-rrs (let ((x (scan '(1 2))))
		(setq xx x)
		(collect-sum x)) (3 11))

    (test-rrs
     (let* ((a 3) (z (scan '(1 2))) (b (collect z)))
       (list (collect (#M(lambda (y) (setq z (#M1+ z)) (1+ y)) z))
	     a (collect z) b)) (((2 3) 3 (3 4) (1 2)) 12))

    (test-rrs (let ((x #Z(1 2 3)))
		(if (null x) 10 20)) (20 13))

    (test-rrs (progn (eval '(defun zzt (x)
			      (declare (optimizable-series-function 2))
			      (values (null x) (collect x))))
		     (multiple-value-list (zzt #Z(1 2 3))))
	      ((nil (1 2 3)) 14))

    (test-rrs
     (let* ((a nil) (z (scan '(1 2))) (b (collect z)))
       (when (not a) (setq a #Z(9 8)))
       (list (collect a) (collect z) b)) (((9 8) (1 2) (1 2)) 20))
    (test-rrs (let ((x #Z(1 2)))
		(list (if T 3 (scan-range :upto 3))
		      (collect x))) ((3 (1 2)) 20))
    (test-rrs (let ((x #Z(1 2)))
		(if T (collect-sum #Z(2 3)) x)) (5 20))

    (test-rrs (let* ((e #Z(1 2))
		       (w (collect e)))
		  (collect (#M(lambda (x) (cons x w)) e))) (((1 1 2) (2 1 2)) 21))
    (test-rrs (let* ((e #Z((1) (2)))
		       (w (collect e)))
		  (collect (#M(lambda (x) (cons (car x) w)) e)))
	      (((1 (1) (2)) (2 (1) (2))) 21))
    (test-rrs (let* ((e #Z(1 2))
		       (w (collect e))
		       (x (collect-sum e)))
		 (list (collect (#M(lambda (z) (list z x)) e))
		       (collect (#M(lambda (z) (list* z w)) e))))
	       ((((1 3) (2 3)) ((1 1 2) (2 1 2))) 21))

    (test-rrs (let* ((e #Z(1 -2 3))
		       (w (split-if e #'plusp)))
		 (collect (#Mlist e w))) (((1 1) (-2 3)) 22))
    (test-rrs (let* ((e #Z(1 -2 3))
		       (w (split-if e #'plusp)))
		 (collect (#Mlist e e w))) (((1 1 1) (-2 -2 3)) 22))
    (test-rrs (let* ((e #Z(1 -2 -4 3)))
		(multiple-value-bind (w x) (split-if e #'plusp)
		  (collect (#Mlist w x)))) (((1 -2) (3 -4)) 22))

    (test-rrs (let* ((e #Z(1 -2 -4 3))
		       (w (choose-if #'plusp e)))
		 (collect (#Mlist e w))) (((1 1) (-2 3)) 23))
    (test-rrs (let* ((e #Z(1 -2 -4 3))
		       (w (choose-if #'plusp e)))
		 (collect (#Mlist e e w))) (((1 1 1) (-2 -2 3)) 23))
    (test-rrs (let* ((e #Z(1 2)))
		  (collect (catenate e e))) ((1 2 1 2) 23))
    (test-rrs (let* ((e #Z(1 2)))
		  (collect (#Mlist e (catenate e e)))) (((1 1) (2 2)) 23))
    (test-rrs (let* ((e #Z(1 -2 -3 4)))
		  (collect (#Mlist e (catenate (choose-if #'plusp e)
					       (choose-if #'minusp e)))))
	       (((1 1) (-2 4) (-3 -2) (4 -3)) 23))
    (test-rrs (let* ((e #Z(1 -2 -3 4)))
		(multiple-value-bind (w x) (split-if e #'plusp)
		  (collect (#Mlist e (catenate w x)))))
	      (((1 1) (-2 4) (-3 -2) (4 -3)) 23))

; tests due to bugs found and extensions made after 1/1/90

    ((let ((x 3))
       (list (collect-last
	       (mapping ((i (scan-range :upto x)))
		 (setq x 4)
		 i))
	     x))
     (3 4))

    ((let ((oddp #Z(1 2 3)))
       (collect (choose-if #'oddp oddp)))
     (1 3))
    ((collect (choose-if #'(lambda (x) (let ((y (1+ x))) (evenp y))) #Z(1 2 3)))
     (1 3))
    ((collect (scan-lists-of-lists-fringe '(1 (1 2) (2 3))
					  #'(lambda (x) (let ((y (car x))) (evenp y)))))
     (1 1 2 (2 3)))
    ((collect (scan-range :upto ((lambda (x) (let ((y (1+ x))) (* 2 y))) 1)))
     (0 1 2 3 4))

    ((let ((x #Z(1 2 3)))
       (list (collect-sum x) (collect-sum (catenate x #Z(4 5))))) (6 15))
    ((let ((x (scan-range)))
       (list (collect-sum (subseries x 0 3)) (collect-sum (subseries x 0 5)))) (3 10))
    ((multiple-value-bind (x+ x-) (split-if #Z(1 -2 3 -4 5 -6) #'plusp)
       (list (collect-sum (subseries x+ 0 2)) (collect-sum x-))) (4 -12))
    ((multiple-value-bind (x+ x-) (split-if #Z(1 -2 3 -4 5 -6) #'plusp)
       (list (collect-sum x-) (collect-sum (subseries x+ 0 2)))) (-12 4))
    ((multiple-value-bind (x+ x-) (split-if #Z(1 -2 3 -4 5 -6) #'plusp)
       (list (collect-sum x+) (collect-first x-))) (9 -2))

    (test-rrs (let ((x #Z(1 2 3))
                    (g (generator (scan '(1 2 3)))))
                (list (collect-sum x) (next-in g)))
              ((6 1) 24))

    (test-def ((defun zzz1 (x)
		 (declare (optimizable-series-function))
		 (scan-fn t #'(lambda () 10)
			  #'(lambda (z) (funcall #'(lambda (z) (- z x)) z))
			  #'zerop))
	       (collect (zzz1 2)))
	      (10 8 6 4 2))

    (testm (collect (car (scan '((1)(2)(3))))) (1 2 3))
    (testm (let ((*x* 0))
             (collect (progn (list #Z(1 2 3) (incx))))) ((1 0) (2 0) (3 0)))
    (testm (let ((*x* 0))
             (collect (list #Z(1 2 3) (catenate #Z(a) (incx)))))
           ((1 a) (2 0) (3 0)))
    (testm (let ((e #Z(1 2 3 4)))
             (collect (choose (evenp e) e))) (2 4))
    (testm (let ((x #Z(1 nil (a) 3 4)))
	     (collect (and (numberp x) (oddp x))))
	   (t nil nil t nil))
    (testm (let ((*x* 1))
	     (let* ((x #Z(1 nil (a) 3 4)) (z (list x)))
	       (when (null x) (incx))
	       (collect (if (numberp x) *x* z))))
	   (1 (nil) ((a)) 2 2))
    (testm (let ((*x* 0))
             (let* ((x (car (scan '((1) (2) (3)))))
                    (y (1+ x))
                    (z (collect-sum (* x y))))
               (incx (list x y 4))
               (incx z)
               (list (collect (list x (catenate #Z(a) (incx 'b)))) *x*)))
              (((1 a) (2 b) (3 b)) 5))

    ((let* ((x 3) (e (make-series x))) (collect e)) (3))

;Here, temporarily not working because SETQ processing
;assumes the straight-line restriction is satisfied.
;    (testm (let* ((x #Z(1 nil (a) 3 4)) (y (+ 0 1)) (z (list x)))
;	     (when (null x) (setq y (1+ y)))
;	     (collect (if (numberp x) y z)))
;	   (1 (nil) ((a)) 2 2))

;Here, note this is an example where the optimization is not correctness
;preservering due to side-effects.  Also note that more work happens than
;you might think in the optimized expression in any case.
;Here if not testm, you get an odd message about non-series to series dflow
;before you get the not-straight line error message.
;    (testm (let ((*x* 0))
;             (let ((e #Z(1 2 3 4)))
;	        (list (if (numberp *x*) (collect-sum e) (collect-sum (#Mincx e)))
;	              *x*))) (10 4))
;Here also note this even more extreme case.  It would work right if the
;whole inner-let were nested in where it could be.
;    (testm (let ((*x* 0))
;             (let ((e #Z(1 2 3 4)))
;	        (list (if (numberp *x*) 0 (collect-sum (#Mincx e)))
;	              *x*))) (0 4))

    ((let ((a #'car)) (funcall (or a a) '(1 2))) 1)

;here temporarily not working
;    ((let ((e #Z(a b)))
;       (list (collect (compiler-let ((*c1* 3) *c2*)
;                        (#Mc1-c2-macro e)))
;             (collect (compiler-let ((*c2* 4))
;                        (#Mc1-c2-macro e)))))
;     (((3 nil a) (3 nil b)) ((1 4 a) (1 4 b))))

    ((let ((mask (mapping ((a (scan '(a b c))))
		   a)))
       (collect mask)) (a b c))
    ((let ((end 3)
	   (data #Z(1 2 3 4)))
       (collect (until-if #'(lambda (obj) (eql obj end)) data)))
     (1 2))
    ((let ((end 3)
	   (data #Z(1 2 3 4)))
       (collect (choose-if #'(lambda (obj) (eql obj end)) data)))
     (3))
    ((let ((end 3)
	   (data #Z(1 2 3 4)))
       (collect (split-if data #'(lambda (obj) (eql obj end)))))
     (3))

; Additional tests that only work on symbolics.

 #+symbolics
    (test-def ((defun foo3 (number)
		 (declare (integer number))
		 (1+ number))
	       (collect (scan-range :below (foo3 4))))
	      (0 1 2 3 4))
 #+symbolics
    ((collect (mapping ((x #Z(1 2)))
		(do ((i 1 (1+ i))
		     a (b) (c 0)
		     (r 0 (+ x r)))
		    ((> i x) r)
		  (setq b i a i)
		  (if (> (+ a b c) 100) (return nil)))))
     (1 4))
;here temporarily not working, due to bug in the code.
; #+symbolics
;    (test-wrs (defun ugh5 (a)
;		(declare (optimizable-series-function))
;		(scan '(1 2 3)))
;	      (ugh5 50))
 #+symbolics
    (test-wrs (defun ugh6 (a)
		(declare (optimizable-series-function) (ignore a))
		(scan a))
	      (ugh6 51))


    ) test-failed nil)

;------------------------------------------------------------------------

;Copyright 1982,1983,1984,1985,1986,1987,1988,1989, and 1990
;by the Massachusetts Institute of Technology, Cambridge, Massachusetts.

;Permission to use, copy, modify, and distribute this software and its
;documentation for any purpose and without fee is hereby granted,
;provided that this copyright and permission notice appear in all
;copies and supporting documentation, and that the name of M.I.T. not
;be used in advertising or publicity pertaining to distribution of the
;software without specific, written prior permission. M.I.T. makes no
;representations about the suitability of this software for any
;purpose.  It is provided "as is" without express or implied warranty.

;    M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
;    ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
;    M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
;    ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
;    WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
;    ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
;    SOFTWARE.

;------------------------------------------------------------------------
