From acc561366f3fe6ec0377103f52ef0f7e923711c9 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Mon, 1 Aug 2022 19:35:19 -0700
Subject: Modify the project structure.

Now the lib directory contains what will eventually end up on the
user's /usr/lib/csc. When I write make install, it will copy all of
the .csc files from lib into the destination lib directory. This means I
can start working on the standard library in lib/scheme.
---
 lib/csc/match-test.csc | 113 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 113 insertions(+)
 create mode 100644 lib/csc/match-test.csc

(limited to 'lib/csc/match-test.csc')

diff --git a/lib/csc/match-test.csc b/lib/csc/match-test.csc
new file mode 100644
index 0000000..c5923e4
--- /dev/null
+++ b/lib/csc/match-test.csc
@@ -0,0 +1,113 @@
+(define-library (csc match-test)
+  (import (scheme base)
+          (only (csc testing) assert-equal test)
+          (csc match))
+  (begin
+
+
+    (test match-cond
+      (assert-equal
+        3
+        (match 3
+          ('0 0)
+          ('1 1)
+          ('2 2)
+          ('3 3)
+          ('4 4))))
+
+
+    (test match-list
+      (assert-equal
+        2
+        (match '(1 2 3)
+          ('() 0)
+          (('1 '2) 1)
+          (('1 '2 '3) 2)
+          (('1 '2 '3 '4) 3)
+          (_ 4))))
+
+
+    (test match-binding
+      (assert-equal
+        2
+        (match '(1 2 3)
+          (('1 x '3) x))))
+
+
+    (test match-destructuring
+      (assert-equal
+        1
+        (match '(1 2 3)
+          ('() 0)
+          ((head . _) head))))
+
+
+    (test match-ignore
+      (assert-equal
+        2
+        (match '(1 2 3)
+          ((_ _ _ _) 0)
+          (('2 _ _) 1)
+          (('1 _ _) 2)
+          (_ 3))))
+
+
+    (test match-improper-list
+      (assert-equal
+        2
+        (match '(1 2 3)
+          (('2 . _) 1)
+          (('1 . x) (car x))
+          (_ 3))))
+
+
+    (test match-symbol
+      (assert-equal
+        2
+        (match 'b
+          ('a 1)
+          ('b 2)
+          (_ 3))))
+
+
+    (test match-when
+      (assert-equal
+        3
+        (match 'b
+          ('a 1)
+          ('b when #f 2)
+          ('b when #t 3)
+          (_ 4))))
+
+
+    (test match-when-depending-on-pattern-variable
+      (assert-equal
+        2
+        (match 10
+          (n when (= 1 n) 1)
+          (n when (= 10 n) 2)
+          (_ 3))))
+
+
+    (define-match-record-type <test-record-type>
+      (make-test-record-type a b c)
+      test-record-type?
+      %test-record-type
+      (a test-record-type-a)
+      (b test-record-type-b)
+      (c test-record-type-c))
+
+
+    (test match-record-type
+      (assert-equal
+        2
+        (match (make-test-record-type 1 2 3)
+          ((% %test-record-type a b c) b))))
+
+
+    (test match-record-type-any
+      (assert-equal
+        2
+        (match '(1 2 3)
+          ((% %test-record-type . _) 1)
+          ('(1 2 3) 2))))))
-- 
cgit v1.3.1