From 512b963888e1965e7176fe577b3cef4ac5663745 Mon Sep 17 00:00:00 2001
From: "Mike D. Lowis" <mike@mdlowis.com>
Date: Thu, 19 Jul 2012 15:25:39 -0400
Subject: [PATCH] Added tests for arg-list and fixed a bug in test-apply

---
 source/parse-utils.scm | 11 +++++----
 source/parser.scm      | 16 ++++++++++++-
 tests/test_parser.scm  | 52 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 73 insertions(+), 6 deletions(-)

diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index 5b70533..31318f6 100644
--- a/source/parse-utils.scm
+++ b/source/parse-utils.scm
@@ -68,10 +68,11 @@
 (define (test-apply fn buf . args)
   (define result '())
   (buf-mark! buf)
-  (call/cc
-    (lambda (cont)
-      (with-exception-handler
-        (lambda (x) (cont '()))
-        (lambda ()  (set! result (apply fn (append buf args)))))))
+  (set! result
+    (call/cc
+      (lambda (cont)
+        (with-exception-handler
+          (lambda (x) (cont '()))
+          (lambda ()  (apply fn (append (list buf) args)))))))
   (buf-release! buf)
   (not (null? result)))
diff --git a/source/parser.scm b/source/parser.scm
index be2aa55..2973488 100644
--- a/source/parser.scm
+++ b/source/parser.scm
@@ -139,7 +139,21 @@
     (abort "Expected a literal"))
   (syntree (token-type tok) (token-text tok) '()))
 
-(define (dlang/arg-list in) '())
+(define (dlang/arg-list in)
+  (define tree (syntree 'arglist "" '()))
+  (define chldrn '())
+  (token-match in 'lpar)
+  (if (not (token-matches? in 'rpar))
+    (begin
+      (set! chldrn
+        (append chldrn (list (dlang/expression in))))
+      (while (not (token-matches? in 'rpar))
+        (token-match in 'comma)
+        (set! chldrn
+          (append chldrn (list (dlang/expression in)))))))
+  (token-match in 'rpar)
+  (syntree-children-set! tree chldrn)
+  tree)
 
 (define (dlang/arg-list? in)
   (test-apply dlang/arg-list in))
diff --git a/tests/test_parser.scm b/tests/test_parser.scm
index 0bb8f26..96eb831 100644
--- a/tests/test_parser.scm
+++ b/tests/test_parser.scm
@@ -366,6 +366,58 @@
 
 ; dlang/arg-list
 ;------------------------------------------------------------------------------
+(def-test "dlang/arg-list should recognize an empty id list"
+  (call-with-input-string "()"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/arg-list lxr))
+      (syntree=? result (syntree 'arglist "" '())))))
+
+(def-test "dlang/arg-list should recognize an arg list of length 1"
+  (call-with-input-string "(a)"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/arg-list lxr))
+      (syntree=? result
+        (syntree 'arglist ""
+          (list (syntree 'id "a" '())))))))
+
+(def-test "dlang/arg-list should recognize an arg list of length 2"
+  (call-with-input-string "(a,1.0)"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/arg-list lxr))
+      (syntree=? result
+        (syntree 'arglist ""
+          (list
+            (syntree 'id "a" '())
+            (syntree 'number "1.0" '())))))))
+
+(def-test "dlang/arg-list should recognize an arg list of length 3"
+  (call-with-input-string "(a,1.0,$c)"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/arg-list lxr))
+      (syntree=? result
+        (syntree 'arglist ""
+          (list
+            (syntree 'id "a" '())
+            (syntree 'number "1.0" '())
+            (syntree 'symbol "$c" '())))))))
+
+; dlang/arg-list?
+;------------------------------------------------------------------------------
+(def-test "dlang/arg-list? should return true if input contains an arg list"
+  (call-with-input-string "(a, 1.0, $c)"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (equal? #t (dlang/arg-list? lxr)))))
+
+(def-test "dlang/arg-list? should return false if input does not contain an arg list"
+  (call-with-input-string "(a b c)"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (equal? #f (dlang/arg-list? lxr)))))
 
 ; dlang/id-list
 ;------------------------------------------------------------------------------
-- 
2.52.0