From: Michael D. Lowis Date: Tue, 10 Jul 2012 04:49:10 +0000 (-0400) Subject: Added more unit tests for lexer X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=9587d76f34854d1dceff00a5af097a3c1e22bc56;p=archive%2Fdlang-scm.git Added more unit tests for lexer --- diff --git a/Makefile b/Makefile index f39e95a..baaeb2d 100644 --- a/Makefile +++ b/Makefile @@ -37,7 +37,7 @@ TEST_OBJS = $(TEST_FILES:%.$(TEST_EXT)=%.o) # Include Directories SRC_INCS = -I inc -TEST_INCS = -I inc +TEST_INCS = -I inc -w # Compiler and Linker Options #---------------------------- diff --git a/inc/test.scm b/inc/test.scm index 48bb5be..3ae1011 100644 --- a/inc/test.scm +++ b/inc/test.scm @@ -6,3 +6,16 @@ (cons desc (lambda () body ...)))))) +(define-syntax check-error + (syntax-rules () + ((_ expect expr) + (let ((prev error)) + (define result + (call/cc + (lambda (err) + (set! error err) + expr))) + (set! error prev) + (equal? expect result))))) + + diff --git a/source/lexer.scm b/source/lexer.scm index 685490e..fda961b 100644 --- a/source/lexer.scm +++ b/source/lexer.scm @@ -63,10 +63,12 @@ (define (dlang/integer in) (define text "") - (if (char-numeric? (buf-lookahead! in 1)) + (if (and + (not (eof-object? (buf-lookahead! in 1))) + (char-numeric? (buf-lookahead! in 1))) (while (char-numeric? (buf-lookahead! in 1)) (set! text (string-append text (string (buf-consume! in))))) - (error "Expected a number.")) + (error "Expected an integer")) text) (define (dlang/decimal in) @@ -80,24 +82,24 @@ (match in #\e) (match in #\E)) (dlang/integer in ""))) -(define (dlang/character in str) +(define (dlang/character in) (token 'character (string-append (string (match in #\')) (string (buf-consume! in)) (string (match in #\')) ))) -(define (dlang/string in str) +(define (dlang/string in) (token 'string (string-append (string (match in #\")) (accumulate-till in string-append "" #\") (string (match in #\")) ))) -(define (dlang/symbol in str) +(define (dlang/symbol in) (token 'symbol (string-append - (match in #\$) + (string (char-match in #\$)) (token-text (dlang/id in))))) (define (dlang/id in) diff --git a/source/parse-utils.scm b/source/parse-utils.scm index 3f1bcf7..fc007c3 100644 --- a/source/parse-utils.scm +++ b/source/parse-utils.scm @@ -8,11 +8,13 @@ (define (char-match buf expect) (define actual (buf-lookahead! buf 1)) - (if (equal? expect actual) - (buf-consume! buf) - (error - (string-append - "Expected '" expect "', received '" actual "' instead."))) + (if (eof-object? actual) + (error (string-append "Expected '" (string expect) "', received EOF instead")) + (if (equal? expect actual) + (buf-consume! buf) + (error + (string-append + "Expected '" (string expect) "', received '" (string actual) "' instead")))) actual) (define (token-match buf expect) @@ -21,6 +23,6 @@ (buf-consume! buf) (error (string-append - "Expected a " expect ", received a " actual " instead."))) + "Expected a " expect ", received a " actual " instead"))) actual) diff --git a/tests/test.scm b/tests/test.scm index 8eb1430..8d1da87 100644 --- a/tests/test.scm +++ b/tests/test.scm @@ -6,7 +6,7 @@ (define (register-test! test) (set! unit-tests (append unit-tests (list test)))) -(define (error msg) msg) +;(define (error msg) msg) (define (print-summary pass fail) (if (zero? fail) diff --git a/tests/test_lexer.scm b/tests/test_lexer.scm index 0482f8d..c0c1c76 100644 --- a/tests/test_lexer.scm +++ b/tests/test_lexer.scm @@ -16,6 +16,43 @@ ; dlang/integer ;------------------------------------------------------------------------------ +(def-test "dlang/integer should recognize an integer of length one" + (call-with-input-string "0" + (lambda (input) + (define buffer (buf input read-char)) + (define result (dlang/integer buffer)) + (and (string? result) + (equal? "0" result))))) + +(def-test "dlang/integer should recognize an integer of length two" + (call-with-input-string "01" + (lambda (input) + (define buffer (buf input read-char)) + (define result (dlang/integer buffer)) + (and (string? result) + (equal? "01" result))))) + +(def-test "dlang/integer should recognize an integer of length three" + (call-with-input-string "012" + (lambda (input) + (define buffer (buf input read-char)) + (define result (dlang/integer buffer)) + (and (string? result) + (equal? "012" result))))) + +(def-test "dlang/integer should error when no integer in input" + (call-with-input-string "abc" + (lambda (input) + (define buffer (buf input read-char)) + (check-error "Expected an integer" + (dlang/integer buffer))))) + +(def-test "dlang/integer should error when EOF" + (call-with-input-string "abc" + (lambda (input) + (define buffer (buf input read-char)) + (check-error "Expected an integer" + (dlang/integer buffer))))) ; dlang/decimal ;------------------------------------------------------------------------------ @@ -31,33 +68,64 @@ ; dlang/symbol ;------------------------------------------------------------------------------ -(def-test "dlang/symbol should error when no name given for a symbol" - (call-with-input-string "$" - (lambda (input) '()))) - -(def-test "dlang/symbol should error when not a symbol" - (call-with-input-string "abc" - (lambda (input) '()))) - (def-test "dlang/symbol should recognize a symbol of length one" (call-with-input-string "$a" - (lambda (input) '()))) + (lambda (input) + (define buffer (buf input read-char)) + (define result (dlang/symbol buffer)) + (and (token? result) + (equal? 'symbol (token-type result)) + (equal? "$a" (token-text result)))))) (def-test "dlang/symbol should recognize a symbol of length two" (call-with-input-string "$ab" - (lambda (input) '()))) + (lambda (input) + (define buffer (buf input read-char)) + (define result (dlang/symbol buffer)) + (and (token? result) + (equal? 'symbol (token-type result)) + (equal? "$ab" (token-text result)))))) (def-test "dlang/symbol should recognize a symbol of length three" (call-with-input-string "$abc" - (lambda (input) '()))) + (lambda (input) + (define buffer (buf input read-char)) + (define result (dlang/symbol buffer)) + (and (token? result) + (equal? 'symbol (token-type result)) + (equal? "$abc" (token-text result)))))) (def-test "dlang/symbol should stop recognition on EOF" (call-with-input-string "$abc" - (lambda (input) '()))) + (lambda (input) + (define buffer (buf input read-char)) + (define result (dlang/symbol buffer)) + (and (token? result) + (equal? 'symbol (token-type result)) + (equal? "$abc" (token-text result)))))) (def-test "dlang/symbol should stop recognition on whitespace" (call-with-input-string "$abc " - (lambda (input) '()))) + (lambda (input) + (define buffer (buf input read-char)) + (define result (dlang/symbol buffer)) + (and (token? result) + (equal? 'symbol (token-type result)) + (equal? "$abc" (token-text result)))))) + +(def-test "dlang/symbol should error when no name given for a symbol" + (call-with-input-string "$" + (lambda (input) + (define buffer (buf input read-char)) + (check-error "An Id was expected but none found." + (dlang/symbol buffer))))) + +(def-test "dlang/symbol should error when EOF" + (call-with-input-string "" + (lambda (input) + (define buffer (buf input read-char)) + (check-error "Expected '$', received EOF instead" + (dlang/symbol buffer))))) ; dlang/id ;------------------------------------------------------------------------------ @@ -110,6 +178,6 @@ (call-with-input-string "" (lambda (input) (define buffer (buf input read-char)) - (define result (dlang/id buffer)) - (equal? result "An Id was expected but none found.") ))) + (check-error "An Id was expected but none found." + (dlang/id buffer)))))