From: Mike D. Lowis Date: Fri, 28 Sep 2012 19:50:07 +0000 (-0400) Subject: Fixed all unit tests X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=070cd7e2dec2e8f818b1ec0043fa50509f4dbefc;p=archive%2Fdlang-scm.git Fixed all unit tests --- diff --git a/source/lexer.scm b/source/lexer.scm index 1fc8169..bcdf7d5 100644 --- a/source/lexer.scm +++ b/source/lexer.scm @@ -15,37 +15,37 @@ ((eof-object? ch) ch) ; Whitespace - ((char-whitespace? ch) + ((dlang/whitespace? in) (dlang/whitespace in)) ; Comment - ((char=? ch #\#) + ((char=? (charobj-char ch) #\#) (dlang/comment in)) ; Number ((or - (and (char=? ch #\-) (char-numeric? (buf-lookahead! in 2))) - (char-numeric? ch)) + (and (char=? (charobj-char ch) #\-) (dlang/integer? (buf-lookahead! in 2))) + (char-numeric? (charobj-char ch))) (dlang/number in)) ; Character - ((char=? ch #\') (dlang/character in)) + ((char=? (charobj-char ch) #\') (dlang/character in)) ; String - ((char=? ch #\") (dlang/string in)) + ((char=? (charobj-char ch) #\") (dlang/string in)) ; Symbol - ((char=? ch #\$) (dlang/symbol in)) + ((char=? (charobj-char ch) #\$) (dlang/symbol in)) ; Punctuation and Parens - ((char=? ch #\() - (token 'lpar (string (buf-consume! in)) location)) - ((char=? ch #\)) - (token 'rpar (string (buf-consume! in)) location)) - ((char=? ch #\,) - (token 'comma (string (buf-consume! in)) location)) - ((char=? ch #\;) - (token 'term (string (buf-consume! in)) location)) + ((char=? (charobj-char ch) #\() + (token 'lpar (string (charobj-char (buf-consume! in))) location)) + ((char=? (charobj-char ch) #\)) + (token 'rpar (string (charobj-char (buf-consume! in))) location)) + ((char=? (charobj-char ch) #\,) + (token 'comma (string (charobj-char (buf-consume! in))) location)) + ((char=? (charobj-char ch) #\;) + (token 'term (string (charobj-char (buf-consume! in))) location)) ; Id (else @@ -60,7 +60,8 @@ (dlang/tokenize in)) (define (dlang/whitespace? in) - (char-whitespace? (buf-lookahead! in 1))) + (and (not (eof-object? (buf-lookahead! in 1))) + (char-whitespace? (charobj-char (buf-lookahead! in 1))))) (define (dlang/comment in) (char-match in #\#) @@ -68,20 +69,23 @@ (dlang/tokenize in)) (define (dlang/comment? in) - (and (not (char=? (buf-lookahead! in 1) #\newline)) - (not (eof-object? (buf-lookahead! in 1))))) + (and (not (eof-object? (buf-lookahead! in 1))) + (not (char=? (charobj-char (buf-lookahead! in 1)) #\newline)))) (define (dlang/number in) (define location (buf-posdata in)) (token 'number (string-append - (if (char=? #\- (buf-lookahead! in 1)) - (string (buf-consume! in)) "") + (if (and (not (eof-object? (buf-lookahead! in 1))) + (char=? #\- (charobj-char (buf-lookahead! in 1)))) + (string (charobj-char (buf-consume! in))) "") (dlang/integer in) - (if (char=? (buf-lookahead! in 1) #\.) + (if (and (not (eof-object? (buf-lookahead! in 1))) + (char=? (charobj-char (buf-lookahead! in 1)) #\.)) (dlang/decimal in) "") - (if (or (char=? (buf-lookahead! in 1) #\e) - (char=? (buf-lookahead! in 1) #\E)) + (if (and (not (eof-object? (buf-lookahead! in 1))) + (or (char=? (charobj-char (buf-lookahead! in 1)) #\e) + (char=? (charobj-char (buf-lookahead! in 1)) #\E))) (dlang/exponent in) "")) location)) @@ -102,10 +106,13 @@ (define (dlang/exponent in) (string-append (string - (if (char=? (buf-lookahead! in 1) #\e) - (char-match in #\e) (char-match in #\E))) - (if (char=? #\- (buf-lookahead! in 1)) - (string (buf-consume! in)) "") + (if (and (not (eof-object? (buf-lookahead! in 1))) + (char=? #\e (charobj-char (buf-lookahead! in 1)))) + (char-match in #\e) + (char-match in #\E))) + (if (and (not (eof-object? (buf-lookahead! in 1))) + (char=? #\- (charobj-char (buf-lookahead! in 1)))) + (string (charobj-char (buf-consume! in))) "") (dlang/integer in))) (define (dlang/character in) @@ -115,7 +122,7 @@ (string (char-match in #\')) (if (eof-object? (buf-lookahead! in 1)) (abort "Unexpected EOF while parsing character literal") - (string (buf-consume! in))) + (string (charobj-char (buf-consume! in)))) (string (char-match in #\'))) location)) @@ -131,8 +138,8 @@ (define (dlang/string-char? in) (define ch (buf-lookahead! in 1)) (and (not (eof-object? ch)) - (not (char=? #\newline ch)) - (not (char=? #\" ch)))) + (not (char=? #\newline (charobj-char ch))) + (not (char=? #\" (charobj-char ch))))) (define (dlang/symbol in) (define location (buf-posdata in)) @@ -144,7 +151,7 @@ (define (dlang/id in) (define location (buf-posdata in)) - (define str(collect-char in dlang/id-char?)) + (define str (collect-char in dlang/id-char?)) (if (> (string-length str) 0) (token 'id str location) (abort "An Id was expected but none found."))) @@ -152,8 +159,8 @@ (define (dlang/id-char? in) (define ch (buf-lookahead! in 1)) (and (not (eof-object? ch)) - (not (char-whitespace? ch)) - (case ch + (not (char-whitespace? (charobj-char ch))) + (case (charobj-char ch) ((#\( #\) #\; #\, #\' #\" #\$ #\#) #f) (else #t)))) diff --git a/source/parse-utils.scm b/source/parse-utils.scm index 48768d9..2df1d03 100644 --- a/source/parse-utils.scm +++ b/source/parse-utils.scm @@ -73,13 +73,13 @@ (if (eof-object? actual) (abort (string-append "Expected '" (string expect) "', received EOF instead")) - (if (equal? expect actual) + (if (equal? expect (charobj-char actual)) (buf-consume! buf) (abort (string-append "Expected '" (string expect) - "', received '" (string actual) "' instead")))) - actual) + "', received '" (string (charobj-char actual)) "' instead")))) + (charobj-char actual)) (define (token-match buf expect) (define actual (buf-lookahead! buf 1)) diff --git a/tests/test_lexer.scm b/tests/test_lexer.scm index 3c9702e..5c11374 100644 --- a/tests/test_lexer.scm +++ b/tests/test_lexer.scm @@ -146,8 +146,7 @@ (define buffer (dlang/char-buf input)) (define result (dlang/whitespace buffer)) (token=? result - (token 'id "foo" (posdata "(string)" 2 2))) - ))) + (token 'id "foo" (posdata "(string)" 2 2)))))) ; dlang/comment ;------------------------------------------------------------------------------ diff --git a/tests/test_parse_utils.scm b/tests/test_parse_utils.scm index 408ebbe..4a70eba 100644 --- a/tests/test_parse_utils.scm +++ b/tests/test_parse_utils.scm @@ -214,21 +214,21 @@ (def-test "char-match should consume and return char if the next char matches" (call-with-input-string "a" (lambda (input) - (define buffer (buf input read-char)) + (define buffer (buf (charport input) charport-read)) (and (equal? #\a (char-match buffer #\a)) (eof-object? (buf-lookahead! buffer 1)))))) (def-test "char-match should error when EOF" (call-with-input-string "" (lambda (input) - (define buffer (buf input read-char)) + (define buffer (buf (charport input) charport-read)) (check-exception "Expected 'a', received EOF instead" (char-match buffer #\a))))) (def-test "char-match should error when chars do not match" (call-with-input-string "b" (lambda (input) - (define buffer (buf input read-char)) + (define buffer (buf (charport input) charport-read)) (check-exception "Expected 'a', received 'b' instead" (char-match buffer #\a))))) diff --git a/tests/test_parser.scm b/tests/test_parser.scm index 1d9ab36..d1a97ac 100644 --- a/tests/test_parser.scm +++ b/tests/test_parser.scm @@ -2,713 +2,713 @@ (declare (unit test_parser) (uses parser lexer buf)) -;; dlang/program -;;------------------------------------------------------------------------------ -;(def-test "dlang/program should parse an empty program" -; (call-with-input-string "" -; (lambda (input) -; (define lxr (dlang/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 (dlang/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 (dlang/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 (dlang/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 (dlang/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 (dlang/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 -;;------------------------------------------------------------------------------ -;(def-test "dlang/define should parse a variable definition" -; (call-with-input-string "def foo 1.0;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/core-form lxr)) -; (syntree=? result -; (syntree 'define "" -; (list -; (syntree 'id "foo" '()) -; (syntree 'number "1.0" '()))))))) -; -;(def-test "dlang/core-form should parse a variable assignment" -; (call-with-input-string "set! foo 1.0;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/core-form lxr)) -; (syntree=? result -; (syntree 'assign "" -; (list -; (syntree 'id "foo" '()) -; (syntree 'number "1.0" '()))))))) -; -;(def-test "dlang/core-form should parse an if statement" -; (call-with-input-string "if cond result1;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/core-form lxr)) -; (syntree=? result -; (syntree 'if "" -; (list -; (syntree 'id "cond" '()) -; (syntree 'id "result1" '()))))))) -; -;(def-test "dlang/core-form should parse a begin block" -; (call-with-input-string "begin;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/core-form lxr)) -; (syntree=? result -; (syntree 'begin "" '()))))) -; -;(def-test "dlang/core-form should parse a func" -; (call-with-input-string "func();" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/core-form lxr)) -; (syntree=? result -; (syntree 'func "" -; (list -; (syntree 'args "" '()) -; (syntree 'block "" '()))))))) -; -;; dlang/core-form? -;;------------------------------------------------------------------------------ -;(def-test "dlang/core-form? should recognize def as a core form" -; (call-with-input-string "def" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (equal? #t (dlang/core-form? lxr))))) -; -;(def-test "dlang/core-form? should recognize set! as a core form" -; (call-with-input-string "set!" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (equal? #t (dlang/core-form? lxr))))) -; -;(def-test "dlang/core-form? should recognize def as a core form" -; (call-with-input-string "if" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (equal? #t (dlang/core-form? lxr))))) -; -;(def-test "dlang/core-form? should recognize def as a core form" -; (call-with-input-string "begin" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (equal? #t (dlang/core-form? lxr))))) -; -;(def-test "dlang/core-form? should recognize def as a core form" -; (call-with-input-string "func" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (equal? #t (dlang/core-form? lxr))))) -; -;(def-test "dlang/core-form? should return false for non-coreform" -; (call-with-input-string "foo" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (equal? #f (dlang/core-form? lxr))))) -; -;; dlang/define -;;------------------------------------------------------------------------------ -;(def-test "dlang/define should parse a variable definition" -; (call-with-input-string "def foo 1.0;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/define lxr)) -; (syntree=? result -; (syntree 'define "" -; (list -; (syntree 'id "foo" '()) -; (syntree 'number "1.0" '()))))))) -; -;(def-test "dlang/define should parse a function definition" -; (call-with-input-string "def foo() 1.0;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/define lxr)) -; (syntree=? result -; (syntree 'define "" -; (list (syntree 'id "foo" '()) -; (syntree 'func "" -; (list (syntree 'args "" '()) -; (syntree 'block "" -; (list (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 (dlang/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 (dlang/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" -; (call-with-input-string "set! foo 1.0;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/assign lxr)) -; (syntree=? result -; (syntree 'assign "" -; (list -; (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 (dlang/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 (dlang/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" -; (call-with-input-string "if cond result1;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/if lxr)) -; (syntree=? result -; (syntree 'if "" -; (list -; (syntree 'id "cond" '()) -; (syntree 'id "result1" '()))))))) -; -;(def-test "dlang/if should parse an if statement with two branches" -; (call-with-input-string "if cond result1 result2;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/if lxr)) -; (syntree=? result -; (syntree 'if "" -; (list -; (syntree 'id "cond" '()) -; (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 (dlang/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 (dlang/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 (dlang/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 (dlang/lexer input)) -; (check-exception "Expected a literal" -; (dlang/if lxr))))) -; -;; dlang/begin -;;------------------------------------------------------------------------------ -;(def-test "dlang/begin should parse a begin block with 0 expressions" -; (call-with-input-string "begin;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/begin lxr)) -; (syntree=? result -; (syntree 'begin "" '()))))) -; -;(def-test "dlang/begin should parse a begin block with 1 expression" -; (call-with-input-string "begin stm1;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/begin lxr)) -; (syntree=? result -; (syntree 'begin "" -; (list -; (syntree 'id "stm1" '()))))))) -; -;(def-test "dlang/begin should parse a begin block with 2 expressions" -; (call-with-input-string "begin stm1 stm2;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/begin lxr)) -; (syntree=? result -; (syntree 'begin "" -; (list -; (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 (dlang/lexer input)) -; (check-exception "Expected a literal" -; (dlang/begin lxr))))) -; -;; dlang/func -;;------------------------------------------------------------------------------ -;(def-test "dlang/func should parse an empty func" -; (call-with-input-string "func();" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/func lxr)) -; (syntree=? result -; (syntree 'func "" -; (list -; (syntree 'args "" '()) -; (syntree 'block "" '()))))))) -; -;(def-test "dlang/func should parse a func with one statement in the body" -; (call-with-input-string "func() stm1;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/func lxr)) -; (syntree=? result -; (syntree 'func "" -; (list -; (syntree 'args "" '()) -; (syntree 'block "" -; (list -; (syntree 'id "stm1" '()))))))))) -; -;(def-test "dlang/func should parse a func with two statements in the body" -; (call-with-input-string "func() stm1 stm2;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/func lxr)) -; (syntree=? result -; (syntree 'func "" -; (list -; (syntree 'args "" '()) -; (syntree 'block "" -; (list -; (syntree 'id "stm1" '()) -; (syntree 'id "stm2" '()))))))))) -; -;(def-test "dlang/func should parse a func with one param" -; (call-with-input-string "func(a);" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/func lxr)) -; (syntree=? result -; (syntree 'func "" -; (list -; (syntree 'args "" -; (list -; (syntree 'id "a" '()) -; )) -; (syntree 'block "" '()))))))) -; -;(def-test "dlang/func should parse a func with two params" -; (call-with-input-string "func(a,b);" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/func lxr)) -; (syntree=? result -; (syntree 'func "" -; (list -; (syntree 'args "" -; (list -; (syntree 'id "a" '()) -; (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 (dlang/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 (dlang/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 (dlang/lexer input)) -; (check-exception "Expected a literal" -; (dlang/func lxr))))) -; -;; dlang/basic-expr -;;------------------------------------------------------------------------------ -;(def-test "dlang/basic-expr should parse a literal" -; (call-with-input-string "abc" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/basic-expr lxr)) -; (syntree=? result (syntree 'id "abc" '()))))) -; -;(def-test "dlang/basic-expr should parse an infix operator application" -; (call-with-input-string "(1.0 * 2.0)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/basic-expr lxr)) -; (syntree=? result -; (syntree 'apply "" -; (list -; (syntree 'id "*" '()) -; (syntree 'number "1.0" '()) -; (syntree 'number "2.0" '()))))))) -; -;; dlang/operator-app -;;------------------------------------------------------------------------------ -;(def-test "dlang/operator-app should parse an infix operator application" -; (call-with-input-string "(1.0 * 2.0)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/operator-app lxr)) -; (syntree=? result -; (syntree 'apply "" -; (list -; (syntree 'id "*" '()) -; (syntree 'number "1.0" '()) -; (syntree 'number "2.0" '()))))))) -; -;(def-test "dlang/operator-app should error when first paren missing" -; (call-with-input-string "1.0 * 2.0)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception -; "Expected a token of type 'lpar, received 'number instead" -; (dlang/operator-app lxr))))) -; -;(def-test "dlang/operator-app should error when second paren missing" -; (call-with-input-string "(1.0 * 2.0" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a token of type 'rpar, received EOF instead" -; (dlang/operator-app lxr))))) -; -;(def-test "dlang/operator-app should error operator is not an id" -; (call-with-input-string "(1.0 2.0 3.0)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a token of type 'id, received 'number instead" -; (dlang/operator-app lxr))))) -; -;; dlang/operator -;;------------------------------------------------------------------------------ -;(def-test "dlang/operator should parse an Id" -; (call-with-input-string "abc" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/operator lxr)) -; (syntree=? result (syntree 'id "abc" '()))))) -; -;(def-test "dlang/operator should error if not an Id" -; (call-with-input-string "1.0" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "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 (dlang/lexer input)) -; (check-exception "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 (dlang/lexer input)) -; (define result (dlang/literal lxr)) -; (syntree=? result (syntree 'id "abc" '()))))) -; -;(def-test "dlang/literal should parse a Character" -; (call-with-input-string "'a'" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/literal lxr)) -; (syntree=? result (syntree 'character "'a'" '()))))) -; -;(def-test "dlang/literal should parse a String" -; (call-with-input-string "\"abc\"" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/literal lxr)) -; (syntree=? result (syntree 'string "\"abc\"" '()))))) -; -;(def-test "dlang/literal should parse a Symbol" -; (call-with-input-string "$abc" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/literal lxr)) -; (syntree=? result (syntree 'symbol "$abc" '()))))) -; -;(def-test "dlang/literal should parse a Number" -; (call-with-input-string "1.0" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/literal lxr)) -; (syntree=? result (syntree 'number "1.0" '()))))) -; -;(def-test "dlang/literal should error when no literal found" -; (call-with-input-string "(" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a literal" -; (dlang/literal lxr))))) -; -;(def-test "dlang/literal should error when EOF" -; (call-with-input-string "" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a literal" -; (dlang/literal lxr))))) -; -;; dlang/arg-list -;;------------------------------------------------------------------------------ -;(def-test "dlang/arg-list should recognize an empty id list" -; (call-with-input-string "()" -; (lambda (input) -; (define lxr (dlang/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 (dlang/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 (dlang/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 (dlang/lexer input)) -; (define result (dlang/arg-list lxr)) -; (syntree=? result -; (syntree 'arglist "" -; (list -; (syntree 'id "a" '()) -; (syntree 'number "1.0" '()) -; (syntree 'symbol "$c" '()))))))) -; -;(def-test "dlang/arg-list should error when first paren missing" -; (call-with-input-string ")" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a token of type 'lpar, received 'rpar instead" -; (dlang/arg-list lxr))))) -; -;(def-test "dlang/arg-list should error when second paren missing" -; (call-with-input-string "(" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a literal" -; (dlang/arg-list lxr))))) -; -;(def-test "dlang/arg-list should error when comma missing between args" -; (call-with-input-string "(a b)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a token of type 'comma, received 'id instead" -; (dlang/arg-list lxr))))) -; -;; 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 (dlang/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 (dlang/lexer input)) -; (equal? #f (dlang/arg-list? lxr))))) -; -;; dlang/id-list -;;------------------------------------------------------------------------------ -;(def-test "dlang/id-list should recognize an empty id list" -; (call-with-input-string "()" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/id-list lxr)) -; (syntree=? result (syntree 'args "" '()))))) -; -;(def-test "dlang/id-list should recognize an id list of length 1" -; (call-with-input-string "(a)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/id-list lxr)) -; (syntree=? result -; (syntree 'args "" -; (list (syntree 'id "a" '()))))))) -; -;(def-test "dlang/id-list should recognize an id list of length 2" -; (call-with-input-string "(a,b)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/id-list lxr)) -; (syntree=? result -; (syntree 'args "" -; (list -; (syntree 'id "a" '()) -; (syntree 'id "b" '()))))))) -; -;(def-test "dlang/id-list should recognize an id list of length 3" -; (call-with-input-string "(a,b,c)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/id-list lxr)) -; (syntree=? result -; (syntree 'args "" -; (list -; (syntree 'id "a" '()) -; (syntree 'id "b" '()) -; (syntree 'id "c" '()))))))) -; -;(def-test "dlang/id-list should error when non-id recieved" -; (call-with-input-string "(1.0)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a token of type 'id, received 'number instead" -; (dlang/id-list lxr))))) -; -;(def-test "dlang/id-list should error when no comma in between ids" -; (call-with-input-string "(a b)" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a token of type 'comma, received 'id instead" -; (dlang/id-list lxr))))) -; -;(def-test "dlang/id-list should error when left paren missing" -; (call-with-input-string ")" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a token of type 'lpar, received 'rpar instead" -; (dlang/id-list lxr))))) -; -;(def-test "dlang/id-list should error when right paren missing" -; (call-with-input-string "(" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a token of type 'id, received EOF instead" -; (dlang/id-list lxr))))) -; -;; dlang/expr-block -;;------------------------------------------------------------------------------ -;(def-test "dlang/expr-block should parse a block of 0 expressions" -; (call-with-input-string ";" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/expr-block lxr 'term)) -; (syntree=? result (syntree 'block "" '()))))) -; -;(def-test "dlang/expr-block should parse a block of 1 expression" -; (call-with-input-string "1.0;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/expr-block lxr 'term)) -; (syntree=? result -; (syntree 'block "" -; (list -; (syntree 'number "1.0" '()))))))) -; -;(def-test "dlang/expr-block should parse a block of 2 expressions" -; (call-with-input-string "1.0 2.0;" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (define result (dlang/expr-block lxr 'term)) -; (syntree=? result -; (syntree 'block "" -; (list -; (syntree 'number "1.0" '()) -; (syntree 'number "2.0" '()))))))) -; -;(def-test "dlang/expr-block should error when no terminator found" -; (call-with-input-string "1.0 2.0" -; (lambda (input) -; (define lxr (dlang/lexer input)) -; (check-exception "Expected a literal" -; (dlang/expr-block lxr 'term))))) -; +; dlang/program +;------------------------------------------------------------------------------ +(def-test "dlang/program should parse an empty program" + (call-with-input-string "" + (lambda (input) + (define lxr (dlang/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 (dlang/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 (dlang/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 (dlang/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 (dlang/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 (dlang/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 +;------------------------------------------------------------------------------ +(def-test "dlang/define should parse a variable definition" + (call-with-input-string "def foo 1.0;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/core-form lxr)) + (syntree=? result + (syntree 'define "" + (list + (syntree 'id "foo" '()) + (syntree 'number "1.0" '()))))))) + +(def-test "dlang/core-form should parse a variable assignment" + (call-with-input-string "set! foo 1.0;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/core-form lxr)) + (syntree=? result + (syntree 'assign "" + (list + (syntree 'id "foo" '()) + (syntree 'number "1.0" '()))))))) + +(def-test "dlang/core-form should parse an if statement" + (call-with-input-string "if cond result1;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/core-form lxr)) + (syntree=? result + (syntree 'if "" + (list + (syntree 'id "cond" '()) + (syntree 'id "result1" '()))))))) + +(def-test "dlang/core-form should parse a begin block" + (call-with-input-string "begin;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/core-form lxr)) + (syntree=? result + (syntree 'begin "" '()))))) + +(def-test "dlang/core-form should parse a func" + (call-with-input-string "func();" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/core-form lxr)) + (syntree=? result + (syntree 'func "" + (list + (syntree 'args "" '()) + (syntree 'block "" '()))))))) + +; dlang/core-form? +;------------------------------------------------------------------------------ +(def-test "dlang/core-form? should recognize def as a core form" + (call-with-input-string "def" + (lambda (input) + (define lxr (dlang/lexer input)) + (equal? #t (dlang/core-form? lxr))))) + +(def-test "dlang/core-form? should recognize set! as a core form" + (call-with-input-string "set!" + (lambda (input) + (define lxr (dlang/lexer input)) + (equal? #t (dlang/core-form? lxr))))) + +(def-test "dlang/core-form? should recognize def as a core form" + (call-with-input-string "if" + (lambda (input) + (define lxr (dlang/lexer input)) + (equal? #t (dlang/core-form? lxr))))) + +(def-test "dlang/core-form? should recognize def as a core form" + (call-with-input-string "begin" + (lambda (input) + (define lxr (dlang/lexer input)) + (equal? #t (dlang/core-form? lxr))))) + +(def-test "dlang/core-form? should recognize def as a core form" + (call-with-input-string "func" + (lambda (input) + (define lxr (dlang/lexer input)) + (equal? #t (dlang/core-form? lxr))))) + +(def-test "dlang/core-form? should return false for non-coreform" + (call-with-input-string "foo" + (lambda (input) + (define lxr (dlang/lexer input)) + (equal? #f (dlang/core-form? lxr))))) + +; dlang/define +;------------------------------------------------------------------------------ +(def-test "dlang/define should parse a variable definition" + (call-with-input-string "def foo 1.0;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/define lxr)) + (syntree=? result + (syntree 'define "" + (list + (syntree 'id "foo" '()) + (syntree 'number "1.0" '()))))))) + +(def-test "dlang/define should parse a function definition" + (call-with-input-string "def foo() 1.0;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/define lxr)) + (syntree=? result + (syntree 'define "" + (list (syntree 'id "foo" '()) + (syntree 'func "" + (list (syntree 'args "" '()) + (syntree 'block "" + (list (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 (dlang/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 (dlang/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" + (call-with-input-string "set! foo 1.0;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/assign lxr)) + (syntree=? result + (syntree 'assign "" + (list + (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 (dlang/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 (dlang/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" + (call-with-input-string "if cond result1;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/if lxr)) + (syntree=? result + (syntree 'if "" + (list + (syntree 'id "cond" '()) + (syntree 'id "result1" '()))))))) + +(def-test "dlang/if should parse an if statement with two branches" + (call-with-input-string "if cond result1 result2;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/if lxr)) + (syntree=? result + (syntree 'if "" + (list + (syntree 'id "cond" '()) + (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 (dlang/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 (dlang/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 (dlang/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 (dlang/lexer input)) + (check-exception "Expected a literal" + (dlang/if lxr))))) + +; dlang/begin +;------------------------------------------------------------------------------ +(def-test "dlang/begin should parse a begin block with 0 expressions" + (call-with-input-string "begin;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/begin lxr)) + (syntree=? result + (syntree 'begin "" '()))))) + +(def-test "dlang/begin should parse a begin block with 1 expression" + (call-with-input-string "begin stm1;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/begin lxr)) + (syntree=? result + (syntree 'begin "" + (list + (syntree 'id "stm1" '()))))))) + +(def-test "dlang/begin should parse a begin block with 2 expressions" + (call-with-input-string "begin stm1 stm2;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/begin lxr)) + (syntree=? result + (syntree 'begin "" + (list + (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 (dlang/lexer input)) + (check-exception "Expected a literal" + (dlang/begin lxr))))) + +; dlang/func +;------------------------------------------------------------------------------ +(def-test "dlang/func should parse an empty func" + (call-with-input-string "func();" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/func lxr)) + (syntree=? result + (syntree 'func "" + (list + (syntree 'args "" '()) + (syntree 'block "" '()))))))) + +(def-test "dlang/func should parse a func with one statement in the body" + (call-with-input-string "func() stm1;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/func lxr)) + (syntree=? result + (syntree 'func "" + (list + (syntree 'args "" '()) + (syntree 'block "" + (list + (syntree 'id "stm1" '()))))))))) + +(def-test "dlang/func should parse a func with two statements in the body" + (call-with-input-string "func() stm1 stm2;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/func lxr)) + (syntree=? result + (syntree 'func "" + (list + (syntree 'args "" '()) + (syntree 'block "" + (list + (syntree 'id "stm1" '()) + (syntree 'id "stm2" '()))))))))) + +(def-test "dlang/func should parse a func with one param" + (call-with-input-string "func(a);" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/func lxr)) + (syntree=? result + (syntree 'func "" + (list + (syntree 'args "" + (list + (syntree 'id "a" '()) + )) + (syntree 'block "" '()))))))) + +(def-test "dlang/func should parse a func with two params" + (call-with-input-string "func(a,b);" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/func lxr)) + (syntree=? result + (syntree 'func "" + (list + (syntree 'args "" + (list + (syntree 'id "a" '()) + (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 (dlang/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 (dlang/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 (dlang/lexer input)) + (check-exception "Expected a literal" + (dlang/func lxr))))) + +; dlang/basic-expr +;------------------------------------------------------------------------------ +(def-test "dlang/basic-expr should parse a literal" + (call-with-input-string "abc" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/basic-expr lxr)) + (syntree=? result (syntree 'id "abc" '()))))) + +(def-test "dlang/basic-expr should parse an infix operator application" + (call-with-input-string "(1.0 * 2.0)" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/basic-expr lxr)) + (syntree=? result + (syntree 'apply "" + (list + (syntree 'id "*" '()) + (syntree 'number "1.0" '()) + (syntree 'number "2.0" '()))))))) + +; dlang/operator-app +;------------------------------------------------------------------------------ +(def-test "dlang/operator-app should parse an infix operator application" + (call-with-input-string "(1.0 * 2.0)" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/operator-app lxr)) + (syntree=? result + (syntree 'apply "" + (list + (syntree 'id "*" '()) + (syntree 'number "1.0" '()) + (syntree 'number "2.0" '()))))))) + +(def-test "dlang/operator-app should error when first paren missing" + (call-with-input-string "1.0 * 2.0)" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception + "Expected a token of type 'lpar, received 'number instead" + (dlang/operator-app lxr))))) + +(def-test "dlang/operator-app should error when second paren missing" + (call-with-input-string "(1.0 * 2.0" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a token of type 'rpar, received EOF instead" + (dlang/operator-app lxr))))) + +(def-test "dlang/operator-app should error operator is not an id" + (call-with-input-string "(1.0 2.0 3.0)" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a token of type 'id, received 'number instead" + (dlang/operator-app lxr))))) + +; dlang/operator +;------------------------------------------------------------------------------ +(def-test "dlang/operator should parse an Id" + (call-with-input-string "abc" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/operator lxr)) + (syntree=? result (syntree 'id "abc" '()))))) + +(def-test "dlang/operator should error if not an Id" + (call-with-input-string "1.0" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "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 (dlang/lexer input)) + (check-exception "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 (dlang/lexer input)) + (define result (dlang/literal lxr)) + (syntree=? result (syntree 'id "abc" '()))))) + +(def-test "dlang/literal should parse a Character" + (call-with-input-string "'a'" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/literal lxr)) + (syntree=? result (syntree 'character "'a'" '()))))) + +(def-test "dlang/literal should parse a String" + (call-with-input-string "\"abc\"" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/literal lxr)) + (syntree=? result (syntree 'string "\"abc\"" '()))))) + +(def-test "dlang/literal should parse a Symbol" + (call-with-input-string "$abc" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/literal lxr)) + (syntree=? result (syntree 'symbol "$abc" '()))))) + +(def-test "dlang/literal should parse a Number" + (call-with-input-string "1.0" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/literal lxr)) + (syntree=? result (syntree 'number "1.0" '()))))) + +(def-test "dlang/literal should error when no literal found" + (call-with-input-string "(" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a literal" + (dlang/literal lxr))))) + +(def-test "dlang/literal should error when EOF" + (call-with-input-string "" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a literal" + (dlang/literal lxr))))) + +; dlang/arg-list +;------------------------------------------------------------------------------ +(def-test "dlang/arg-list should recognize an empty id list" + (call-with-input-string "()" + (lambda (input) + (define lxr (dlang/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 (dlang/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 (dlang/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 (dlang/lexer input)) + (define result (dlang/arg-list lxr)) + (syntree=? result + (syntree 'arglist "" + (list + (syntree 'id "a" '()) + (syntree 'number "1.0" '()) + (syntree 'symbol "$c" '()))))))) + +(def-test "dlang/arg-list should error when first paren missing" + (call-with-input-string ")" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a token of type 'lpar, received 'rpar instead" + (dlang/arg-list lxr))))) + +(def-test "dlang/arg-list should error when second paren missing" + (call-with-input-string "(" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a literal" + (dlang/arg-list lxr))))) + +(def-test "dlang/arg-list should error when comma missing between args" + (call-with-input-string "(a b)" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a token of type 'comma, received 'id instead" + (dlang/arg-list lxr))))) + +; 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 (dlang/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 (dlang/lexer input)) + (equal? #f (dlang/arg-list? lxr))))) + +; dlang/id-list +;------------------------------------------------------------------------------ +(def-test "dlang/id-list should recognize an empty id list" + (call-with-input-string "()" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/id-list lxr)) + (syntree=? result (syntree 'args "" '()))))) + +(def-test "dlang/id-list should recognize an id list of length 1" + (call-with-input-string "(a)" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/id-list lxr)) + (syntree=? result + (syntree 'args "" + (list (syntree 'id "a" '()))))))) + +(def-test "dlang/id-list should recognize an id list of length 2" + (call-with-input-string "(a,b)" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/id-list lxr)) + (syntree=? result + (syntree 'args "" + (list + (syntree 'id "a" '()) + (syntree 'id "b" '()))))))) + +(def-test "dlang/id-list should recognize an id list of length 3" + (call-with-input-string "(a,b,c)" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/id-list lxr)) + (syntree=? result + (syntree 'args "" + (list + (syntree 'id "a" '()) + (syntree 'id "b" '()) + (syntree 'id "c" '()))))))) + +(def-test "dlang/id-list should error when non-id recieved" + (call-with-input-string "(1.0)" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a token of type 'id, received 'number instead" + (dlang/id-list lxr))))) + +(def-test "dlang/id-list should error when no comma in between ids" + (call-with-input-string "(a b)" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a token of type 'comma, received 'id instead" + (dlang/id-list lxr))))) + +(def-test "dlang/id-list should error when left paren missing" + (call-with-input-string ")" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a token of type 'lpar, received 'rpar instead" + (dlang/id-list lxr))))) + +(def-test "dlang/id-list should error when right paren missing" + (call-with-input-string "(" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a token of type 'id, received EOF instead" + (dlang/id-list lxr))))) + +; dlang/expr-block +;------------------------------------------------------------------------------ +(def-test "dlang/expr-block should parse a block of 0 expressions" + (call-with-input-string ";" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/expr-block lxr 'term)) + (syntree=? result (syntree 'block "" '()))))) + +(def-test "dlang/expr-block should parse a block of 1 expression" + (call-with-input-string "1.0;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/expr-block lxr 'term)) + (syntree=? result + (syntree 'block "" + (list + (syntree 'number "1.0" '()))))))) + +(def-test "dlang/expr-block should parse a block of 2 expressions" + (call-with-input-string "1.0 2.0;" + (lambda (input) + (define lxr (dlang/lexer input)) + (define result (dlang/expr-block lxr 'term)) + (syntree=? result + (syntree 'block "" + (list + (syntree 'number "1.0" '()) + (syntree 'number "2.0" '()))))))) + +(def-test "dlang/expr-block should error when no terminator found" + (call-with-input-string "1.0 2.0" + (lambda (input) + (define lxr (dlang/lexer input)) + (check-exception "Expected a literal" + (dlang/expr-block lxr 'term))))) +