From f06966df463bdba5912b999bcb6ab0badb83a561 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 9 Jan 2022 16:20:43 -0800
Subject: Redo the testing framework.

We can lean more on the power of scheme to make the testing framework a
little less verbose.
---
 vec-test.csc | 109 +++++++++++++----------------------------------------------
 1 file changed, 24 insertions(+), 85 deletions(-)

(limited to 'vec-test.csc')

diff --git a/vec-test.csc b/vec-test.csc
index 681a7c0..8a19b3e 100644
--- a/vec-test.csc
+++ b/vec-test.csc
@@ -1,94 +1,33 @@
 (import (scheme base)
         (only (csc testing)
-              subtest
-              define-test
-              errorf)
+          assert-equal
+          test)
         (csc vec))
 
 
-(define-test (test-vec t)
-  (define-record-type <test-case>
-    (test-case desc args want)
-    test-case?
-    (desc desc)
-    (args args)
-    (want want))
-  (let ((tests (list
-                 (test-case
-                   "empty"
-                   '()
-                   '())
-                 (test-case
-                   "singleton"
-                   '(1)
-                   '(1)))))
-    (for-each
-      (lambda (tc)
-        (subtest t (desc tc)
-                 (let ((got (apply vec (args tc))))
-                   (unless (equal? (vec->list got) (want tc))
-                     (errorf t "(apply vec {}) = {}, want {}." (args tc) got (want tc)))
-                   (unless (equal? (vec-length got) (length (want tc)))
-                     (errorf t "(apply vec {}) length = {}, want {}." (args tc) (vec-length got) (length (want tc)))))))
-      tests)))
+(test vec-empty
+  (assert-equal '() (vec->list (vec))))
 
 
-(define-test (test-vec-append t)
-  (define-record-type <test-case>
-    (test-case desc in arg want)
-    test-case?
-    (desc desc)
-    (in in)
-    (arg arg)
-    (want want))
-  (let ((tests (list
-                 (test-case
-                   "append to empty"
-                   '()
-                   1
-                   '(1))
-                 (test-case
-                   "append to singleton"
-                   '(1)
-                   2
-                   '(1 2))
-                 (test-case
-                   "append to 2-elem"
-                   '(1 2)
-                   3
-                   '(1 2 3)))))
-    (for-each
-      (lambda (tc)
-        (subtest t (desc tc)
-                 (let* ((v (list->vec (in tc)))
-                        (got (vec-append v (arg tc))))
-                   (unless (equal? (vec->list got) (want tc))
-                     (errorf t "(vec-append {} {}) = {}, want {}." v (arg tc) got (want tc))))))
-      tests)))
+(test vec-singleton
+  (assert-equal '(1) (vec->list (vec 1))))
 
 
-(define-test (test-vec-ref t)
-  (define-record-type <test-case>
-    (test-case desc xs k want)
-    test-case?
-    (desc desc)
-    (xs xs)
-    (k k)
-    (want want))
-  (let ((tests (list
-                 (test-case
-                   "1"
-                   '(1 2)
-                   1
-                   2)
-                 (test-case
-                   "singleton"
-                   '(1)
-                   0
-                   1))))
-    (for-each
-      (lambda (tc)
-        (let ((got (vec-ref (list->vec (xs tc)) (k tc))))
-          (unless (= got (want tc))
-            (errorf t "(vec-ref {} {}) = {}, want {}." (xs tc) (k tc) got (want tc)))))
-      tests)))
+(test vec-append-to-empty
+  (assert-equal '(1) (vec->list (vec-append (vec) 1))))
+
+
+(test vec-append-to-singleton
+  (assert-equal '(1 2) (vec->list (vec-append (vec 1) 2))))
+
+
+(test vec-append-to-2-elem
+  (assert-equal '(1 2 3) (vec->list (vec-append (vec 1 2) 3))))
+
+
+(test vec-ref-1
+  (assert-equal 2 (vec-ref (vec 1 2) 1)))
+
+
+(test vec-ref-singleton
+  (assert-equal 1 (vec-ref (vec 1) 0)))
-- 
cgit v1.3.1