From: Mike D. Lowis <mike@mdlowis.com>
Date: Fri, 27 Jul 2012 18:51:41 +0000 (-0400)
Subject: Added tests for parse-utils
X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=19fab88a21aedc9856653babb94045633da738cf;p=archive%2Fdlang-scm.git

Added tests for parse-utils
---

diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index 7828996..7b1362f 100644
--- a/source/parse-utils.scm
+++ b/source/parse-utils.scm
@@ -25,12 +25,14 @@
 (define (char-match buf expect)
   (define actual (buf-lookahead! buf 1))
   (if (eof-object? actual)
-    (abort (string-append "Expected '" (string expect) "', received EOF instead"))
+    (abort
+      (string-append "Expected '" (string expect) "', received EOF instead"))
     (if (equal? expect actual)
       (buf-consume! buf)
       (abort
         (string-append
-          "Expected '" (string expect) "', received '" (string actual) "' instead"))))
+          "Expected '" (string expect)
+          "', received '" (string actual) "' instead"))))
   actual)
 
 (define (token-match buf expect)
diff --git a/tests/test_parse_utils.scm b/tests/test_parse_utils.scm
index 5cc804f..62d6a34 100644
--- a/tests/test_parse_utils.scm
+++ b/tests/test_parse_utils.scm
@@ -1,3 +1,93 @@
 (include "test.scm")
 (declare (unit test_parse_utils))
 
+; Tests for function definitions
+;------------------------------------------------------------------------------
+(def-test "functions for token creation and usage should be created"
+  (and (procedure? make-token)
+       (procedure? token)
+       (procedure? token-text)
+       (procedure? token-type)))
+
+(def-test "functions for syntree creation and usage should be created"
+  (and (procedure? make-syntree)
+       (procedure? syntree)
+       (procedure? syntree-text)
+       (procedure? syntree-type)
+       (procedure? syntree-children)))
+
+; syntree=?
+;------------------------------------------------------------------------------
+(def-test "syntree=? should return true if trees are equal"
+  (syntree=?
+    (syntree 'foo "" '())
+    (syntree 'foo "" '())))
+
+(def-test "syntree=? should return false if types differ"
+  (not
+    (syntree=?
+      (syntree 'foo "" '())
+      (syntree 'bar "" '()))))
+
+(def-test "syntree=? should return false if text differs"
+  (not
+    (syntree=?
+      (syntree 'foo "a" '())
+      (syntree 'foo "b" '()))))
+
+(def-test "syntree=? should return false if children differ"
+  (not
+    (syntree=?
+      (syntree 'foo "" '())
+      (syntree 'foo "" '(1)))))
+
+; syntree-children=?
+;------------------------------------------------------------------------------
+(def-test "syntree=? should return true is lists and elements are equal"
+  (syntree-children=?
+    (list (syntree 'foo "bar" '()))
+    (list (syntree 'foo "bar" '()))))
+
+(def-test "syntree=? should return true if both lists are null"
+  (syntree-children=? '() '()))
+
+(def-test "syntree=? should return false if only one of the lists is null"
+  (not (syntree-children=? '() '(1))))
+
+(def-test "syntree=? should return false if elements differ"
+  (not
+    (syntree-children=?
+      (list (syntree 'foo "" '()))
+      (list (syntree 'bar "" '())))))
+
+; char-match
+;------------------------------------------------------------------------------
+
+; token-match
+;------------------------------------------------------------------------------
+
+; token-matches?
+;------------------------------------------------------------------------------
+
+; keyword-match
+;------------------------------------------------------------------------------
+
+; token->syntree
+;------------------------------------------------------------------------------
+(def-test "token->syntree should convert a token to a syntree"
+  (syntree=?
+    (token->syntree (token 'foo "bar"))
+    (syntree 'foo "bar" '())))
+
+; test-apply
+;------------------------------------------------------------------------------
+
+; collect-char
+;------------------------------------------------------------------------------
+
+; consume-all
+;------------------------------------------------------------------------------
+
+; collect
+;------------------------------------------------------------------------------
+