Updated test framework

diff --git a/SConstruct b/SConstruct
index f11523ee940b6c0102bd85c6e5da5df247a19934..e45edaf98802bd49506849fc44efcdbbc41f533a 100644 (file)
--- a/SConstruct
+++ b/SConstruct
@@ -16,52 +16,53 @@ def find_files(path,pattern):
 
 # Scheme Source Compiler
 scheme_compiler = Builder(
-    action        = 'csc $CCFLAGS -c -o $TARGET $SOURCE',
-    suffix        = '.o',
-    src_suffix    = '.scm',
-    single_source = True
-)
+        action        = 'csc $CCFLAGS -c -o $TARGET $SOURCE',
+        suffix        = '.o',
+        src_suffix    = '.scm',
+        single_source = True
+        )
 
 # Scheme Binary Linker
 scheme_linker = Builder(
-    action      = 'csc $LDFLAGS -o $TARGET $SOURCES',
-    suffix      = "$PROGSUFFIX",
-    src_suffix  = '.o',
-    src_builder = [ scheme_compiler ]
-)
+        action      = 'csc $LDFLAGS -o $TARGET $SOURCES',
+        suffix      = "$PROGSUFFIX",
+        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 ]
-)
+        action      = 'csc $LDFLAGS -o $TARGET $SOURCES && $TARGET',
+        suffix      = "$PROGSUFFIX",
+        src_suffix  = '.o',
+        src_builder = [ scheme_compiler ]
+        )
 
 # Create the Environment for this project
 env = Environment(
         ENV      = os.environ,
-        CCFLAGS  = [ '-explicit-use' ],
+        CCFLAGS  = [ '-explicit-use', '-I', 'inc'],
         LDFLAGS  = [],
-        BUILDERS = { 'SchemeProgram': scheme_linker,
-                     'SchemeTestRunner': scheme_tester }
-)
+        BUILDERS = {
+            'SchemeProgram': scheme_linker,
+            'SchemeTestRunner': scheme_tester }
+        )
 
 #------------------------------------------------------------------------------
 # SCLPL Targets
 #------------------------------------------------------------------------------
 
 # SCLPL Compiler
+src_files = find_files('source/compiler/','*.scm')
 env.SchemeProgram(
-    target = 'sclpl-cc',
-    source = find_files('source/compiler/','*.scm')
-)
+        target = 'sclpl-cc',
+        source = src_files
+        )
 
-env.Command('tests.log', find_files('tests/compiler/','*.scm'), "csi -q $SOURCES >> $TARGET")
-
-#env.SchemeTestRunner(
-#    target = 'sclpl-cc-tests',
-#    source = find_files('source/compiler/','*.scm') +
-#             find_files('tests/compiler/','*.scm')
-#)
+# Test Suite
+env.SchemeTestRunner(
+        target = 'sclpl-cc-tests',
+        source = [s for s in src_files if not s.endswith("main.scm")] +
+        find_files('tests/compiler/','*.scm')
+        )
 

