From 640c963660ddf3173adda85708889903bfc81e3a Mon Sep 17 00:00:00 2001
From: "Michael D. Lowis" <mike@mdlowis.com>
Date: Wed, 4 Jul 2012 23:25:59 -0400
Subject: [PATCH] Added unit testing capability and first unit test file

---
 .gitignore         |  2 +-
 Makefile           |  6 +++-
 inc/loop.scm       | 27 ++++++++++++++++
 inc/test.scm       |  8 +++++
 source/buf.scm     | 79 ++++++++++++++++++++--------------------------
 tests/main.scm     |  5 +--
 tests/test.scm     | 28 ++++++++++++++++
 tests/test_buf.scm | 65 ++++++++++++++++++++++++++++++++++++++
 tests/test_foo.scm |  8 -----
 9 files changed, 172 insertions(+), 56 deletions(-)
 create mode 100644 inc/loop.scm
 create mode 100644 inc/test.scm
 create mode 100644 tests/test.scm
 create mode 100644 tests/test_buf.scm
 delete mode 100644 tests/test_foo.scm

diff --git a/.gitignore b/.gitignore
index 2065fc6..1225200 100644
--- a/.gitignore
+++ b/.gitignore
@@ -7,4 +7,4 @@ cscope.out
 *.lib
 *~
 *.d
-
+test_runner*
diff --git a/Makefile b/Makefile
index c5ad55a..bbc8363 100644
--- a/Makefile
+++ b/Makefile
@@ -35,6 +35,10 @@ TEST_FILES = $(call flist, $(TEST_ROOT), $(TEST_EXT))
 SRC_OBJS = $(SRC_FILES:%.$(SRC_EXT)=%.o)
 TEST_OBJS = $(TEST_FILES:%.$(TEST_EXT)=%.o)
 
+# Include Directories
+SRC_INCS  =
+TEST_INCS = -I inc
+
 # Compiler and Linker Options
 #----------------------------
 CSC = csc
@@ -70,7 +74,7 @@ $(SRC_OBJS): %.o : %.$(SRC_EXT)
 
 $(TEST_OBJS): %.o : %.$(TEST_EXT)
 	@echo $<
-	@$(CSC) $(CSCFLAGS) -o $@ $<
+	@$(CSC) $(CSCFLAGS) $(TEST_INCS) -o $@ $<
 
 # Cleanup
 clean:
diff --git a/inc/loop.scm b/inc/loop.scm
new file mode 100644
index 0000000..717c48a
--- /dev/null
+++ b/inc/loop.scm
@@ -0,0 +1,27 @@
+(declare (unit loops))
+
+; For loop macro
+(define-syntax for
+  (syntax-rules ()
+    ((_ var lst body ...)
+      (let loop ((var (car lst)))
+        body ...
+        (if (< var (cadr lst))
+          (loop (+ var (caddr lst))))))))
+
+; While loop macro
+(define-syntax while
+  (syntax-rules ()
+    ((_ cnd body ...)
+      (let loop ()
+        body ...
+        (if cnd (loop))))))
+
+; Until loop macro
+(define-syntax until
+  (syntax-rules ()
+    ((_ cnd body ...)
+      (let loop ()
+        body ...
+        (if (not cnd) (loop))))))
+
diff --git a/inc/test.scm b/inc/test.scm
new file mode 100644
index 0000000..48bb5be
--- /dev/null
+++ b/inc/test.scm
@@ -0,0 +1,8 @@
+
+(define-syntax def-test
+  (syntax-rules ()
+    ((_ desc body ...)
+      (register-test!
+        (cons desc
+          (lambda () body ...))))))
+
diff --git a/source/buf.scm b/source/buf.scm
index cb21634..69394d2 100644
--- a/source/buf.scm
+++ b/source/buf.scm
@@ -23,56 +23,47 @@
        (vector?   (buf-data obj))))
 
 (define (buf-marked? b)
-  (if (buf? b)
-    (> (length (buf-marks b)) 0)))
+  (> (length (buf-marks b)) 0))
 
