From eea987165441746f7fe7782672ee1ae7546a1dcd Mon Sep 17 00:00:00 2001 From: "Mike D. Lowis" Date: Fri, 20 Jul 2012 10:40:06 -0400 Subject: [PATCH] Finished tests for parser and fixed a bug in buf module where release was not resetting the buffer position --- source/buf.scm | 1 + source/parser.scm | 8 ++- tests/test_buf.scm | 6 +- tests/test_parser.scm | 136 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 147 insertions(+), 4 deletions(-) diff --git a/source/buf.scm b/source/buf.scm index 80267a8..9e3b734 100644 --- 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 6c62147..3121305 100644 --- 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 1e18104..c08d614 100644 --- 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 da99c1f..9d510c5 100644 --- 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" -- 2.52.0