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 |
75ad31007bf3
|
| children |
de9d10a9b4b5
|
| branches/tags |
(none) |
| files |
Makefile losh.asd test/base.lisp test/control-flow.lisp test/package.lisp test/run.lisp |
Changes
--- 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
--- 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"))))
--- /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))
+
--- /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)))))
+
--- /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))
--- /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)