test/control-flow.lisp @ 566c907b762a

Add a couple of unit tests

More to come later (hopefully).
author Steve Losh <steve@stevelosh.com>
date Sun, 17 Jun 2018 14:44:31 -0700
parents (none)
children a0c69729ade3
(in-package :losh.test)


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

    (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*
  (locally
    #+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)))))