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.

1 files changed, 103 insertions, 0 deletions

diff --git a/strings-test.csc b/strings-test.csc
new file mode 100644
index 0000000..f7c8e53
--- /dev/null
+++ b/strings-test.csc
@@ -0,0 +1,103 @@
+(import (scheme base)
+        (only (csc testing)
+              define-test
+              errorf
+              subtest)
+        (csc strings))
+
+
+(define-test (test-str-prefix? t)
+  (define-record-type <test-case>
+    (test-case name prefix str want)
+    test-case?
+    (name name)
+    (prefix prefix)
+    (str str)
+    (want want))
+  (let ((tests (list
+                 (test-case
+                   "good"
+                   "asdf"
+                   "asdfjkl;"
+                   #t)
+                 (test-case
+                   "bad"
+                   "asdf"
+                   "asdbjkl;"
+                   #f)
+                 (test-case
+                   "too long"
+                   "asdf"
+                   "as"
+                   #f))))
+    (for-each
+      (lambda (tc)
+        (subtest t (name tc)
+                 (let ((got (str-prefix? (prefix tc) (str tc))))
+                   (unless (eq? got (want tc))
+                     (errorf t "(str-prefix? {} {}) = {}, want {}" (str-quote (prefix tc)) (str-quote (str tc)) got (want tc))))))
+      tests)))
+
+
+(define-test (test-str-quote t)
+  (define-record-type <test-case>
+    (test-case name str want)
+    test-case?
+    (name name)
+    (str str)
+    (want want))
+  (let ((tests (list
+                 (test-case
+                   "simple"
+                   "hello"
+                   "\"hello\"")
+                 (test-case
+                   "escape"
+                   "this string \" has a quote"
+                   "\"this string \\\" has a quote\""))))
+    (for-each
+      (lambda (tc)
+        (subtest t (name tc)
+                 (let ((got (str-quote (str tc))))
+                   (unless (equal? got (want tc))
+                     (errorf t "(str-quote {}) = {}, want {}" (str tc) (got tc) (want tc))))))
+      tests)))
+
+
+(define-test (test-str-find t)
+  (define-record-type <test-case>
+    (test-case name match str want)
+    test-case?
+    (name name)
+    (match match)
+    (str str)
+    (want want))
+  (let ((tests (list
+                 (test-case
+                   "ok"
+                   "abc"
+                   "dabsadfdabcdfdfd"
+                   8)
+                 (test-case
+                   "one letter"
+                   "a"
+                   "sdfdfdfsasdfe"
+                   8))))
+    (for-each
+      (lambda (tc)
+        (subtest t (name tc)
+                 (let ((got (str-find (match tc) (str tc))))
+                   (unless (= got (want tc))
+                     (errorf t "(str-find {} {}) = {}, want {}" (str-quote (match tc)) (str-quote (str tc)) got (want tc))))))
+      tests)))
+
+
+(define-test (test-str-find-notfound t)
+  (let* ((match "a")
+         (str "def")
+         (got-exception '()))
+    (guard (e
+             ((str-not-found-error? e) (set! got-exception e)))
+           (str-find match str))
+    (unless (str-not-found-error? got-exception)
+      (errorf t "str-find succeeded, wanted <str-not-found-error>"))))