-(define (buf-mark b)
-  (if (buf? b)
-    (buf-marks-set! b (cons (buf-pos b) (buf-marks b)))))
+(define (buf-mark! b)
+  (buf-marks-set! b (cons (buf-pos b) (buf-marks b))))
 
-(define (buf-release b)
-  (if (buf? b)
-    (buf-marks-set! b (cdr (buf-marks b)))))
+(define (buf-release! b)
+  (buf-marks-set! b (cdr (buf-marks b))))
 
-(define (buf-advance b)
-  (if (buf? b)
-    (buf-pos-set! b (+ 1 (buf-pos b)))))
+(define (buf-advance! b)
+  (buf-pos-set! b (+ 1 (buf-pos b))))
 
-(define (buf-sync b n)
-  (if (buf? b)
-    (let* ((pos     (buf-pos b))
-           (size    (length (buf-data)))
-           (nxt_idx (- (+ pos n) 1))
-           (max_idx (- size 1)))
-      (if (= size 0)
-        (buf-fill b n)
-        (if (>= nxt_idx max_idx)
-          (buf-fill b (- nxt_idx max_idx)))))))
+(define (buf-sync! b n)
+  (let* ((pos     (buf-pos b))
+         (size    (length (buf-data)))
+         (nxt_idx (- (+ pos n) 1))
+         (max_idx (- size 1)))
+    (if (= size 0)
+      (buf-fill! b n)
+      (if (>= nxt_idx max_idx)
+        (buf-fill! b (- nxt_idx max_idx))))))
 
-(define (buf-fill b n)
-  (if (buf? b)
-    (let loop ((i 0))
-      (buf-data-set!
-        (vector-append (buf-data b) ((buf-ldfn b))))
-      (if (< i n) (loop (+ i 1))))))
+(define (buf-fill! b n)
+  (let loop ((i 0))
+    (buf-data-set!
+      (vector-append (buf-data b) ((buf-ldfn b))))
+    (if (< i n) (loop (+ i 1)))))
 
-(define (buf-lookahead b n)
-  (if (buf? b)
-    (buf-sync b n)
-    (vector-ref
-      (buf-data b)
-      (- (+ (buf-pos b) n) 1))))
+(define (buf-lookahead! b n)
+  (buf-sync b n)
+  (vector-ref
+    (buf-data b)
+    (- (+ (buf-pos b) n) 1)))
 
-(define (buf-consume b n)
-  (if (buf? b)
+(define (buf-consume! b n)
+  (buf-advance! b)
+  (if
+    (and
+      (= (buf-pos b) (length (buf-data b)))
+      (not (buf-marked? b)))
     (begin
-      (buf-advance b)
-      (if
-        (and
-          (= location size)
-          (not (buf-marked? b)))
-        (begin
-          (buf-pos-set! 0)
-          (buf-data-set! (vector))))
-      (buf-sync b1))))
+      (buf-pos-set! 0)
+      (buf-data-set! (vector))))
+  (buf-sync! b1))
 
diff --git a/tests/main.scm b/tests/main.scm
index 47a4910..a309997 100644
--- a/tests/main.scm
+++ b/tests/main.scm
@@ -1,6 +1,7 @@
 (declare
   (uses library)
-  (uses test_foo))
+  (uses test_buf)
+  (uses test))
 
-;(run-unit-tests)
+(run-all-unit-tests)
 
