aboutsummaryrefslogtreecommitdiffstats
path: root/vec-test.csc
diff options
context:
space:
mode:
Diffstat (limited to 'vec-test.csc')
-rw-r--r--vec-test.csc94
1 files changed, 94 insertions, 0 deletions
diff --git a/vec-test.csc b/vec-test.csc
new file mode 100644
index 0000000..681a7c0
--- /dev/null
+++ b/vec-test.csc
@@ -0,0 +1,94 @@
+(import (scheme base)
+ (only (csc testing)
+ subtest
+ define-test
+ errorf)
+ (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)))
+
+
+(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)))
+
+
+(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)))