From 68986fe0410584c6934c835bb0ee784655f5f8c5 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Tue, 11 Jan 2022 22:01:23 -0800
Subject: Move scheme compiler into a separate directory.

---
 csc/hash-map-test.csc | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100644 csc/hash-map-test.csc

(limited to 'csc/hash-map-test.csc')

diff --git a/csc/hash-map-test.csc b/csc/hash-map-test.csc
new file mode 100644
index 0000000..353e6b4
--- /dev/null
+++ b/csc/hash-map-test.csc
@@ -0,0 +1,78 @@
+(import (scheme base)
+        (only (csc sort) sort)
+        (only (csc testing)
+              assert-equal
+              assert-raises
+              test)
+        (csc hash-map))
+
+
+(define (hash-symbol s)
+  (hash-bytevector (string->utf8 (symbol->string s))))
+
+
+(define (symbol<? s1 s2)
+  (string<? (symbol->string s1) (symbol->string s2)))
+
+
+(define (alist->map->alist l)
+  (map->alist (alist->map hash-symbol symbol<? l)))
+
+
+(define (sort-alist l)
+  (sort (lambda (x1 x2) (symbol<? (car x1) (car x2))) l))
+
+
+(test map->alist-singleton
+  (assert-equal (sort-alist '((a . 1))) (sort-alist (alist->map->alist '((a . 1))))))
+
+
+(test map->alist-two
+  (assert-equal (sort-alist '((a . 1) (b . 2))) (sort-alist (alist->map->alist '((a . 1) (b . 2))))))
+
+
+(test map->alist-longer
+  (assert-equal
+    (sort-alist '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6)))
+    (sort-alist (alist->map->alist '((a . 1) (b . 2) (c . 3) (d . 4) (e . 5) (f . 6))))))
+
+
+(test map->alist-larger
+  (assert-equal
+    (sort-alist '((f . 5) (m . 1) (n . 7) (q . 3) (x . 8)))
+    (sort-alist (alist->map->alist '((m . 1) (n . 2) (q . 3) (f . 5) (n . 7) (x . 8))))))
+
+
+(test map->alist-in-order
+  (assert-equal
+    (sort-alist '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ())))
+    (sort-alist (alist->map->alist '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))))))
+
+
+(test map->alist-reversed
+  (assert-equal
+    (sort-alist '((h . ()) (g . ()) (f . ()) (e . ()) (d . ()) (c . ()) (b . ()) (a . ())))
+    (sort-alist (alist->map->alist '((a . ()) (b . ()) (c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()))))))
+
+
+(test map->alist-overwrite
+  (assert-equal
+    (sort-alist '((a . 2)))
+    (sort-alist (alist->map->alist '((a . 1) (a . 2))))))
+
+
+(test map->alist-alternating
+  (assert-equal
+    (sort-alist '((h . ()) (g . ()) (i . ()) (f . ()) (j . ()) (e . ()) (k . ()) (d . ()) (l . ()) (c . ())))
+    (sort-alist (alist->map->alist '((c . ()) (d . ()) (e . ()) (f . ()) (g . ()) (h . ()) (i . ()) (j . ()) (k . ()) (l . ()))))))
+
+
+(test lookup
+  (assert-equal
+    2
+    (lookup (alist->map hash-symbol symbol<? '((a . 1) (b . 2) (c . 3))) 'b)))
+
+
+(test lookup-notfound
+  (assert-raises key-not-found-error?
+    (lookup (alist->map hash-symbol symbol<? '((a . 1) (b . 2) (c . 3))) 'd)))
-- 
cgit v1.3.1