Added tests for arg-list and fixed a bug in test-apply

diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index 5b7053391e810c84d6061e24e64db35d7bd9b427..31318f6c10431a7e8293881181af069a23d21f06 100644 (file)
--- 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 be2aa556220f14894547bf56ba77c82f1152f9ad..29734887ea9f3fbbab533aefeb506cfb397ac2d0 100644 (file)
--- 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 0bb8f269c858e5dd06f0650f93e504427192de3f..96eb831579fc1a9d162d1bcd8abb5123fe87bf33 100644 (file)
--- 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
 ;------------------------------------------------------------------------------