add testing files

2 files changed, 181 insertions, 0 deletions

diff --git a/test-vartika-plus.lisp b/test-vartika-plus.lisp
new file mode 100644
index 0000000..1f45933
--- /dev/null
+++ b/test-vartika-plus.lisp
@@ -0,0 +1,150 @@
+(load "test.lisp")
+(load "plus-inc.lisp")
+
+;;; basic functions
+
+(deftest test-explode ()
+  (check
+    (equal (explode 1) '(|1|))
+    (equal (explode 22211) '(|2| |2| |2| |1| |1|))))
+
+(deftest test-explode-string ()
+  (check
+    (equal (explode-string "1") '(|1|))
+    (equal (explode-string "22211") '(|2| |2| |2| |1| |1|))))
+
+(deftest test-implode ()
+  (check
+    (eq (implode '(|1|)) '|1|)
+    (eq (implode '(|2| |1| |3|)) '|213|)))
+
+(deftest test-symbol-to-number ()
+  (check
+    (eql (symbol-to-number '|1|) 1)
+    (eql (symbol-to-number '|231|) 231)))
+
+(deftest test-base-number ()
+  (check
+    (base-number '(|1|) '|1|)
+    (base-number '(|1| |1| |1|) '|1|)
+    (base-number nil '|1|)
+    (null (base-number '(|2|) '|1|))
+    (null (base-number '(|1| |2| |1|) '|1|))
+    (null (base-number '(|1| |2| |3|) '|1|))
+    (null (base-number '(|2| |3| |4|) '|1|))))
+
+(deftest test-may-reverse-units-first ()
+  (setf *number-units-at-beginning* t)
+  (check
+    (equal (may-reverse '(|1|)) '(|1|))
+    (equal (may-reverse '(|1| |1| |1|)) '(|1| |1| |1|))
+    (equal (may-reverse '(|1| |2| |3|)) '(|1| |2| |3|))))
+
+(deftest test-may-reverse-units-last ()
+  (setf *number-units-at-beginning* nil)
+  (check
+    (equal (may-reverse '(|1|)) '(|1|))
+    (equal (may-reverse '(|1| |1| |1|)) '(|1| |1| |1|))
+    (equal (may-reverse '(|1| |2| |3|)) '(|3| |2| |1|))))
+
+
+(deftest test-basic ()
+  (combine-results
+    (test-explode)
+    (test-explode-string)
+    (test-implode)
+    (test-symbol-to-number)
+    (test-base-number)
+    (test-may-reverse-units-first)
+    (test-may-reverse-units-last)))
+
+
+;;; one
+;;; earthal, infinite
+
+(deftest test-earth-next-digit ()
+  (let ((numerals '(|1| |2| |3| |4| |5|)))
+    (check
+      (eq (next-digit numerals '|1|) '|2|)
+      (eq (next-digit numerals '|3|) '|4|)
+      (eq (next-digit numerals '|5|) nil))))
+
+(deftest test-earth-previous-digit ()
+  (let ((numerals '(|1| |2| |3| |4| |5|)))
+    (check
+      (eq (previous-digit numerals '|1|) nil)
+      (eq (previous-digit numerals '|3|) '|2|)
+      (eq (previous-digit numerals '|5|) '|4|))))
+
+(deftest test-earth-infinite-next-list-number ()
+  (setf *number-units-at-beginning* t)
+  (let ((numerals '(|1| |2| |3| |4| |5|)))
+    (check
+      (equal (next-list-number numerals nil) '(|1|))
+      (equal (next-list-number numerals '(|1|)) '(|2|))
+      (equal (next-list-number numerals '(|1| |3|)) '(|2| |3|))
+      (equal (next-list-number numerals '(|5|)) '(|1| |2|))
+      (equal (next-list-number numerals '(|1| |1|)) '(|2| |1|))
+      (equal (next-list-number numerals '(|1| |3| |1| |1|)) '(|2| |3| |1| |1|))
+      (equal (next-list-number numerals '(|5| |5|)) '(|1| |1| |2|))
+      (equal (next-list-number numerals '(|1| |5| |5|)) '(|2| |5| |5|))
+      (equal (next-list-number numerals '(|5| |5| |5|)) '(|1| |1| |1| |2|))
+      (equal (next-list-number numerals '(|5| |5| |1|)) '(|1| |1| |2| |1|))
+      (equal (next-list-number numerals '(|5| |5| |1| |1| |1|)) '(|1| |1| |2| |1| |1| |1|))
+      (equal (next-list-number numerals '(|4| |5| |1| |1| |1|)) '(|5| |5| |1| |1| |1|))
+      (equal (next-list-number numerals '(|4| |5| |1|)) '(|5| |5| |1|))
+      (equal (next-list-number numerals '(|5| |5| |2| |1|)) '(|1| |1| |3| |1|)))))
+
+(deftest test-earth-infinite-previous-list-number ()
+  (setf *number-units-at-beginning* t)
+  (let ((numerals '(|1| |2| |3| |4| |5|)))
+    (check
+      (equal (previous-list-number numerals '(|1|)) nil)
+      (equal (previous-list-number numerals '(|1| |1|)) nil)
+      (equal (previous-list-number numerals '(|1| |1| |1|)) nil)
+      (equal (previous-list-number numerals '(|2|)) '(|1|))
+      (equal (previous-list-number numerals '(|5|)) '(|4|))
+      (equal (previous-list-number numerals '(|2| |3|)) '(|1| |3|))
+      (equal (previous-list-number numerals '(|5| |5|)) '(|4| |5|))
+      (equal (previous-list-number numerals '(|1| |5|)) '(|5| |4|))
+      (equal (previous-list-number numerals '(|1| |2|)) '(|5|))
+      (equal (previous-list-number numerals '(|2| |3| |1|)) '(|1| |3| |1|))
+      (equal (previous-list-number numerals '(|2| |3| |1| |1|)) '(|1| |3| |1| |1|))
+      (equal (previous-list-number numerals '(|1| |1| |2| |3|)) '(|5| |5| |1| |3|))
+      (equal (previous-list-number numerals '(|5| |5| |1| |1| |1|)) '(|4| |5| |1| |1| |1|))
+      (equal (previous-list-number numerals '(|1| |5| |1|)) '(|5| |4| |1|))
+      (equal (previous-list-number numerals '(|1| |5| |1| |1|)) '(|5| |4| |1| |1|))
+      (equal (previous-list-number numerals '(|1| |2| |1|)) '(|5| |1|))
+      (equal (previous-list-number numerals '(|1| |2| |1| |1|)) '(|5| |1| |1|))
+      (equal (previous-list-number numerals '(|2| |2| |1| |1|)) '(|1| |2| |1| |1|)))))
+
+(deftest test-earth-plus-args-list ()
+  (setf *number-units-at-beginning* t)
+  (let ((numerals '(|1| |2| |3| |4| |5|)))
+    (check
+      (equal (plus-args-list numerals '(|1|) '(|1|)) '(|1|))
+      (equal (plus-args-list numerals '(|2|) '(|1|)) '(|2|))
+      (equal (plus-args-list numerals '(|1|) '(|2|)) '(|2|))
+      (equal (plus-args-list numerals '(|2|) '(|2|)) '(|3|))
+      (equal (plus-args-list numerals '(|5|) '(|2|)) '(|1| |2|))
+      (equal (plus-args-list numerals '(|2|) '(|5|)) '(|1| |2|))
+      (equal (plus-args-list numerals '(|1| |3|) '(|1|)) '(|1| |3|))
+      (equal (plus-args-list numerals '(|2| |3|) '(|2|)) '(|3| |3|))
+      (equal (plus-args-list numerals '(|2| |3|) '(|5|)) '(|1| |4|))
+      (equal (plus-args-list numerals '(|2| |2|) '(|2| |2|)) '(|3| |3|))
+      (equal (plus-args-list numerals '(|3| |2|) '(|5| |3|)) '(|2| |5|))
+      (equal (plus-args-list numerals '(|3| |3|) '(|5| |3|)) '(|2| |1| |2|)))))
+
+(deftest test-earth-inf ()
+  (combine-results
+    (test-earth-next-digit)
+    (test-earth-previous-digit)
+    (test-earth-infinite-next-list-number)
+    (test-earth-infinite-previous-list-number)
+    (test-earth-plus-args-list)))
+
+
+
+(deftest test-earth ()
+  (test-basic)
+  (test-earth-inf))
diff --git a/test.lisp b/test.lisp
new file mode 100644
index 0000000..5f65ccc
--- /dev/null
+++ b/test.lisp
@@ -0,0 +1,31 @@
+;(in-package :test)
+
+(defvar *test-name* nil)
+
+(defmacro with-gensyms ((&rest names) &body body)
+  `(let ,(loop for n in names collect `(,n (gensym)))
+     ,@body))
+
+(defmacro deftest (name parameters &body body)
+  "Define a test function. Within a test function we can call other
+test functions or use `check' to run individual test cases."
+  `(defun ,name ,parameters
+     (let ((*test-name* (append *test-name* (list ',name))))
+       ,@body)))
+
+(defmacro check (&body forms)
+  "Run each expression in `forms' as a test case."
+  `(combine-results
+    ,@(loop for f in forms collect `(report-result ,f ',f))))
+
+(defmacro combine-results (&body forms)
+  "Combine the results (as booleans) of evaluating `forms' in order."
+  (with-gensyms (result)
+    `(let ((,result t))
+      ,@(loop for f in forms collect `(unless ,f (setf ,result nil)))
+      ,result)))
+
+(defun report-result (result form)
+  "Report the results of a single test case. Called by `check'."
+  (format t "~:[FAIL~;pass~] ... ~a: ~a~%" result *test-name* form)
+  result)