From f4ca6878cc0f6d6b5a55f8196d013f3d3b1ab4b4 Mon Sep 17 00:00:00 2001
From: "Mike D. Lowis" <mike@mdlowis.com>
Date: Mon, 16 Jul 2012 16:46:40 -0400
Subject: [PATCH] Added tests for expression and basic expression parsing rules

---
 source/parser.scm     | 14 ++++++++------
 tests/test_parser.scm | 18 ++++++++++++++++++
 2 files changed, 26 insertions(+), 6 deletions(-)

diff --git a/source/parser.scm b/source/parser.scm
index 3a48f73..ac6acda 100644
--- 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 731dcaa..93ac572 100644
--- 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
 ;------------------------------------------------------------------------------
-- 
2.54.0