Added tests for expression and basic expression parsing rules

diff --git a/source/parser.scm b/source/parser.scm
index 3a48f73a6e6c6f0b15c4043b4d939eb04dc70d1f..ac6acda441d923d90a79ca54be8afb2da312e590 100644 (file)
--- a/source/parser.scm
+++ b/source/parser.scm
@@ -36,14 +36,14 @@
 (define (dlang/expression in)
   (if (core-form? in)
     (core-form in)
-    (let ((result (dlang/basic-expr in))
-          (ret    '()))
+    (let ((result (dlang/basic-expr in)))
       (if (equal? 'lpar (buf-lookahead! in 1))
         (begin
           (match in 'lpar)
-          (set! ret (dlang/expr-list in))
+          (set! result
+            (syntree 'apply (list result (dlang/expr-list in))))
           (match in 'rpar)))
-      ret)))
+      result)))
 
 (define (dlang/core-form in)
   (define tok (buf-lookahead! in 1))
@@ -139,10 +139,12 @@
   (token-match in 'lpar)
   (if (not (token-matches? in 'rpar))
     (begin
-      (set! chldrn (append chldrn (list (token->syntree (token-match in 'id)))))
+      (set! chldrn
+        (append chldrn (list (token->syntree (token-match in 'id)))))
       (while (not (token-matches? in 'rpar))
         (token-match in 'comma)
-        (set! chldrn (append chldrn (list (token->syntree (token-match in 'id))))))))
+        (set! chldrn
+          (append chldrn (list (token->syntree (token-match in 'id))))))))
   (token-match in 'rpar)
   (syntree-children-set! tree chldrn)
   tree)

diff --git a/tests/test_parser.scm b/tests/test_parser.scm
index 731dcaa8bfd55525d8aaf69e7f4ed2145c49a646..93ac5725029d01ff85fc0af2bdf352a2671abb27 100644 (file)
--- a/tests/test_parser.scm
+++ b/tests/test_parser.scm
@@ -12,6 +12,15 @@
 
 ; dlang/expression
 ;------------------------------------------------------------------------------
+(def-test "dlang/expression should parse a literal"
+  (call-with-input-string "abc"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/expression lxr))
+      (and (syntree? result)
+           (equal? 'id (syntree-type result))
+           (equal? "abc" (syntree-text result))
+           (equal? '() (syntree-children result))))))
 
 ; dlang/core-form
 ;------------------------------------------------------------------------------
@@ -33,6 +42,15 @@
 
 ; dlang/basic-expr
 ;------------------------------------------------------------------------------
+(def-test "dlang/basic-expr should parse a literal"
+  (call-with-input-string "abc"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/basic-expr lxr))
+      (and (syntree? result)
+           (equal? 'id (syntree-type result))
+           (equal? "abc" (syntree-text result))
+           (equal? '() (syntree-children result))))))
 
 ; dlang/operator-app
 ;------------------------------------------------------------------------------