# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1529279440 25200
# Node ID a0c69729ade3e0f6ce9faed36f11e1d093e3ba8f
# Parent  0dd5e94be86ba08aabd1d5d8d2f0a80fa9e80aa4
Add a few more control-flow tests

diff -r 0dd5e94be86b -r a0c69729ade3 src/control-flow.lisp
--- a/src/control-flow.lisp	Sun Jun 17 16:28:57 2018 -0700
+++ b/src/control-flow.lisp	Sun Jun 17 16:50:40 2018 -0700
@@ -473,10 +473,14 @@
     ; 2 11
 
   "
-  (if (null ranges)
-    `(progn ,@body)
-    (destructuring-bind (var from below) (first ranges)
-      `(loop :for ,var :from ,from :below ,below
-             :do (do-range ,(rest ranges) ,@body)))))
+  (assert (not (null ranges)) ()
+    "Ranges to iterate in DO-RANGE must not be null.")
+  (recursively ((ranges ranges))
+    (if (null ranges)
+      `(progn ,@body)
+      (destructuring-bind (var from below) (first ranges)
+        `(loop
+           :for ,var :from ,from :below ,below
+           :do ,(recur (rest ranges)))))))
 
 
diff -r 0dd5e94be86b -r a0c69729ade3 test/control-flow.lisp
--- a/test/control-flow.lisp	Sun Jun 17 16:28:57 2018 -0700
+++ b/test/control-flow.lisp	Sun Jun 17 16:50:40 2018 -0700
@@ -2,169 +2,247 @@
 
 
 (define-test when-let
-  (locally
-    #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
-    (is (eql :foo (when-let ()
-                    :foo)))
-    (is (eql 1 (when-let ((a 1))
-                 a)))
-    (is (eql 3 (when-let ((a 1)
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+  (is (eql :foo (when-let ()
+                  :foo)))
+  (is (eql 1 (when-let ((a 1))
+               a)))
+  (is (eql 3 (when-let ((a 1)
+                        (b 2))
+               (+ a b))))
+  (is (eql nil (when-let ((a nil)
                           (b 2))
                  (+ a b))))
-    (is (eql nil (when-let ((a nil)
-                            (b 2))
-                   (+ a b))))
-    (is (eql nil (when-let ((a 1)
-                            (b nil))
-                   (+ a b))))
-    (is (eql nil (when-let ((a 1)
-                            (b nil)
-                            (c 3))
-                   (+ a b c))))
-    (let (x)
-      (is (eql nil (when-let ((a (progn (push 1 x) 1))
-                              (b (progn (push 2 x) nil))
-                              (c (progn (push 3 x) 3)))
-                     (declare (type fixnum a b c))
-                     (push :body x)
-                     (+ a b c))))
-      (is (equal '(2 1) x)))
-    (let (x)
-      (is (eql 6 (when-let ((a (progn (push 1 x) 1))
-                            (b (progn (push 2 x) 2))
+  (is (eql nil (when-let ((a 1)
+                          (b nil))
+                 (+ a b))))
+  (is (eql nil (when-let ((a 1)
+                          (b nil)
+                          (c 3))
+                 (+ a b c))))
+  (let (x)
+    (is (eql nil (when-let ((a (progn (push 1 x) 1))
+                            (b (progn (push 2 x) nil))
                             (c (progn (push 3 x) 3)))
                    (declare (type fixnum a b c))
                    (push :body x)
                    (+ a b c))))
-      (is (equal '(:body 3 2 1) x)))))
+    (is (equal '(2 1) x)))
+  (let (x)
+    (is (eql 6 (when-let ((a (progn (push 1 x) 1))
+                          (b (progn (push 2 x) 2))
+                          (c (progn (push 3 x) 3)))
+                 (declare (type fixnum a b c))
+                 (push :body x)
+                 (+ a b c))))
+    (is (equal '(:body 3 2 1) x))))
 
 (define-test when-let*
-  (locally
-    #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
-    (is (eql :foo (when-let* ()
-                    :foo)))
-    (is (eql 1 (when-let* ((a 1))
-                 a)))
-    (is (eql 2 (when-let* ((a 1)
-                           (b (1+ a)))
-                 b)))
-    (is (eql nil (when-let* ((a nil)
-                             (b 2))
-                   (+ a b))))
-    (is (eql nil (when-let* ((a 1)
-                             (b nil))
-                   (+ a b))))
-    (is (eql nil (when-let* ((a 1)
-                             (b nil)
-                             (c (+ 2 a)))
-                   (+ a b c))))
-    (let (x)
-      (is (eql nil (when-let* ((a (progn (push 1 x) 1))
-                               (b (progn (push 2 x) nil))
-                               (c (progn (push 3 x) 3)))
-                     (push :body x)
-                     (+ a b c))))
-      (is (equal '(2 1) x)))
-    (let (x)
-      (is (eql 6 (when-let* ((a (progn (push 1 x) 1))
-                             (b (progn (push 2 x) 2))
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+  (is (eql :foo (when-let* ()
+                  :foo)))
+  (is (eql 1 (when-let* ((a 1))
+               a)))
+  (is (eql 2 (when-let* ((a 1)
+                         (b (1+ a)))
+               b)))
+  (is (eql nil (when-let* ((a nil)
+                           (b 2))
+                 (+ a b))))
+  (is (eql nil (when-let* ((a 1)
+                           (b nil))
+                 (+ a b))))
+  (is (eql nil (when-let* ((a 1)
+                           (b nil)
+                           (c (+ 2 a)))
+                 (+ a b c))))
+  (let (x)
+    (is (eql nil (when-let* ((a (progn (push 1 x) 1))
+                             (b (progn (push 2 x) nil))
                              (c (progn (push 3 x) 3)))
                    (push :body x)
                    (+ a b c))))
-      (is (equal '(:body 3 2 1) x)))))
+    (is (equal '(2 1) x)))
+  (let (x)
+    (is (eql 6 (when-let* ((a (progn (push 1 x) 1))
+                           (b (progn (push 2 x) 2))
+                           (c (progn (push 3 x) 3)))
+                 (push :body x)
+                 (+ a b c))))
+    (is (equal '(:body 3 2 1) x))))
 
 
 (define-test if-let
-  (locally
-    #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
-    (is (eql :foo (if-let ()
-                    :foo
-                    :bar)))
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+  (is (eql :foo (if-let ()
+                  :foo
+                  :bar)))
 
-    (is (eql 1 (if-let ((a 1))
-                 a
-                 :bar)))
-    (is (eql :bar (if-let ((a nil))
-                    a
-                    :bar)))
-    (is (eql 3 (if-let ((a 1)
-                        (b 2))
-                 (+ a b)
-                 :bar)))
-    (is (eql :bar (if-let ((a nil)
-                           (b 2))
-                    (+ a b)
-                    :bar)))
-    (is (eql :bar (if-let ((a 1)
-                           (b nil))
-                    (+ a b)
-                    :bar)))
-    (is (eql :bar (if-let ((a 1)
-                           (b nil)
-                           (c 3))
+  (is (eql 1 (if-let ((a 1))
+               a
+               :bar)))
+  (is (eql :bar (if-let ((a nil))
+                  a
+                  :bar)))
+  (is (eql 3 (if-let ((a 1)
+                      (b 2))
+               (+ a b)
+               :bar)))
+  (is (eql :bar (if-let ((a nil)
+                         (b 2))
+                  (+ a b)
+                  :bar)))
+  (is (eql :bar (if-let ((a 1)
+                         (b nil))
+                  (+ a b)
+                  :bar)))
+  (is (eql :bar (if-let ((a 1)
+                         (b nil)
+                         (c 3))
+                  (+ a b c)
+                  :bar)))
+  (let (x)
+    (is (eql :bar (if-let ((a (progn (push 1 x) 1))
+                           (b (progn (push 2 x) nil))
+                           (c (progn (push 3 x) 3)))
+                    (declare (type fixnum a b c))
                     (+ a b c)
                     :bar)))
-    (let (x)
-      (is (eql :bar (if-let ((a (progn (push 1 x) 1))
-                             (b (progn (push 2 x) nil))
-                             (c (progn (push 3 x) 3)))
-                      (declare (type fixnum a b c))
-                      (+ a b c)
-                      :bar)))
-      (is (equal '(2 1) x)))
-    (let (x)
-      (is (eql 6 (if-let ((a (progn (push 1 x) 1))
-                          (b (progn (push 2 x) 2))
-                          (c (progn (push 3 x) 3)))
-                   (declare (type fixnum a b c))
-                   (+ a b c)
-                   :bar)))
-      (is (equal '(3 2 1) x)))))
+    (is (equal '(2 1) x)))
+  (let (x)
+    (is (eql 6 (if-let ((a (progn (push 1 x) 1))
+                        (b (progn (push 2 x) 2))
+                        (c (progn (push 3 x) 3)))
+                 (declare (type fixnum a b c))
+                 (+ a b c)
+                 :bar)))
+    (is (equal '(3 2 1) x))))
 
 (define-test if-let*
-  (locally
-    #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
-    (is (eql :foo (if-let* ()
-                    :foo
-                    :bar)))
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+  (is (eql :foo (if-let* ()
+                  :foo
+                  :bar)))
 
-    (is (eql 1 (if-let* ((a 1))
-                 a
-                 :bar)))
-    (is (eql :bar (if-let* ((a nil))
-                    a
-                    :bar)))
-    (is (eql 3 (if-let* ((a 1)
-                         (b (1+ a)))
-                 (+ a b)
-                 :bar)))
-    (is (eql :bar (if-let* ((a nil)
-                            (b 2))
-                    (+ a b)
-                    :bar)))
-    (is (eql :bar (if-let* ((a 1)
-                            (b nil))
-                    (+ a b)
-                    :bar)))
-    (is (eql :bar (if-let* ((a 1)
-                            (b nil)
-                            (c 3))
+  (is (eql 1 (if-let* ((a 1))
+               a
+               :bar)))
+  (is (eql :bar (if-let* ((a nil))
+                  a
+                  :bar)))
+  (is (eql 3 (if-let* ((a 1)
+                       (b (1+ a)))
+               (+ a b)
+               :bar)))
+  (is (eql :bar (if-let* ((a nil)
+                          (b 2))
+                  (+ a b)
+                  :bar)))
+  (is (eql :bar (if-let* ((a 1)
+                          (b nil))
+                  (+ a b)
+                  :bar)))
+  (is (eql :bar (if-let* ((a 1)
+                          (b nil)
+                          (c 3))
+                  (+ a b c)
+                  :bar)))
+  (let (x)
+    (is (eql :bar (if-let* ((a (progn (push 1 x) 1))
+                            (b (progn (push 2 x) nil))
+                            (c (progn (push 3 x) 3)))
+                    (declare (type fixnum a b c))
                     (+ a b c)
                     :bar)))
-    (let (x)
-      (is (eql :bar (if-let* ((a (progn (push 1 x) 1))
-                              (b (progn (push 2 x) nil))
-                              (c (progn (push 3 x) 3)))
-                      (declare (type fixnum a b c))
-                      (+ a b c)
-                      :bar)))
-      (is (equal '(2 1) x)))
-    (let (x)
-      (is (eql 6 (if-let* ((a (progn (push 1 x) 1))
-                           (b (progn (push 2 x) 2))
-                           (c (progn (push 3 x) 3)))
-                   (declare (type fixnum a b c))
-                   (+ a b c)
-                   :bar)))
-      (is (equal '(3 2 1) x)))))
+    (is (equal '(2 1) x)))
+  (let (x)
+    (is (eql 6 (if-let* ((a (progn (push 1 x) 1))
+                         (b (progn (push 2 x) 2))
+                         (c (progn (push 3 x) 3)))
+                 (declare (type fixnum a b c))
+                 (+ a b c)
+                 :bar)))
+    (is (equal '(3 2 1) x))))
+
+
+(define-test do-range
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+  (is (equal '(1 2 3)
+             (gathering
+               (do-range ((x 1 4))
+                 (gather x)))))
+  (is (equal '()
+             (gathering
+               (do-range ((x 1 1))
+                 (gather x)))))
+  (is (equal '((1 . 1) (1 . 2) (1 . 3)
+               (2 . 1) (2 . 2) (2 . 3))
+             (gathering
+               (do-range ((x 1 3)
+                          (y 1 4))
+                 (gather (cons x y)))))))
+
+(define-test do-repeat
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+  (is (equal '(1 1 1)
+             (gathering
+               (do-repeat 3
+                 (gather 1)))))
+  (is (equal '()
+             (gathering
+               (do-repeat 0
+                 (gather 1))))))
+
 
+(define-test gathering
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+  (is (equal '(1 2 3)
+             (gathering
+               (gather 1)
+               (gather 2)
+               (gather 3))))
+  (is (equal '()
+             (gathering
+               1))))
+
+(define-test gathering-vector
+  #+sbcl (declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
+  (is (equalp #(1 2 3)
+              (gathering-vector ()
+                (gather 1)
+                (gather 2)
+                (gather 3))))
+  (is (equalp #()
+              (gathering-vector ()
+                1))))
+
+
+(define-test when-found
+  (let ((h (make-hash-table)))
+    (setf (gethash 'foo h) 1)
+    (is (equal 2 (when-found (x (gethash 'foo h))
+                   (1+ x))))
+    (is (equal nil (when-found (x (gethash 'bar h))
+                     (1+ x))))))
+
+(define-test if-found
+  (let ((h (make-hash-table)))
+    (setf (gethash 'foo h) 1)
+    (is (equal 2 (if-found (x (gethash 'foo h))
+                   (1+ x)
+                   :no)))
+    (is (equal :no (if-found (x (gethash 'bar h))
+                     (1+ x)
+                     :no)))))
+
+
+(define-test nest
+  (is (equal '(1 2 1 2)
+             (nest
+               (let ((a 1)
+                     (b 2)))
+               (let ((c a)
+                     (d b)))
+               (list a b c d)))))
+
+