Finished tests for parser and fixed a bug in buf module where release was not resetti...

diff --git a/source/buf.scm b/source/buf.scm
index 80267a8061621354e5ae1365ab92eefdbda74931..9e3b734f89430c7e45012faa886ab924d3a4dd4d 100644 (file)
--- a/source/buf.scm
+++ b/source/buf.scm
@@ -25,6 +25,7 @@
   (buf-marks-set! b (cons (buf-pos b) (buf-marks b))))
 
 (define (buf-release! b)
+  (buf-pos-set! b (car (buf-marks b)))
   (buf-marks-set! b (cdr (buf-marks b))))
 
 (define (buf-advance! b)

diff --git a/source/parser.scm b/source/parser.scm
index 6c621472812ac36853de70b70554fe53aff3234a..312130529ed882edc5223b132213c4aa532046d5 100644 (file)
--- a/source/parser.scm
+++ b/source/parser.scm
@@ -31,13 +31,17 @@
 (define (dlang/program in)
   (define result '())
   (while (not (eof-object? (buf-lookahead! in 1)))
-    (append result (list (dlang/expression in)))))
+    (set! result (append result (list (dlang/expression in)))))
+  result)
 
 (define (dlang/expression in)
   (if (dlang/core-form? in)
     (dlang/core-form in)
     (let ((result (dlang/basic-expr in)))
-      (if (dlang/arg-list? in) (dlang/arg-list? in result) result))))
+      (if (dlang/arg-list? in)
+        (syntree 'apply ""
+          (append (list result) (syntree-children (dlang/arg-list in))))
+        result))))
 
 (define (dlang/core-form in)
   (define tok (buf-lookahead! in 1))

diff --git a/tests/test_buf.scm b/tests/test_buf.scm
index 1e1810443d5b32b1892645e99907bad1947f50f2..c08d614a67eb838f3efedacbaffd22bf0c3f8a1f 100644 (file)
--- a/tests/test_buf.scm
+++ b/tests/test_buf.scm
@@ -106,13 +106,15 @@
   (define buffer (buf (current-input-port) (lambda () '())))
   (buf-marks-set! buffer '(0 1))
   (buf-release! buffer)
-  (equal? '(1) (buf-marks buffer)))
+  (and (equal? '(1) (buf-marks buffer))
+       (equal? 0    (buf-pos buffer))))
 
 (def-test "buf-release! should remove the current mark from the marks list when multiple marks exist"
   (define buffer (buf (current-input-port) (lambda () '())))
   (buf-marks-set! buffer '(0 1 2))
   (buf-release! buffer)
-  (equal? '(1 2) (buf-marks buffer)))
+  (and (equal? '(1 2) (buf-marks buffer))
+       (equal? 0    (buf-pos buffer))))
 
 ; buf-advance!
 ;------------------------------------------------------------------------------

diff --git a/tests/test_parser.scm b/tests/test_parser.scm
index da99c1ff459cacf67e5f80c2b4f20ac571c8bfe9..9d510c5e77bbffee2649fbe92556201410cf77cb 100644 (file)
--- a/tests/test_parser.scm
+++ b/tests/test_parser.scm
@@ -9,9 +9,61 @@
 
 ; dlang/program
 ;------------------------------------------------------------------------------
+(def-test "dlang/program should parse an empty program"
+  (call-with-input-string ""
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/program lxr))
+      (equal? result '()))))
+
+(def-test "dlang/program should parse a program with one expression"
+  (call-with-input-string "abc"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/program lxr))
+      (equal? result (list (syntree 'id "abc" '()))))))
+
+(def-test "dlang/program should parse a program with two expressions"
+  (call-with-input-string "abc 1.0"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/program lxr))
+      (equal? result
+        (list
+          (syntree 'id "abc" '())
+          (syntree 'number "1.0" '()))))))
 
 ; dlang/expression
 ;------------------------------------------------------------------------------
+(def-test "dlang/expression should parse a core form"
+  (call-with-input-string "def foo 1.0;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/expression lxr))
+      (syntree=? result
+        (syntree 'define ""
+          (list
+            (syntree 'id "foo" '())
+            (syntree 'number "1.0" '())))))))
+
+(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))
+      (syntree=? result (syntree 'id "abc" '())))))
+
+(def-test "dlang/expression should parse a function application"
+  (call-with-input-string "abc(1.0,2.0)"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/expression lxr))
+      (syntree=? result
+        (syntree 'apply ""
+          (list
+            (syntree 'id "abc" '())
+            (syntree 'number "1.0" '())
+            (syntree 'number "2.0" '())))))))
 
 ; dlang/core-form
 ;------------------------------------------------------------------------------
