Added token=? function and more tests for existing functions

diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index 7b1362fc440e04d6622b8749d38dfcc7ed4081a2..f23ff996cc04940355be4fe6b5bab21007262737 100644 (file)
--- a/source/parse-utils.scm
+++ b/source/parse-utils.scm
@@ -3,6 +3,10 @@
 (define-record token type text)
 (define token make-token)
 
+(define (token=? tok1 tok2)
+  (and (equal? (token-type tok1) (token-type tok2))
+       (equal? (token-text tok1) (token-text tok2))))
+
 (define-record syntree type text children)
 (define syntree make-syntree)
 

diff --git a/tests/test_parse_utils.scm b/tests/test_parse_utils.scm
index 62d6a34ac5d248d46406a00cab0ae95d10e0f49c..b654899ae1ea4218130421236ec266dbdfe7825c 100644 (file)
--- a/tests/test_parse_utils.scm
+++ b/tests/test_parse_utils.scm
@@ -16,6 +16,25 @@
        (procedure? syntree-type)
        (procedure? syntree-children)))
 
+; token=?
+;------------------------------------------------------------------------------
+(def-test "token=? should return true if trees are equal"
+  (token=?
+    (token 'foo "")
+    (token 'foo "")))
+
+(def-test "token=? should return false if types differ"
+  (not
+    (token=?
+      (token 'foo "")
+      (token 'bar ""))))
+
+(def-test "token=? should return false if text differs"
+  (not
+    (token=?
+      (token 'foo "a")
+      (token 'foo "b"))))
+
 ; syntree=?
 ;------------------------------------------------------------------------------
 (def-test "syntree=? should return true if trees are equal"
@@ -62,9 +81,50 @@
 
 ; char-match
 ;------------------------------------------------------------------------------
+(def-test "char-match should consume and return char if the next char matches"
+  (call-with-input-string "a"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (and (equal? #\a (char-match buffer #\a))
+           (eof-object? (buf-lookahead! buffer 1))))))
+
+(def-test "char-match should error when EOF"
+  (call-with-input-string ""
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (check-exception "Expected 'a', received EOF instead"
+        (char-match buffer #\a)))))
+
+(def-test "char-match should error when chars do not match"
+  (call-with-input-string "b"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (check-exception "Expected 'a', received 'b' instead"
+        (char-match buffer #\a)))))
 
 ; token-match
 ;------------------------------------------------------------------------------
+(def-test "token-match should consume and return token if type matches"
+  (call-with-input-string "a"
+    (lambda (input)
+      (define buffer (dlang/lexer input))
+      (token=?
+        (token-match buffer 'id)
+        (token 'id "a")))))
+
+(def-test "token-match should error when EOF received"
+  (call-with-input-string ""
+    (lambda (input)
+      (define buffer (dlang/lexer input))
+      (check-exception "Expected a token of type 'id, received EOF instead"
+        (token-match buffer 'id)))))
+
+(def-test "token-match should error if type does not match"
+  (call-with-input-string "1.0"
+    (lambda (input)
+      (define buffer (dlang/lexer input))
+      (check-exception "Expected a token of type 'id, received 'number instead"
+        (token-match buffer 'id)))))
 
 ; token-matches?
 ;------------------------------------------------------------------------------