summary refs log tree commit diff
path: root/implementation/srfi-64-minimal.scm
diff options
context:
space:
mode:
Diffstat (limited to 'implementation/srfi-64-minimal.scm')
-rw-r--r--implementation/srfi-64-minimal.scm50
1 files changed, 50 insertions, 0 deletions
diff --git a/implementation/srfi-64-minimal.scm b/implementation/srfi-64-minimal.scm
new file mode 100644
index 0000000..e60632b
--- /dev/null
+++ b/implementation/srfi-64-minimal.scm
@@ -0,0 +1,50 @@
+; Just enough of SRFI 64 (unit tests) to run test.scm.
+
+(define *test-failures* '())
+
+(define (test-begin name)
+  (newline)
+  (display "Test group: ")
+  (display name)
+  (newline)
+  (newline))
+
+(define (test-end name)
+  (newline)
+  (cond
+    ((null? *test-failures*)
+      (display "All tests passed!")
+      (newline)
+      (newline)
+      (exit 0))
+    (else
+      (write (length *test-failures*))
+      (display " TEST(S) FAILED:")
+      (newline)
+      (for-each (lambda (x) (x)) (reverse *test-failures*))
+      (newline)
+      (exit 1))))
+
+(define (%test-equal name expected actual)
+  (cond
+    ((equal? expected actual)
+      (display "pass: "))
+    (else
+      (set! *test-failures*
+            (cons
+              (lambda ()
+                (display name)
+                (display ": Expected ")
+                (write expected)
+                (display ", got ")
+                (write actual)
+                (newline))
+              *test-failures*))
+      (display "FAIL: ")))
+  (display name)
+  (newline))
+
+(define-syntax test-equal
+  (syntax-rules ()
+    ((_ name expected actual)
+       (%test-equal name expected (guard (e (#t e)) actual)))))