From 3ff7aac2d2eb2cbf2f854793fc0d7bc6f1f7d927 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 9 Jan 2022 08:40:09 -0800
Subject: Initial commit.

Not sure if everything here will be needed eventually, but we have a
working bytecode interpreter. Next I will write the linker, then the
core compiler, and finish with the macro expander.
---
 list-test.csc | 127 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 127 insertions(+)
 create mode 100644 list-test.csc

(limited to 'list-test.csc')

diff --git a/list-test.csc b/list-test.csc
new file mode 100644
index 0000000..ec4b4ed
--- /dev/null
+++ b/list-test.csc
@@ -0,0 +1,127 @@
+(import (scheme base)
+        (only (csc testing) define-test errorf)
+        (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)))
+
+
+(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)))
+
+
+(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)))
-- 
cgit v1.3.1