From 0424b088aa5a66afa523db1fc21e8c83f3d4b797 Mon Sep 17 00:00:00 2001
From: "Mike D. Lowis" <mike@mdlowis.com>
Date: Fri, 27 Jul 2012 15:50:38 -0400
Subject: [PATCH] =?utf8?q?Added=20token=3D=3F=20function=20and=20more=20te?=
 =?utf8?q?sts=20for=20existing=20functions?=

---
 source/parse-utils.scm     |  4 +++
 tests/test_parse_utils.scm | 60 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 64 insertions(+)

diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index 7b1362f..f23ff99 100644
--- 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 62d6a34..b654899 100644
--- 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?
 ;------------------------------------------------------------------------------
-- 
2.52.0