# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1529271871 25200
# Node ID 566c907b762ae55079b7c504382b87cecfcf2618
# Parent  75ad31007bf3d8d6beb0d6e1a756b8cb8619f979
Add a couple of unit tests

More to come later (hopefully).

diff -r 75ad31007bf3 -r 566c907b762a Makefile
--- a/Makefile	Sun Jun 03 12:49:43 2018 -0400
+++ b/Makefile	Sun Jun 17 14:44:31 2018 -0700
@@ -1,13 +1,35 @@
-.PHONY: docs
-
+.PHONY: docs test test-sbcl test-ccl test-ecl test-abcl
+heading_printer = $(shell which heading || echo 'true')
 sourcefiles = $(shell ffind --full-path --literal .lisp)
 
+# Vendor ----------------------------------------------------------------------
 vendor: vendor/quickutils.lisp
 vendor/quickutils.lisp: vendor/make-quickutils.lisp
 	cd vendor && ros run -L sbcl --load make-quickutils.lisp  --eval '(quit)'
 
+
+# Documentation ---------------------------------------------------------------
 DOCUMENTATION.markdown: $(sourcefiles)
 	sbcl --noinform --load make-docs.lisp  --eval '(quit)'
 
 docs: DOCUMENTATION.markdown
 
+
+# Testing ---------------------------------------------------------------------
+test: test-sbcl test-ccl test-ecl test-abcl
+
+test-sbcl:
+	$(heading_printer) computer 'SBCL'
+	sbcl --load test/run.lisp
+
+test-ccl:
+	$(heading_printer) slant 'CCL'
+	ccl --load test/run.lisp
+
+test-ecl:
+	$(heading_printer) roman 'ECL'
+	ecl --load test/run.lisp
+
+test-abcl:
+	$(heading_printer) broadway 'ABCL'
+	abcl --load test/run.lisp
diff -r 75ad31007bf3 -r 566c907b762a losh.asd
--- a/losh.asd	Sun Jun 03 12:49:43 2018 -0400
+++ b/losh.asd	Sun Jun 17 14:44:31 2018 -0700
@@ -7,6 +7,8 @@
   :license "MIT"
   :version "0.0.1"
 
+  :in-order-to ((asdf:test-op (asdf:test-op :losh/test)))
+
   :depends-on (:iterate
                #+sbcl :sb-sprof
                )
@@ -18,3 +20,21 @@
     :components ((:file "quickutils")))
    (:file "package")
    (:file "losh")))
+
+(asdf:defsystem :losh/test
+  :description "Test suite for losh."
+
+  :author "Steve Losh <steve@stevelosh.com>"
+  :license "MIT"
+
+  :depends-on (:losh :1am)
+
+  :serial t
+  :components ((:module "test"
+                :serial t
+                :components ((:file "package")
+                             (:file "base")
+                             (:file "control-flow"))))
+
+  :perform (asdf:test-op (op system)
+             (funcall (read-from-string "losh.test:run-tests"))))
diff -r 75ad31007bf3 -r 566c907b762a test/base.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/base.lisp	Sun Jun 17 14:44:31 2018 -0700
@@ -0,0 +1,11 @@
+(in-package :losh.test)
+
+
+(defmacro define-test (name &body body)
+  `(test ,(intern (concatenate 'string (symbol-name 'test-) (symbol-name name)))
+    (let ((*package* ,*package*))
+      ,@body)))
+
+(defun run-tests ()
+  (1am:run))
+
diff -r 75ad31007bf3 -r 566c907b762a test/control-flow.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/control-flow.lisp	Sun Jun 17 14:44:31 2018 -0700
@@ -0,0 +1,170 @@
+(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)))))
+
diff -r 75ad31007bf3 -r 566c907b762a test/package.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/package.lisp	Sun Jun 17 14:44:31 2018 -0700
@@ -0,0 +1,4 @@
+(defpackage :losh.test
+  (:use :cl :1am :losh)
+  (:shadowing-import-from :1am :test)
+  (:export :run-tests))
diff -r 75ad31007bf3 -r 566c907b762a test/run.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/test/run.lisp	Sun Jun 17 14:44:31 2018 -0700
@@ -0,0 +1,5 @@
+#+ecl (setf compiler:*user-cc-flags* "-Wno-shift-negative-value")
+
+(ql:quickload :losh)
+(time (asdf:test-system :losh))
+(quit)