@@ -118,6 +170,20 @@
             (syntree 'id "foo" '())
             (syntree 'number "1.0" '())))))))
 
+(def-test "dlang/define should error when no terminator found"
+  (call-with-input-string "def foo 1.0"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a token of type 'term, received EOF instead"
+        (dlang/define lxr)))))
+
+(def-test "dlang/define should error when variable name not an id"
+  (call-with-input-string "def 1.0 1.0;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a token of type 'id, received 'number instead"
+        (dlang/define lxr)))))
+
 ; dlang/assign
 ;------------------------------------------------------------------------------
 (def-test "dlang/assign should parse a variable assignment"
@@ -131,6 +197,20 @@
             (syntree 'id "foo" '())
             (syntree 'number "1.0" '())))))))
 
+(def-test "dlang/define should error when no terminator found"
+  (call-with-input-string "set! foo 1.0"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a token of type 'term, received EOF instead"
+        (dlang/assign lxr)))))
+
+(def-test "dlang/define should error when variable name not an id"
+  (call-with-input-string "set! 1.0 1.0;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a token of type 'id, received 'number instead"
+        (dlang/assign lxr)))))
+
 ; dlang/if
 ;------------------------------------------------------------------------------
 (def-test "dlang/if should parse an if statement with one branch"
@@ -156,6 +236,34 @@
             (syntree 'id "result1" '())
             (syntree 'id "result2" '())))))))
 
+(def-test "dlang/if should error if term received instead of condition"
+  (call-with-input-string "if;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a literal"
+        (dlang/if lxr)))))
+
+(def-test "dlang/if should error if EOF received instead of condition"
+  (call-with-input-string "if"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a literal"
+        (dlang/if lxr)))))
+
+(def-test "dlang/if should error if term received instead of expression"
+  (call-with-input-string "if 1.0;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a literal"
+        (dlang/if lxr)))))
+
+(def-test "dlang/if should error if EOF received instead of expression"
+  (call-with-input-string "if 1.0"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a literal"
+        (dlang/if lxr)))))
+
 ; dlang/begin
 ;------------------------------------------------------------------------------
 (def-test "dlang/begin should parse a begin block with 0 expressions"
@@ -187,6 +295,13 @@
             (syntree 'id "stm1" '())
             (syntree 'id "stm2" '())))))))
 
+(def-test "dlang/begin should error if EOF received instead of term"
+  (call-with-input-string "begin 1.0"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a literal"
+        (dlang/begin lxr)))))
+
 ; dlang/func
 ;------------------------------------------------------------------------------
 (def-test "dlang/func should parse an empty func"
@@ -255,6 +370,27 @@
                 (syntree 'id "b" '())))
             (syntree 'block "" '())))))))
 
+(def-test "dlang/func should error if no opening paren on arg list"
+  (call-with-input-string "func);"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a token of type 'lpar, received 'rpar instead"
+        (dlang/func lxr)))))
+
+(def-test "dlang/func should error if no closing paren on arg list"
+  (call-with-input-string "func(;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a token of type 'id, received 'term instead"
+        (dlang/func lxr)))))
+
+(def-test "dlang/func should error if no terminator"
+  (call-with-input-string "func()"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (check-exception "Expected a literal"
+        (dlang/func lxr)))))
+
 ; dlang/basic-expr
 ;------------------------------------------------------------------------------
 (def-test "dlang/basic-expr should parse a literal"