From 708b874213977065024ce08fd592ad752176448f Mon Sep 17 00:00:00 2001
From: "Mike D. Lowis" <mike@mdlowis.com>
Date: Mon, 16 Jul 2012 14:23:44 -0400
Subject: [PATCH] Added blacklisted Id characters to a predicate function for
 use in the lexer. This fixes the Id and Id-list parsing

---
 source/lexer.scm      |  15 +++--
 tests/test_lexer.scm  | 133 +++++++++++++++++++++++++++++++++++++++++-
 tests/test_parser.scm |   6 +-
 3 files changed, 145 insertions(+), 9 deletions(-)

diff --git a/source/lexer.scm b/source/lexer.scm
index 2db5bf3..1bdfeef 100644
--- a/source/lexer.scm
+++ b/source/lexer.scm
@@ -129,13 +129,18 @@
 
 (define (dlang/id in)
   (define acc "")
-  (define ch (buf-lookahead! in 1))
-  (while (and (not (char-whitespace? ch))
-           (not (eof-object? ch))
-           (not (char=? ch #\#)))
+  (while (dlang/id-char? in)
     (set! acc (string-append acc (string (buf-consume! in))))
-    (set! ch (buf-lookahead! in 1)))
+    )
   (if (> (string-length acc) 0)
     (token 'id acc)
     (error "An Id was expected but none found.")))
 
+(define (dlang/id-char? in)
+  (define ch (buf-lookahead! in 1))
+  (and (not (eof-object? ch))
+       (not (char-whitespace? ch))
+       (case ch
+         ((#\( #\) #\; #\, #\' #\" #\$ #\#) #f)
+         (else #t))))
+
diff --git a/tests/test_lexer.scm b/tests/test_lexer.scm
index 91a7b8b..0144318 100644
--- a/tests/test_lexer.scm
+++ b/tests/test_lexer.scm
@@ -621,7 +621,7 @@
            (equal? 'id (token-type result))
            (equal? "abc" (token-text result))))))
 
-(def-test "dlang/id should stop recognition on whitepsace"
+(def-test "dlang/id should stop recognition on whitespace"
   (call-with-input-string "abc abc"
     (lambda (input)
       (define buffer (buf input read-char))
@@ -655,3 +655,134 @@
            (equal? 'id (token-type result))
            (equal? "foo" (token-text result))))))
 
+(def-test "dlang/id should stop recognition when left paren encountered"
+  (call-with-input-string "foo("
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/id buffer))
+      (and (token? result)
+           (equal? 'id (token-type result))
+           (equal? "foo" (token-text result))))))
+
+(def-test "dlang/id should stop recognition when right paren encountered"
+  (call-with-input-string "foo)"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/id buffer))
+      (and (token? result)
+           (equal? 'id (token-type result))
+           (equal? "foo" (token-text result))))))
+
+(def-test "dlang/id should stop recognition when semicolon encountered"
+  (call-with-input-string "foo;"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/id buffer))
+      (and (token? result)
+           (equal? 'id (token-type result))
+           (equal? "foo" (token-text result))))))
+
+(def-test "dlang/id should stop recognition when comma encountered"
+  (call-with-input-string "foo,"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/id buffer))
+      (and (token? result)
+           (equal? 'id (token-type result))
+           (equal? "foo" (token-text result))))))
+
+(def-test "dlang/id should stop recognition when single quote encountered"
+  (call-with-input-string "foo'"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/id buffer))
+      (and (token? result)
+           (equal? 'id (token-type result))
+           (equal? "foo" (token-text result))))))
+
+(def-test "dlang/id should stop recognition when double quote encountered"
+  (call-with-input-string "foo\""
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/id buffer))
+      (and (token? result)
+           (equal? 'id (token-type result))
+           (equal? "foo" (token-text result))))))
+
+(def-test "dlang/id should stop recognition when dollar sign encountered"
+  (call-with-input-string "foo$"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/id buffer))
+      (and (token? result)
+           (equal? 'id (token-type result))
+           (equal? "foo" (token-text result))))))
+
+; dlang/id-char?
+;------------------------------------------------------------------------------
+(def-test "dlang/id-char? should return true for valid char"
+  (call-with-input-string "f"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #t (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for eof"
+  (call-with-input-string ""
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for whitespace"
+  (call-with-input-string " "
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for left paren"
+  (call-with-input-string "("
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for right paren"
+  (call-with-input-string ")"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for semicolon"
+  (call-with-input-string ";"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for comma"
+  (call-with-input-string ","
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for single quote"
+  (call-with-input-string "'"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for double quote"
+  (call-with-input-string "\""
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for dollar sign"
+  (call-with-input-string "$"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
+(def-test "dlang/id-char? should return false for hash"
+  (call-with-input-string "#"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (equal? #f (dlang/id-char? buffer)))))
+
diff --git a/tests/test_parser.scm b/tests/test_parser.scm
index ffefdff..731dcaa 100644
--- a/tests/test_parser.scm
+++ b/tests/test_parser.scm
@@ -146,7 +146,7 @@
            (equal? '()   (syntree-children result))))))
 
 (def-test "dlang/id-list should recognize an id list of length 1"
-  (call-with-input-string "( a )"
+  (call-with-input-string "(a)"
     (lambda (input)
       (define lxr (make-lexer input))
       (define result (dlang/id-list lxr))
@@ -157,7 +157,7 @@
              (list (syntree 'id "a" '())))))))
 
 (def-test "dlang/id-list should recognize an id list of length 2"
-  (call-with-input-string "( a , b )"
+  (call-with-input-string "(a,b)"
     (lambda (input)
       (define lxr (make-lexer input))
       (define result (dlang/id-list lxr))
@@ -169,7 +169,7 @@
                    (syntree 'id "b" '())))))))
 
 (def-test "dlang/id-list should recognize an id list of length 3"
-  (call-with-input-string "( a , b , c )"
+  (call-with-input-string "(a,b,c)"
     (lambda (input)
       (define lxr (make-lexer input))
       (define result (dlang/id-list lxr))
-- 
2.52.0