diff --git a/inc/test-macros.scm b/inc/test-macros.scm
new file mode 100644 (file)
index 0000000..9bd340d
--- /dev/null
+++ b/inc/test-macros.scm
@@ -0,0 +1,52 @@
+
+(define-syntax def-test
+  (syntax-rules ()
+    ((_ desc body ...)
+      (register-test!
+        (cons desc
+          (lambda () body ...))))))
+
+(define-syntax check-error
+  (syntax-rules ()
+    ((_ expect expr)
+      (let ((prev error))
+        (define result
+          (call/cc
+            (lambda (err)
+              (set! error err)
+              expr)))
+        (set! error prev)
+        (equal? expect result)))))
+
+(define-syntax check-exception
+  (syntax-rules ()
+    ((_ expect expr)
+      (equal? expect
+        (call/cc
+          (lambda (cont)
+            (with-exception-handler
+              (lambda (x) (cont x))
+              (lambda ()  expr))))))))
+
+(define-syntax check-parse-error
+  (syntax-rules ()
+    ((_ expect expr)
+      (begin
+        (define etyp-matches? #f)
+        (define emsg
+          (with-output-to-string
+            (lambda ()
+              (set! etyp-matches?
+                (equal? 'parse-error
+                  (call/cc
+                    (lambda (cont)
+                      (with-exception-handler
+                        (lambda (x) (cont x))
+                        (lambda ()  expr)))))))))
+        ;(print "----")
+        ;(print etyp-matches? " " (equal? emsg expect))
+        ;(print "\"" emsg "\"\n")
+        ;(print "\"" expect "\"\n")
+        ;(print "----")
+        (and etyp-matches? (equal? emsg expect))))))
+

diff --git a/premake4.lua b/premake4.lua
deleted file mode 100644 (file)
index f58a2e2..0000000
--- a/premake4.lua
+++ /dev/null
@@ -1,131 +0,0 @@
--------------------------------------------------------------------------------
--- SCLPL Distribution Build Configuration
--------------------------------------------------------------------------------
-solution "SCLPL Distribution"
-configurations { "Release" }
-targetdir "build"
-
--------------------------------------------------------------------------------
--- SCLPL Runtime
--------------------------------------------------------------------------------
-project "sclpl-rt"
-    kind "SharedLib"
-    language "C"
-    location "build"
-    files {
-        "source/runtime/**.*"
-    }
-
-project "sclpl-rt-tests"
-    kind "ConsoleApp"
-    language "C++"
-    location "build"
-    links {
-        "UnitTest++",
-        "sclpl-rt"
-    }
-    includedirs {
-        "source/runtime/**",
-        "tools/UnitTest++/**"
-    }
-    files {
-        "tests/runtime/*.c*"
-    }
-    postbuildcommands {
-        "./sclpl-rt-tests"
-    }
-
--------------------------------------------------------------------------------
--- SCLPL Lexer
--------------------------------------------------------------------------------
-project "sclpl-lex"
-    kind "ConsoleApp"
-    language "C"
-    location "build"
-    includedirs {
-        "source/lexer/**",
-        "source/runtime/**",
-        "source/common/**",
-    }
-    files {
-        "source/lexer/**.*",
-        "source/common/**.*",
-    }
-
-project "sclpl-lex-tests"
-    kind "ConsoleApp"
-    language "C++"
-    location "build"
-    links {
-        "UnitTest++"
-    }
-    includedirs {
-        "source/lexer/**",
-        "tools/UnitTest++/**"
-    }
-    files {
-        "tests/lexer/*.c*"
-    }
-    postbuildcommands {
-        "./sclpl-lex-tests"
-    }
-
--------------------------------------------------------------------------------
--- SCLPL Parser
--------------------------------------------------------------------------------
-project "sclpl-parse"
-    kind "ConsoleApp"
-    language "C"
-    location "build"
-    includedirs {
-        "source/lexer/**",
-        "source/runtime/**",
-        "source/common/**",
-    }
-    files {
-        "source/parser/**.*",
-        "source/common/**.*",
-        "source/runtime/collector/**.*"
-    }
-
-project "sclpl-parse-tests"
-    kind "ConsoleApp"
-    language "C++"
-    location "build"
-    links {
-        "UnitTest++"
-    }
-    includedirs {
-        "source/parser/**",
-        "tools/UnitTest++/**"
-    }
-    files {
-        "tests/parser/*.c*"
-    }
-    postbuildcommands {
-        "./sclpl-parse-tests"
-    }
-
--------------------------------------------------------------------------------
--- UnitTest++ - A C/C++ unit testing library
--------------------------------------------------------------------------------
-project "UnitTest++"
-    kind "SharedLib"
-    language "C++"
-    location "build"
-    files {
-        "tools/UnitTest++/src/*.*",
-    }
-    if os.is "windows" then
-        files { "tools/UnitTest++/src/Win32/**.*" }
-    else
-        files { "tools/UnitTest++/src/Posix/**.*" }
-    end
-
--------------------------------------------------------------------------------
--- Miscellaneous
--------------------------------------------------------------------------------
-if _ACTION == "clean" then
-    os.rmdir("build")
-end
-

diff --git a/tests/compiler/main.scm b/tests/compiler/main.scm
new file mode 100644 (file)
index 0000000..147b6ac
--- /dev/null
+++ b/tests/compiler/main.scm
@@ -0,0 +1,7 @@
+(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
new file mode 100644 (file)
index 0000000..61af094
--- /dev/null
+++ b/tests/compiler/test-reader.scm
@@ -0,0 +1,5 @@
+(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
new file mode 100644 (file)
index 0000000..63de6bd
--- /dev/null
+++ b/tests/compiler/test.scm
@@ -0,0 +1,44 @@
+(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/lexer/main.cpp b/tests/lexer/main.cpp
deleted file mode 100644 (file)
index b73af6f..0000000
--- a/tests/lexer/main.cpp
+++ /dev/null
@@ -1,8 +0,0 @@
-#include "UnitTest++.h"
-#include "TestReporterStdout.h"
-
-
-int main(int, char const *[])
-{
-    return UnitTest::RunAllTests();
-}

diff --git a/tests/parser/main.cpp b/tests/parser/main.cpp
deleted file mode 100644 (file)
index b73af6f..0000000
--- a/tests/parser/main.cpp
+++ /dev/null
@@ -1,8 +0,0 @@
-#include "UnitTest++.h"
-#include "TestReporterStdout.h"
-
-
-int main(int, char const *[])
-{
-    return UnitTest::RunAllTests();
-}