Added more unit tests for lexer

diff --git a/Makefile b/Makefile
index f39e95a07f0ddc39da1f6481ef676abccdaeadae..baaeb2d6c6c2a9bc1c18b845b7fc383259cc177f 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -37,7 +37,7 @@ TEST_OBJS = $(TEST_FILES:%.$(TEST_EXT)=%.o)
 
 # Include Directories
 SRC_INCS  = -I inc
-TEST_INCS = -I inc
+TEST_INCS = -I inc -w
 
 # Compiler and Linker Options
 #----------------------------

diff --git a/inc/test.scm b/inc/test.scm
index 48bb5be5ea32a017c9c374aedb35e5c5ad5f8fe1..3ae10114a53e33dd2b259fcec811bb95ce1b681e 100644 (file)
--- a/inc/test.scm
+++ b/inc/test.scm
@@ -6,3 +6,16 @@
         (cons desc
           (lambda () body ...))))))
 
+(define-syntax check-error
+  (syntax-rules ()
+    ((_ expect expr)
+      (let ((prev error))
+        (define result
+          (call/cc
+            (lambda (err)
+              (set! error err)
+              expr)))
+        (set! error prev)
+        (equal? expect result)))))
+
+

diff --git a/source/lexer.scm b/source/lexer.scm
index 685490e167a18c2873781519e9b8af4ab4e4f6f7..fda961be8c1ff7c3051ae42072b48dcd36c7753e 100644 (file)
--- a/source/lexer.scm
+++ b/source/lexer.scm
@@ -63,10 +63,12 @@
 
 (define (dlang/integer in)
   (define text "")
-  (if (char-numeric? (buf-lookahead! in 1))
+  (if (and
+        (not (eof-object? (buf-lookahead! in 1)))
+        (char-numeric? (buf-lookahead! in 1)))
     (while (char-numeric? (buf-lookahead! in 1))
       (set! text (string-append text (string (buf-consume! in)))))
-    (error "Expected a number."))
+    (error "Expected an integer"))
   text)
 
 (define (dlang/decimal in)
@@ -80,24 +82,24 @@
       (match in #\e) (match in #\E))
     (dlang/integer in "")))
 
