Added blacklisted Id characters to a predicate function for use in the lexer. This...

diff --git a/source/lexer.scm b/source/lexer.scm
index 2db5bf31fdf790e35f89fb15f368012c4a0ec248..1bdfeef6559355e08d848a5acfcf640b8eb6f585 100644 (file)
--- 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 91a7b8bd716b72808f394fe0d1b1c6bdcc9c86f4..014431835bda9015d6300cbfe63beeb2e55a877c 100644 (file)
--- 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 ffefdffaaee188c927fed4096fc4638fe78aefe7..731dcaa8bfd55525d8aaf69e7f4ed2145c49a646 100644 (file)
--- 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))