diff --git a/tests/test.scm b/tests/test.scm
new file mode 100644
index 0000000..ef7103d
--- /dev/null
+++ b/tests/test.scm
@@ -0,0 +1,28 @@
+(declare (unit test)
+         (compile-syntax))
+
+(define unit-tests '())
+
+(define (register-test! test)
+  (set! unit-tests (append unit-tests (list test))))
+
+(define (print-summary pass fail)
+  (if (zero? fail)
+    (print "Success: " pass " tests passed.")
+    (print "Failure: " fail " / " (+ pass fail) " tests failed.")))
+
+(define (run-all-unit-tests)
+  (let loop ((pass  0)
+             (fail  0)
+             (tests unit-tests))
+    (if (not (null? tests))
+      (let* ((test (car tests))
+             (desc (car test))
+             (fn   (cdr test)))
+        (if (not (fn))
+          (begin
+            (print "FAIL: " desc)
+            (loop pass (+ fail 1) (cdr tests)))
+          (loop (+ pass 1) fail (cdr tests))))
+      (print-summary pass fail))))
+
diff --git a/tests/test_buf.scm b/tests/test_buf.scm
new file mode 100644
index 0000000..6dcd5f4
--- /dev/null
+++ b/tests/test_buf.scm
@@ -0,0 +1,65 @@
+(include "test.scm")
+(declare (unit test_buf)
+         (uses test))
+
+; buf
+;------------------------------------------------------------------------------
+(def-test "buf should create a new general purpose buffer" '())
+
+; buf-struct?
+;------------------------------------------------------------------------------
+(def-test "buf-struct? should return true if passed a buffer struct" '())
+(def-test "buf-struct? should return fals if not a buffer struct" '())
+
+; buf?
+;------------------------------------------------------------------------------
+(def-test "buf? should return true if passed a buffer struct with the right elements" '())
+(def-test "buf? should return false if no load function" '())
+(def-test "buf? should return false if pos is not an integer" '())
+(def-test "buf? should return false if marks is not a list" '())
+(def-test "buf? should return false if data is not a vector" '())
+
+; buf-marked?
+;------------------------------------------------------------------------------
+(def-test "buf-marked? should return true if the buffer is marked" '())
+(def-test "buf-marked? should return false if the buffer is NOT marked" '())
+
+; buf-mark!
+;------------------------------------------------------------------------------
+(def-test "buf-mark! should store the current pos in the marks list when the marks list is empty" '())
+(def-test "buf-mark! should prepend the current pos to the marks list" '())
+
+; buf-release!
+;------------------------------------------------------------------------------
+(def-test "buf-release! should remove the current mark from the marks list when only one mark exists" '())
+(def-test "buf-release! should remove the current mark from the marks list when multiple marks exist" '())
+
+; buf-advance!
+;------------------------------------------------------------------------------
+(def-test "buf-advance! should advance pos by 1" '())
+
+; buf-sync!
+;------------------------------------------------------------------------------
+(def-test "buf-sync! should fill the buffer with the specified number of bytes when the buffer is empty" '())
+(def-test "buf-sync! should fill the buffer up to n when the buffer contains less data than required" '())
+(def-test "buf-sync! should do nothing if already synced" '())
+
+; buf-fill!
+;------------------------------------------------------------------------------
+(def-test "buf-fill! should load 0 bytes from the source" '())
+(def-test "buf-fill! should load 1 bytes from the source" '())
+(def-test "buf-fill! should load 2 bytes from the source" '())
+(def-test "buf-fill! should load 3 bytes from the source" '())
+
+; buf-lookahead!
+;------------------------------------------------------------------------------
+(def-test "buf-lookahead! should return the first item of lookahead" '())
+(def-test "buf-lookahead! should return the second item of lookahead" '())
+(def-test "buf-lookahead! should return the third item of lookahead" '())
+
+; buf-consume!
+;------------------------------------------------------------------------------
+(def-test "buf-consume! should clear the buffer if not marked and pos is equal to the buffer size" '())
+(def-test "buf-consume! should NOT clear the buffer if pos not equal to the buffer size" '())
+(def-test "buf-consume! should NOT clear the buffer if the buffer is marked" '())
+
diff --git a/tests/test_foo.scm b/tests/test_foo.scm
deleted file mode 100644
index 3f0f32e..0000000
--- a/tests/test_foo.scm
+++ /dev/null
@@ -1,8 +0,0 @@
-(declare (unit test_foo))
-
-;(test-suite "Foo unit tests"
-;  (test "Foo does cool stuff"
-;    (check-equal 42 (foo 1 2)) ))
-
-(print "Hello, world!")
-
-- 
2.52.0