test/control-flow.lisp @ 1ca3e16900aa

(in-package :losh.test)


(define-test when-let
  #+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 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))
                          (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*
  #+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))
                           (c (progn (push 3 x) 3)))
                 (push :body x)
                 (+ a b c))))
    (is (equal '(:body 3 2 1) x))))


(define-test if-let
  #+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))
                  (+ 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))))

(define-test if-let*
  #+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))
                  (+ 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))))


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