testing macros in r4rsHEADmaster

1 files changed, 53 insertions, 0 deletions

diff --git a/tests/s9fes.scm b/tests/s9fes.scm
new file mode 100644
index 0000000..5b02963
--- /dev/null
+++ b/tests/s9fes.scm
@@ -0,0 +1,53 @@
+;;; Shim for SRFI-64 for unhygenic, single threaded systems.
+
+(define tests-passed 0)
+(define tests-failed 0)
+(define current-test-name '())
+
+(define-syntax test-equal
+  (lambda (name-e expected-e got-e)
+    (let ((name* (gensym 'name))
+          (expected* (gensym 'expected))
+          (got* (gensym 'got))
+          (passed?* (gensym 'passed?)))
+      `(let* ((,name* ,name-e)
+              (,expected* ,expected-e)
+              (,got* ,got-e)
+              (,passed?* (equal? ,expected* ,got*)))
+         (if ,passed?*
+             (begin
+               (set! tests-passed (+ 1 tests-passed))
+               (pretty-print
+                (list 'name (cons ,name* current-test-name)
+                      'passed)))
+             (begin
+               (set! tests-failed (+ 1 tests-failed))
+               (pretty-print
+                (list 'name (cons ,name* current-test-name)
+                      'failed
+                      (list (list 'expected ,expected*)
+                            (list 'got ,got*)))
+                'data)))
+         (newline)))))
+
+(define-syntax test-group
+  (lambda (name-e . body)
+    (let ((old-test-name* (gensym 'old-test-name))
+          (name* (gensym 'name)))
+      `(let ((,old-test-name* current-test-name)
+             (,name* ,name-e))
+         (pretty-print (list 'entering ,name*) 'data)
+         (set! current-test-name (cons ,name* ,old-test-name*))
+         ,@body
+         (set! current-test-name ,old-test-name*)
+         (pretty-print
+          (list 'leaving ,name*
+                (list 'accumulated
+                      (list 'passed tests-passed)
+                      (list 'failed tests-failed)))
+          'data)
+         (newline)))))
+
+(load "../RPS.scm")
+(load "../macros.scm")
+(load "body.scm")