Redo the testing framework.

We can lean more on the power of scheme to make the testing framework a
little less verbose.

1 files changed, 65 insertions, 149 deletions

diff --git a/list-test.csc b/list-test.csc
index e4981e5..d4ea504 100644
--- a/list-test.csc
+++ b/list-test.csc
@@ -1,159 +1,75 @@
 (import (scheme base)
-        (only (csc testing) define-test errorf)
+        (only (csc testing) assert assert-equal test)
         (csc list))
 
 
-(define-test (test-take t)
-  (define-record-type <test-case>
-    (test-case desc n xs want)
-    test-case?
-    (desc desc)
-    (n n)
-    (xs xs)
-    (want want))
-  (let ((tests (list
-                 (test-case
-                   "simple"
-                   3
-                   '(1 2 3 4 5)
-                   '(1 2 3))
-                 (test-case
-                   "negative"
-                   -5
-                   '(1 2 3)
-                   '())
-                 (test-case
-                   "zero"
-                   0
-                   '(1 2 3)
-                   '())
-                 (test-case
-                   "short list"
-                   5
-                   '(1 2 3)
-                   '(1 2 3))
-                 (test-case
-                   "take whole list"
-                   3
-                   '(1 2 3)
-                   '(1 2 3)))))
-    (for-each
-      (lambda (tc)
-        (let ((got (take (n tc) (xs tc))))
-          (unless (equal? got (want tc))
-            (errorf t "(got {} {}) = {}, want {}." (n tc) (xs tc) got (want tc)))))
-      tests)))
+(test take-simple
+  (assert-equal '(1 2 3) (take 3 '(1 2 3 4 5))))
 
 
-(define-test (test-split-at t)
-  (define-record-type <test-case>
-    (test-case desc n xs want-a want-b)
-    test-case?
-    (desc desc)
-    (n n)
-    (xs xs)
-    (want-a want-a)
-    (want-b want-b))
-  (let ((tests (list
-                 (test-case
-                   "simple"
-                   2
-                   '(1 2 3 4)
-                   '(1 2)
-                   '(3 4))
-                 (test-case
-                   "negative"
-                   -5
-                   '(1 2 3)
-                   '()
-                   '(1 2 3))
-                 (test-case
-                   "zero"
-                   0
-                   '(1 2 3)
-                   '()
-                   '(1 2 3))
-                 (test-case
-                   "short list"
-                   5
-                   '(1 2 3)
-                   '(1 2 3)
-                   '())
-                 (test-case
-                   "whole list"
-                   3
-                   '(1 2 3)
-                   '(1 2 3)
-                   '()))))
-    (for-each
-      (lambda (tc)
-        (let-values (((got-a got-b) (split-at (n tc) (xs tc))))
-          (unless (equal? got-a (want-a tc))
-            (errorf t "(split-at {} {}) = (values {}, _), want {}." (n tc) (xs tc) got-a (want-a tc)))
-          (unless (equal? got-b (want-b tc))
-            (errorf t "(split-at {} {}) = (values _, {}), want {}." (n tc) (xs tc) got-b (want-b tc)))))
-      tests)))
+(test take-negative
+  (assert-equal '() (take -5 '(1 2 3))))
 
 
-(define-test (test-revappend t)
-  (define-record-type <test-case>
-    (test-case desc a b want)
-    test-case?
-    (desc desc)
-    (a a)
-    (b b)
-    (want want))
-  (let ((tests (list
-                 (test-case
-                   "threes"
-                   '(3 2 1)
-                   '(4 5 6)
-                   '(1 2 3 4 5 6))
-                 (test-case
-                   "empty first list"
-                   '()
-                   '(1 2 3)
-                   '(1 2 3))
-                 (test-case
-                   "empty second list"
-                   '(3 2 1)
-                   '()
-                   '(1 2 3)))))
-    (for-each
-      (lambda (tc)
-        (let ((got (revappend (a tc) (b tc))))
-          (unless (equal? got (want tc))
-            (errorf t "(revappend {} {}) = {}, want {}." (a tc) (b tc) got (want tc)))))
-      tests)))
+(test take-zero
+  (assert-equal '() (take 0 '(1 2 3))))
 
 
-(define-test (test-intercalate t)
-  (define-record-type <test-case>
-    (test-case desc x l want)
-    test-case?
-    (desc desc)
-    (x x)
-    (l l)
-    (want want))
-  (let ((tests (list
-                 (test-case
-                   "simple"
-                   ","
-                   '("a" "b" "c")
-                   '("a" "," "b" "," "c"))
-                 (test-case
-                   "empty"
-                   ","
-                   '()
-                   '())
-                 (test-case
-                   "singleton"
-                   ","
-                   '(1)
-                   '(1)))))
-    (for-each
-      (lambda (tc)
-        (let ((got (intercalate (x tc) (l tc))))
-          (unless (equal? got (want tc))
-            (errorf t "(intercalate {} {}) = {}, want {}." (x tc) (l tc) got (want tc)))))
-      tests)))
+(test take-short-list
+  (assert-equal '(1 2 3) (take 5 '(1 2 3))))
+
+
+(test take-whole-list
+  (assert-equal '(1 2 3) (take 3 '(1 2 3))))
+
+
+(define-syntax values=
+  (syntax-rules ()
+    ((values= x y)
+     (let-values (((x-a x-b) x)
+                  ((y-a y-b) y))
+       (and (equal? x-a y-a) (equal? x-b y-b))))))
+
+
+(test split-at-simple
+  (assert (values= (values '(1 2) '(3 4)) (split-at 2 '(1 2 3 4)))))
+
+
+(test split-at-negative
+  (assert (values= (values '() '(1 2 3)) (split-at -5 '(1 2 3)))))
+
+
+(test split-at-zero
+  (assert (values= (values '() '(1 2 3)) (split-at 0 '(1 2 3)))))
+
+
+(test split-at-short-list
+  (assert (values= (values '(1 2 3) '()) (split-at 5 '(1 2 3)))))
+
+
+(test split-at-whole-list
+  (assert (values= (values '(1 2 3) '()) (split-at 3 '(1 2 3)))))
+
+
+(test revappend-threes
+  (assert-equal '(1 2 3 4 5 6) (revappend '(3 2 1) '(4 5 6))))
+
+
+(test revappend-empty-first-list
+  (assert-equal '(1 2 3) (revappend '() '(1 2 3))))
+
+
+(test revappend-empty-second-list
+  (assert-equal '(1 2 3) (revappend '(3 2 1) '())))
+
+
+(test intercalate-simple
+  (assert-equal '("a" "," "b" "," "c") (intercalate "," '("a" "b" "c"))))
+
+
+(test intercalate-empty
+  (assert-equal '() (intercalate "," '())))
+
+
+(test intercalate-singleton
+  (assert-equal '(1) (intercalate "," '(1))))