From fd5d467cd935b2d1493c58669dc72a6b99e6f148 Mon Sep 17 00:00:00 2001 From: "Mike D. Lowis" Date: Fri, 13 Jul 2012 16:38:41 -0400 Subject: [PATCH] Added some tests for the parser --- source/main.scm | 14 +----- source/parse-utils.scm | 12 +++-- source/parser.scm | 19 ++++---- tests/test_parser.scm | 104 ++++++++++++++++++++++++++++++++++++++++- 4 files changed, 123 insertions(+), 26 deletions(-) diff --git a/source/main.scm b/source/main.scm index a3dabd7..3b20818 100644 --- a/source/main.scm +++ b/source/main.scm @@ -1,17 +1,5 @@ +(include "loop.scm") (declare (uses buf) (uses lexer) (uses parser)) -(define program-parser - (buf - (buf (current-input-port) dlang/tokenize) - dlang/program)) - -(define expression-parser - (buf - (buf (current-input-port) dlang/tokenize) - dlang/program)) - -(print program-parser) -(print expression-parser) - diff --git a/source/parse-utils.scm b/source/parse-utils.scm index fc007c3..528d855 100644 --- a/source/parse-utils.scm +++ b/source/parse-utils.scm @@ -19,10 +19,16 @@ (define (token-match buf expect) (define actual (buf-lookahead! buf 1)) - (if (equal? expect (token-type actual)) - (buf-consume! buf) + (if (eof-object? actual) (error (string-append - "Expected a " expect ", received a " actual " instead"))) + "Expected a token of type '" (symbol->string expect) "," + " received EOF instead")) + (if (equal? expect (token-type actual)) + (buf-consume! buf) + (error + (string-append + "Expected a token of type '" (symbol->string expect) "," + " received '" (symbol->string (token-type actual)) " instead")))) actual) diff --git a/source/parser.scm b/source/parser.scm index b8c2921..6816f3f 100644 --- a/source/parser.scm +++ b/source/parser.scm @@ -28,6 +28,8 @@ ; ExpBlock := Expression* ;------------------------------------------------------------------------------ +(define (core-form? in) #f) + (define (dlang/program in) (define result '()) (while (not (eof-object? (buf-lookahead! in 1))) @@ -66,18 +68,17 @@ tree)) (define (dlang/operator in) - (define tok (buf-lookahead! in 1)) - (if (equal? 'id (token-type tok)) - (syntree (token-type tok) (token-text tok) '()) - (error "Expected an Id or operator."))) + (define tok (token-match in 'id)) + (syntree (token-type tok) (token-text tok) '())) (define (dlang/literal in) (define tok (buf-lookahead! in 1)) - (if (or (equal? 'id tok) - (equal? 'character tok) - (equal? 'string tok) - (equal? 'symbol tok) - (equal? 'number tok)) + (define type (if (eof-object? tok) '() (token-type tok))) + (if (or (equal? 'id type) + (equal? 'character type) + (equal? 'string type) + (equal? 'symbol type) + (equal? 'number type)) (set! tok (buf-consume! in)) (error "Expected a literal")) (syntree (token-type tok) (token-text tok) '())) diff --git a/tests/test_parser.scm b/tests/test_parser.scm index 7362bf4..64083dc 100644 --- a/tests/test_parser.scm +++ b/tests/test_parser.scm @@ -1,3 +1,105 @@ (include "test.scm") -(declare (unit test_parser)) +(declare (unit test_parser) + (uses parser lexer buf)) + +; Helper functions +;------------------------------------------------------------------------------ +(define (make-lexer input) + (buf (buf input read-char) dlang/tokenize)) + +; dlang/operator-app +;------------------------------------------------------------------------------ + +; dlang/operator +;------------------------------------------------------------------------------ +(def-test "dlang/operator should parse an Id" + (call-with-input-string "abc" + (lambda (input) + (define lxr (make-lexer input)) + (define result (dlang/operator lxr)) + (and (syntree? result) + (equal? 'id (syntree-type result)) + (equal? "abc" (syntree-text result)) + (equal? '() (syntree-children result)))))) + +(def-test "dlang/operator should error if not an Id" + (call-with-input-string "1.0" + (lambda (input) + (define lxr (make-lexer input)) + (check-error "Expected a token of type 'id, received 'number instead" + (dlang/operator lxr))))) + +(def-test "dlang/operator should error if EOF" + (call-with-input-string "" + (lambda (input) + (define lxr (make-lexer input)) + (check-error "Expected a token of type 'id, received EOF instead" + (dlang/operator lxr))))) + +; dlang/literal +;------------------------------------------------------------------------------ +(def-test "dlang/literal should parse an Id" + (call-with-input-string "abc" + (lambda (input) + (define lxr (make-lexer input)) + (define result (dlang/literal lxr)) + (and (syntree? result) + (equal? 'id (syntree-type result)) + (equal? "abc" (syntree-text result)) + (equal? '() (syntree-children result)) + (eof-object? (buf-lookahead! lxr 1)))))) + +(def-test "dlang/literal should parse a Character" + (call-with-input-string "'a'" + (lambda (input) + (define lxr (make-lexer input)) + (define result (dlang/literal lxr)) + (and (syntree? result) + (equal? 'character (syntree-type result)) + (equal? "'a'" (syntree-text result)) + (equal? '() (syntree-children result)))))) + +(def-test "dlang/literal should parse a String" + (call-with-input-string "\"abc\"" + (lambda (input) + (define lxr (make-lexer input)) + (define result (dlang/literal lxr)) + (and (syntree? result) + (equal? 'string (syntree-type result)) + (equal? "\"abc\"" (syntree-text result)) + (equal? '() (syntree-children result)))))) + +(def-test "dlang/literal should parse a Symbol" + (call-with-input-string "$abc" + (lambda (input) + (define lxr (make-lexer input)) + (define result (dlang/literal lxr)) + (and (syntree? result) + (equal? 'symbol (syntree-type result)) + (equal? "$abc" (syntree-text result)) + (equal? '() (syntree-children result)))))) + +(def-test "dlang/literal should parse a Number" + (call-with-input-string "1.0" + (lambda (input) + (define lxr (make-lexer input)) + (define result (dlang/literal lxr)) + (and (syntree? result) + (equal? 'number (syntree-type result)) + (equal? "1.0" (syntree-text result)) + (equal? '() (syntree-children result)))))) + +(def-test "dlang/literal should error when no literal found" + (call-with-input-string "(" + (lambda (input) + (define lxr (make-lexer input)) + (check-error "Expected a literal" + (dlang/literal lxr))))) + +(def-test "dlang/literal should error when EOF" + (call-with-input-string "" + (lambda (input) + (define lxr (make-lexer input)) + (check-error "Expected a literal" + (dlang/literal lxr))))) -- 2.52.0