-(define (dlang/character in str)
+(define (dlang/character in)
   (token 'character
     (string-append
       (string (match in #\'))
       (string (buf-consume! in))
       (string (match in #\')) )))
 
-(define (dlang/string in str)
+(define (dlang/string in)
   (token 'string
     (string-append
       (string (match in #\"))
       (accumulate-till in string-append "" #\")
       (string (match in #\")) )))
 
-(define (dlang/symbol in str)
+(define (dlang/symbol in)
   (token 'symbol
     (string-append
-      (match in #\$)
+      (string (char-match in #\$))
       (token-text (dlang/id in)))))
 
 (define (dlang/id in)

diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index 3f1bcf76f71c47f9d3c5bc8a89d3ffb1acd80db8..fc007c3208e7c998fc69c974795b418cd3645ca0 100644 (file)
--- a/source/parse-utils.scm
+++ b/source/parse-utils.scm
@@ -8,11 +8,13 @@
 
 (define (char-match buf expect)
   (define actual (buf-lookahead! buf 1))
-  (if (equal? expect actual)
-    (buf-consume! buf)
-    (error
-      (string-append
-        "Expected '" expect "', received '" actual "' instead.")))
+  (if (eof-object? actual)
+    (error (string-append "Expected '" (string expect) "', received EOF instead"))
+    (if (equal? expect actual)
+      (buf-consume! buf)
+      (error
+        (string-append
+          "Expected '" (string expect) "', received '" (string actual) "' instead"))))
   actual)
 
 (define (token-match buf expect)
@@ -21,6 +23,6 @@
     (buf-consume! buf)
     (error
       (string-append
-        "Expected a " expect ", received a " actual " instead.")))
+        "Expected a " expect ", received a " actual " instead")))
   actual)
 

diff --git a/tests/test.scm b/tests/test.scm
index 8eb1430f05dcf14acc8f9e1342b4451307c9cd55..8d1da87f3dc04473c144520485bdfbdcf449e72b 100644 (file)
--- a/tests/test.scm
+++ b/tests/test.scm
@@ -6,7 +6,7 @@
 (define (register-test! test)
   (set! unit-tests (append unit-tests (list test))))
 
-(define (error msg) msg)
+;(define (error msg) msg)
 
 (define (print-summary pass fail)
   (if (zero? fail)

diff --git a/tests/test_lexer.scm b/tests/test_lexer.scm
index 0482f8dc1f1ebf8421bab0aee6e57a95dbb5c7cd..c0c1c76ed752f3e06641bf0156de8e0e92bd9fdc 100644 (file)
--- a/tests/test_lexer.scm
+++ b/tests/test_lexer.scm
@@ -16,6 +16,43 @@
 
 ; dlang/integer
 ;------------------------------------------------------------------------------
+(def-test "dlang/integer should recognize an integer of length one"
+  (call-with-input-string "0"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/integer buffer))
+      (and (string? result)
+           (equal? "0" result)))))
+
+(def-test "dlang/integer should recognize an integer of length two"
+  (call-with-input-string "01"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/integer buffer))
+      (and (string? result)
+           (equal? "01" result)))))
+
+(def-test "dlang/integer should recognize an integer of length three"
+  (call-with-input-string "012"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/integer buffer))
+      (and (string? result)
+           (equal? "012" result)))))
+
+(def-test "dlang/integer should error when no integer in input"
+  (call-with-input-string "abc"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (check-error "Expected an integer"
+        (dlang/integer buffer)))))
+
+(def-test "dlang/integer should error when EOF"
+  (call-with-input-string "abc"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (check-error "Expected an integer"
+        (dlang/integer buffer)))))
 
 ; dlang/decimal
 ;------------------------------------------------------------------------------
@@ -31,33 +68,64 @@
 
 ; dlang/symbol
 ;------------------------------------------------------------------------------
-(def-test "dlang/symbol should error when no name given for a symbol"
-  (call-with-input-string "$"
-    (lambda (input) '())))
-
-(def-test "dlang/symbol should error when not a symbol"
-  (call-with-input-string "abc"
-    (lambda (input) '())))
-
 (def-test "dlang/symbol should recognize a symbol of length one"
   (call-with-input-string "$a"
-    (lambda (input) '())))
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/symbol buffer))
+      (and (token? result)
+           (equal? 'symbol (token-type result))
+           (equal? "$a" (token-text result))))))
 
 (def-test "dlang/symbol should recognize a symbol of length two"
   (call-with-input-string "$ab"
-    (lambda (input) '())))
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/symbol buffer))
+      (and (token? result)
+           (equal? 'symbol (token-type result))
+           (equal? "$ab" (token-text result))))))
 
 (def-test "dlang/symbol should recognize a symbol of length three"
   (call-with-input-string "$abc"
-    (lambda (input) '())))
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/symbol buffer))
+      (and (token? result)
+           (equal? 'symbol (token-type result))
+           (equal? "$abc" (token-text result))))))
 
 (def-test "dlang/symbol should stop recognition on EOF"
   (call-with-input-string "$abc"
-    (lambda (input) '())))
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/symbol buffer))
+      (and (token? result)
+           (equal? 'symbol (token-type result))
+           (equal? "$abc" (token-text result))))))
 
 (def-test "dlang/symbol should stop recognition on whitespace"
   (call-with-input-string "$abc "
-    (lambda (input) '())))
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (define result (dlang/symbol buffer))
+      (and (token? result)
+           (equal? 'symbol (token-type result))
+           (equal? "$abc" (token-text result))))))
+
+(def-test "dlang/symbol should error when no name given for a symbol"
+  (call-with-input-string "$"
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (check-error "An Id was expected but none found."
+        (dlang/symbol buffer)))))
+
+(def-test "dlang/symbol should error when EOF"
+  (call-with-input-string ""
+    (lambda (input)
+      (define buffer (buf input read-char))
+      (check-error "Expected '$', received EOF instead"
+        (dlang/symbol buffer)))))
 
 ; dlang/id
 ;------------------------------------------------------------------------------
@@ -110,6 +178,6 @@
   (call-with-input-string ""
     (lambda (input)
       (define buffer (buf input read-char))
-      (define result (dlang/id buffer))
-      (equal? result "An Id was expected but none found.") )))
+      (check-error "An Id was expected but none found."
+        (dlang/id buffer)))))