Added some tests for the parser

diff --git a/source/main.scm b/source/main.scm
index a3dabd70cdc2f8bae2d226be2c28333e88237b58..3b208180320b9bb20735379793282aa70268b10f 100644 (file)
--- a/source/main.scm
+++ b/source/main.scm
@@ -1,17 +1,5 @@
+(include "loop.scm")
 (declare (uses buf)
          (uses lexer)
          (uses parser))
 
-(define program-parser
-  (buf
-    (buf (current-input-port) dlang/tokenize)
-    dlang/program))
-
-(define expression-parser
-  (buf
-    (buf (current-input-port) dlang/tokenize)
-    dlang/program))
-
-(print program-parser)
-(print expression-parser)
-

diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index fc007c3208e7c998fc69c974795b418cd3645ca0..528d855b0cbf474d8eda76bf45d0db653c20b7ab 100644 (file)
--- a/source/parse-utils.scm
+++ b/source/parse-utils.scm
@@ -19,10 +19,16 @@
 
 (define (token-match buf expect)
   (define actual (buf-lookahead! buf 1))
-  (if (equal? expect (token-type actual))
-    (buf-consume! buf)
+  (if (eof-object? actual)
     (error
       (string-append
-        "Expected a " expect ", received a " actual " instead")))
+        "Expected a token of type '" (symbol->string expect) ","
+        " received EOF instead"))
+    (if (equal? expect (token-type actual))
+      (buf-consume! buf)
+      (error
+        (string-append
+          "Expected a token of type '" (symbol->string expect) ","
+          " received '" (symbol->string (token-type actual)) " instead"))))
   actual)
 

diff --git a/source/parser.scm b/source/parser.scm
index b8c292183c11c94b7df3d60ff3598ad92aee68b2..6816f3f16c157befca9e65172dc476d5d1747661 100644 (file)
--- a/source/parser.scm
+++ b/source/parser.scm
@@ -28,6 +28,8 @@
 ; ExpBlock := Expression*
 ;------------------------------------------------------------------------------
 
+(define (core-form? in) #f)
+
 (define (dlang/program in)
   (define result '())
   (while (not (eof-object? (buf-lookahead! in 1)))
@@ -66,18 +68,17 @@
     tree))
 
 (define (dlang/operator in)
-  (define tok (buf-lookahead! in 1))
-  (if (equal? 'id (token-type tok))
-    (syntree (token-type tok) (token-text tok) '())
-    (error "Expected an Id or operator.")))
+  (define tok (token-match in 'id))
+  (syntree (token-type tok) (token-text tok) '()))
 
 (define (dlang/literal in)
   (define tok (buf-lookahead! in 1))
-  (if (or (equal? 'id tok)
-          (equal? 'character tok)
-          (equal? 'string tok)
-          (equal? 'symbol tok)
-          (equal? 'number tok))
+  (define type (if (eof-object? tok) '() (token-type tok)))
+  (if (or (equal? 'id type)
+          (equal? 'character type)
+          (equal? 'string type)
+          (equal? 'symbol type)
+          (equal? 'number type))
     (set! tok (buf-consume! in))
     (error "Expected a literal"))
   (syntree (token-type tok) (token-text tok) '()))

diff --git a/tests/test_parser.scm b/tests/test_parser.scm
index 7362bf421b5b66aaacbefd20963817a7523f84c7..64083dcba4e34c99089fbb1c59a595ba5c772474 100644 (file)
--- a/tests/test_parser.scm
+++ b/tests/test_parser.scm
@@ -1,3 +1,105 @@
 (include "test.scm")
-(declare (unit test_parser))
+(declare (unit test_parser)
+         (uses parser lexer buf))
+
+; Helper functions
+;------------------------------------------------------------------------------
+(define (make-lexer input)
+  (buf (buf input read-char) dlang/tokenize))
+
+; dlang/operator-app
+;------------------------------------------------------------------------------
+
+; dlang/operator
+;------------------------------------------------------------------------------
+(def-test "dlang/operator should parse an Id"
+  (call-with-input-string "abc"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/operator lxr))
+      (and (syntree? result)
+           (equal? 'id (syntree-type result))
+           (equal? "abc" (syntree-text result))
+           (equal? '() (syntree-children result))))))
+
+(def-test "dlang/operator should error if not an Id"
+  (call-with-input-string "1.0"
+    (lambda (input)
+      (define lxr (make-lexer input))
+     (check-error "Expected a token of type 'id, received 'number instead"
+        (dlang/operator lxr)))))
+
+(def-test "dlang/operator should error if EOF"
+  (call-with-input-string ""
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-error "Expected a token of type 'id, received EOF instead"
+        (dlang/operator lxr)))))
+
+; dlang/literal
+;------------------------------------------------------------------------------
+(def-test "dlang/literal should parse an Id"
+  (call-with-input-string "abc"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/literal lxr))
+      (and (syntree? result)
+           (equal? 'id (syntree-type result))
+           (equal? "abc" (syntree-text result))
+           (equal? '() (syntree-children result))
+           (eof-object? (buf-lookahead! lxr 1))))))
+
+(def-test "dlang/literal should parse a Character"
+  (call-with-input-string "'a'"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/literal lxr))
+      (and (syntree? result)
+           (equal? 'character (syntree-type result))
+           (equal? "'a'" (syntree-text result))
+           (equal? '() (syntree-children result))))))
+
+(def-test "dlang/literal should parse a String"
+  (call-with-input-string "\"abc\""
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/literal lxr))
+      (and (syntree? result)
+           (equal? 'string (syntree-type result))
+           (equal? "\"abc\"" (syntree-text result))
+           (equal? '() (syntree-children result))))))
+
+(def-test "dlang/literal should parse a Symbol"
+  (call-with-input-string "$abc"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/literal lxr))
+      (and (syntree? result)
+           (equal? 'symbol (syntree-type result))
+           (equal? "$abc" (syntree-text result))
+           (equal? '() (syntree-children result))))))
+
+(def-test "dlang/literal should parse a Number"
+  (call-with-input-string "1.0"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/literal lxr))
+      (and (syntree? result)
+           (equal? 'number (syntree-type result))
+           (equal? "1.0" (syntree-text result))
+           (equal? '() (syntree-children result))))))
+
+(def-test "dlang/literal should error when no literal found"
+  (call-with-input-string "("
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-error "Expected a literal"
+        (dlang/literal lxr)))))
+
+(def-test "dlang/literal should error when EOF"
+  (call-with-input-string ""
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-error "Expected a literal"
+        (dlang/literal lxr)))))