From 3e845a601c4bc001236d9a7b7e00e96602cb704e Mon Sep 17 00:00:00 2001
From: "Michael D. Lowis" <mike@mdlowis.com>
Date: Wed, 29 Jan 2014 12:38:52 -0500
Subject: [PATCH] checkpoint commit before merging prototype code from dropbox

---
 SConstruct                     | 41 +++++++++++++++++++++----------
 source/slpkg/server.scm        |  7 +++---
 tests/compiler/main.scm        |  7 ------
 tests/compiler/test-reader.scm |  5 ----
 tests/compiler/test.scm        | 44 ----------------------------------
 tests/runtime/main.cpp         |  8 -------
 6 files changed, 32 insertions(+), 80 deletions(-)
 delete mode 100644 tests/compiler/main.scm
 delete mode 100644 tests/compiler/test-reader.scm
 delete mode 100644 tests/compiler/test.scm
 delete mode 100644 tests/runtime/main.cpp

diff --git a/SConstruct b/SConstruct
index 514ac03..0a3245b 100644
--- a/SConstruct
+++ b/SConstruct
@@ -13,6 +13,23 @@ def find_files(path,pattern):
             matches.append(os.path.join(root, filename))
     return matches
 
+# Helper function to build scheme programs and test runners
+def SchemeBuildAndTest(target,sources,tests):
+    # Figure out the target names
+    test_runner  = target + '_tests'
+    test_output  = target + '_results'
+    test_sources = [e for e in sources if not e.endswith('main.scm')] + tests
+    # Create the targets
+    scheme.Program( target, sources )
+    scheme.Program( test_runner, test_sources )
+    RunTest( test_output, test_runner )
+
+# Helper function to run a test suite and generate a log file
+def RunTest( output, runner ):
+    runner_exe = runner + ('.exe' if (platform.system() == 'Windows') else '')
+    cmd = os.path.basename(runner_exe)
+    scheme.Command( output, runner_exe, cmd + ' > $TARGET')
+
 #------------------------------------------------------------------------------
 # Compiler Environments
 #------------------------------------------------------------------------------
@@ -41,22 +58,14 @@ scheme_linker = Builder(
         src_suffix  = '.o',
         src_builder = [ scheme_compiler ])
 
-# Scheme Test Linker
-scheme_tester = Builder(
-        action      = 'csc $LDFLAGS -o $TARGET $SOURCES && $TARGET',
-        suffix      = "$PROGSUFFIX",
-        src_suffix  = '.o',
-        src_builder = [ scheme_compiler ])
-
 # Create the Environment for this project
 scheme = Environment(
         ENV      = os.environ,
         CCFLAGS  = [ '-explicit-use', '-I', 'inc'],
         LDFLAGS  = [],
         TOOLS    = [ 'mingw' ],
-        BUILDERS = {
-            'Program':    scheme_linker,
-            'TestRunner': scheme_tester })
+        BUILDERS = { 'Program': scheme_linker })
+scheme.PrependENVPath('PATH', './build')
 
 #------------------------------------------------------------------------------
 # SCLPL Targets
@@ -77,13 +86,19 @@ readsof.Program('build/readsof', find_files('source/readsof/','*.c'))
 readsof.Depends('readsof', 'sof')
 
 # SCLPL Compiler
-scheme.Program('build/slc', find_files('source/compiler/','*.scm'))
+SchemeBuildAndTest( 'build/slc',
+                    find_files('source/compiler/','*.scm'),
+                    find_files('tests/compiler/','*.scm') )
 
 # SCLPL Package Manager
-scheme.Program('build/slpkg', find_files('source/slpkg/','*.scm'))
+SchemeBuildAndTest( 'build/slpkg',
+                    find_files('source/slpkg/','*.scm'),
+                    find_files('tests/slpkg/','*.scm') )
 
 # SCLPL Assembler
-scheme.Program('build/slas', find_files('source/slas/','*.scm'))
+SchemeBuildAndTest( 'build/slas',
+                    find_files('source/slas/','*.scm'),
+                    find_files('tests/slas/','*.scm') )
 
 # SCLPL Virtual Machine
 c_cpp.Program('build/slvm', find_files('source/slvm/','*.c'))
diff --git a/source/slpkg/server.scm b/source/slpkg/server.scm
index 23dd7fa..983f9da 100644
--- a/source/slpkg/server.scm
+++ b/source/slpkg/server.scm
@@ -1,4 +1,5 @@
-(declare (unit server) );(uses spiffy intarweb posix))
+(declare (unit server) (uses eval));(uses spiffy intarweb posix))
+(require-extension spiffy)
 
 (define index-template
 "<!DOCTYPE html PUBLIC
@@ -36,8 +37,8 @@
   (html-response (sprintf index-template path (generate-index path))))
 
 (define (start-pkg-server port root)
-  (server-port 8080)
-  (root-path "./")
+  (server-port port)
+  (root-path root)
   (handle-directory index-handler)
   (start-server))
 
diff --git a/tests/compiler/main.scm b/tests/compiler/main.scm
deleted file mode 100644
index 147b6ac..0000000
--- a/tests/compiler/main.scm
+++ /dev/null
@@ -1,7 +0,0 @@
-(declare
-  (uses library)
-  (uses test-reader)
-  (uses test))
-
-(run-all-unit-tests)
-
diff --git a/tests/compiler/test-reader.scm b/tests/compiler/test-reader.scm
deleted file mode 100644
index 61af094..0000000
--- a/tests/compiler/test-reader.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(declare (unit test-reader) (uses test reader))
-(include "test-macros.scm")
-
-(def-test "Fail"
-  #f)
diff --git a/tests/compiler/test.scm b/tests/compiler/test.scm
deleted file mode 100644
index 63de6bd..0000000
--- a/tests/compiler/test.scm
+++ /dev/null
@@ -1,44 +0,0 @@
-(declare (unit test))
-
-(define unit-tests '())
-
-(define (register-test! test)
-  (set! unit-tests (cons test unit-tests)))
-
-(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)
-  (run-tests 0 0 (reverse unit-tests)))
-
-(define (run-tests pass fail tests)
-  (if (null? tests)
-      (print-summary pass fail)
-      (if (run-test (car tests))
-          (run-tests (+ 1 pass) fail (cdr tests))
-          (run-tests pass (+ 1 fail) (cdr tests)))))
-
-(define (run-test test)
-  (if (null? test)
-      (error "Invalid test definition")
-      (case (run-test-fn (cdr test))
-        ('pass      #t)
-        ('fail      (print "FAIL: "      (car test)) #f)
-        ('error     (print "ERROR: "     (car test)) #f)
-        ('exception (print "EXCEPTION: " (car test)) #f)
-        (else       (print "UNKNOWN: "   (car test)) #f))))
-
-(define (run-test-fn fn)
-  (define preverr error)
-  (define result
-    (call/cc
-      (lambda (cont)
-        (set! error (lambda (x) (cont 'error)))
-        (with-exception-handler
-          (lambda (x) (cont 'exception))
-          (lambda ()  (cont (if (fn) 'pass 'fail)))))))
-  (set! error preverr)
-  result)
-
diff --git a/tests/runtime/main.cpp b/tests/runtime/main.cpp
deleted file mode 100644
index b73af6f..0000000
--- a/tests/runtime/main.cpp
+++ /dev/null
@@ -1,8 +0,0 @@
-#include "UnitTest++.h"
-#include "TestReporterStdout.h"
-
-
-int main(int, char const *[])
-{
-    return UnitTest::RunAllTests();
-}
-- 
2.55.0