diff options
| -rw-r--r-- | test.lisp | 375 |
1 files changed, 172 insertions, 203 deletions
@@ -1,212 +1,181 @@ (in-package #:monparser) -(defvar *test-passed* 0) -(defvar *test-failed* 0) - -(defun print-result (result) - (if (failure-p result) - (format nil "~a" result) - (format nil "~a" (parsing-tree result)))) - -(defun check-result (actual expected) - (cond ((eq expected :failure) - (or (failure-p actual) - (progn - (format t "~tFAIL: expected failure but got ~a~&" (print-result actual)) - (incf *test-failed*) - nil))) - ((functionp expected) - (or (funcall expected actual) - (progn - (format t "~tFAIL: custom check failed~&") - (format t "~t~tInput: ~a~&" (result-place actual)) - (format t "~t~tResult: ~a~&" actual) - (incf *test-failed*) - nil))) - ((characterp expected) - (or (and (parsing-p actual) - (char= expected (parsing-tree actual))) - (progn - (format t "~tFAIL: expected ~a but got ~a~&" expected (print-result actual)) - (incf *test-failed*) - nil))) - ((stringp expected) - (or (and (parsing-p actual) - (string= expected (parsing-tree actual))) - (progn - (format t "~tFAIL: expected ~a but got ~a~&" expected (print-result actual)) - (incf *test-failed*) - nil))) - ((null expected) - (or (and (parsing-p actual) - (null (parsing-tree actual))) - (progn - (format t "~tFAIL: expected empty list but got ~a~&" (print-result actual)) - (incf *test-failed*) - nil))) - ((typep expected 'cons) - (or (and (parsing-p actual) - (equal expected (parsing-tree actual))) - (progn - (format t "~tFAIL: expected ~a but got ~a~&" expected (print-result actual)) - (incf *test-failed*) - nil))) - (t (format t "~tWARN: unsupported expected type ~a~&" expected) - t))) - -(defmacro deftest (title &body tests) +(defmacro define-tests (&body tests) (let ((test-forms)) (dolist (test tests) (let ((parser (first test)) (input (second test)) (expected (third test))) - (push `(let ((actual (parse ,parser ,input))) - (if (check-result actual ,expected) - (incf *test-passed*) - (incf *test-failed*))) + (push `(let* ((actual (parse ,parser ,input)) + (passed? (if (eq ,expected :failure) + (failure-p actual) + (and (parsing-p actual) + (equalp ,expected (parsing-tree actual)))))) + (if passed? + (incf test-passed) + (progn + (format t "FAIL: ~a ~a ~&~tExpected: ~a~&~tActual: ~a~&~%" + ',parser + ,input + ,expected + (if (parsing-p actual) + (parsing-tree actual) + actual)) + (incf test-failed)))) test-forms))) - (setf test-forms (nreverse test-forms)) - `(progn - (let ((had-failures *test-failed*)) - ,@test-forms - (unless (eq *test-failed* had-failures) - (format t "~a:~&" ,title) - (format t "~%")))))) + `(defun run-tests () + (let ((test-passed 0) + (test-failed 0)) + ,@(reverse test-forms) + (format t "PASSED: ~a~&" test-passed) + (format t "FAILED: ~a~&" test-failed))))) + +(defparser whitespace () + (optional (many (unit #'whitespace?)))) + +(defparser lazy-test () + (within whitespace + (one-of (unit #\h) + (comp ((_ (unit #\{)) + (body (optional (many (lazy lazy-test)))) + (_ (unit #\}))) + body) + (comp ((_ (unit #\()) + (body (optional (many (lazy lazy-test)))) + (_ (unit #\)))) + body) + (unit)))) -(defun test () - (deftest "unit" - ((unit) "hello" #\h) - ((unit #\h) "hello" #\h) - ((unit #\x) "hello" :failure) - ((unit #'alpha-char-p) "hello" #\h) - ((unit #'digit-char-p) "1abc" #\1) - ((unit #\@) "hello" :failure) - ((unit #\x) "" :failure)) - (deftest "many" - ((many (unit #\h)) "hello" (list #\h)) - ((many (unit #\h)) "hhhhhhhello" (list #\h #\h #\h #\h #\h #\h #\h)) - ((many (unit #\h)) "ello" :failure) - ((many (unit #\x)) "hello" :failure) - ((many (unit #\h)) "" :failure) - ((many (unit #'alpha-char-p)) "abc123xyz" (list #\a #\b #\c))) - (deftest "optional many" - ((optional (many (unit #\h))) "hello" (list #\h)) - ((optional (many (unit #\h))) "hhhhhhhello" (list #\h #\h #\h #\h #\h #\h #\h)) - ((optional (many (unit #\h))) "ello" nil) - ((optional (many (unit #\h))) "" nil)) - (deftest "many optional" - ((many (optional (unit #\h))) "hello" (list #\h)) - ((many (optional (unit #\h))) "hhhhhhhello" (list #\h #\h #\h #\h #\h #\h #\h)) - ((many (optional (unit #\h))) "ello" :failure) - ((many (optional (unit #\h))) "" :failure)) - (deftest "until literal" - ((comp ((prefix (optional (literal "zy"))) - (match (if prefix - (fail "Reached prefix") - (unit)))) - match) - "zy" :failure) - ((comp ((prefix (optional (literal "zy"))) - (match (if prefix - (fail "Reached prefix") - (unit)))) - match) - "ezy" #\e) - ((many (comp ((prefix (optional (literal "zy"))) - (match (if prefix - (fail "Reached prefix") - (unit)))) - match)) - "the quick brown fox jumps over the lazy dog." - (coerce "the quick brown fox jumps over the la" 'list)) - ((optional - (many - (comp ((prefix (optional (literal "zy"))) - (match (if prefix - (fail "Reached prefix") - (unit)))) - match))) - "the quick brown fox jumps over the lazy dog." - (coerce "the quick brown fox jumps over the la" 'list))) - (deftest "literal" - ((literal "hello") "hello world" (list #\h #\e #\l #\l #\o)) - ((literal "hello") "hello" (list #\h #\e #\l #\l #\o)) - ((literal "hello") "help" :failure) - ((literal "hello") "world" :failure) - ((literal "") "hello" (list)) - ((literal "ab") "abc" (list #\a #\b))) - (deftest "one-of" - ((one-of (unit #\a) (unit #\b)) "abc" #\a) - ((one-of (unit #\b) (unit #\a)) "abc" #\a) - ((one-of (unit #\c) (unit #\d)) "abc" :failure)) - (deftest "whitespace?" - ((many (unit #'whitespace?)) " abc" (list #\Space #\Space)) - ((many (unit #'whitespace?)) (format nil "~a~aabc" #\Tab #\Newline) (list #\Tab #\Newline)) - ((many (unit #'whitespace?)) "abc" :failure) - ((many (unit #'whitespace?)) "" :failure)) - (deftest "repeat" - ((repeat (unit #\h) 3) "hhhello" (list #\h #\h #\h)) - ((repeat (unit #\h) 3) "hh" :failure) - ((repeat (unit #\x) 3) "hello" :failure)) - (deftest "within" - ((within (literal "(") (many (unit #\a)) (literal ")")) "(aaa)bc" (list #\a #\a #\a)) - ((within (literal "[") (many (unit #\x)) (literal "]")) "[xxxx]bc" (list #\x #\x #\x #\x)) - ((within (literal "(") (many (unit #\a)) (literal ")")) "((aaa)bc" :failure) - ((within (literal "(") (many (unit #\a)) (literal ")")) "(aaabc" :failure)) - (deftest "comp" - ((comp ((a (unit #\a)) - (b (unit #\b))) - (format nil "~a~a" a b)) - "abc" "ab") - ((comp ((a (many (unit #\a))) - (b (many (unit #\b)))) - (format nil "~a ~a" a b)) - "aaabbbccc" "(a a a) (b b b)") - ((comp ((a (unit #\1)) - (b (unit #\2)) - (c (unit #\3))) - (list a b c)) - "12345" (list #\1 #\2 #\3))) - (deftest "failure chaining" - ((comp ((a (literal "hello")) - (b (literal "world"))) - (format nil "~a ~a" a b)) - "helloworld" "(h e l l o) (w o r l d)") - ((comp ((a (literal "hello")) - (b (literal "world"))) - (format nil "~a ~a" a b)) - "hello there" :failure) - ((comp ((a (literal "foo")) - (b (literal "bar")) - (c (literal "baz"))) - (list a b c)) - "foobarbaz" (list (list #\f #\o #\o) (list #\b #\a #\r) (list #\b #\a #\z))) - ((comp ((a (literal "foo")) - (b (literal "bar")) - (c (literal "baz"))) - (list a b c)) - "fooquxbaz" :failure)) - (deftest "custom predicates" - ((many (unit (lambda (c) (char= c #\0)))) "000123" (list #\0 #\0 #\0 #\1 #\2 #\3)) - ((many (unit (lambda (c) (oddp (digit-char-p c))))) "13579abc" (list #\1 #\3 #\5 #\7 #\9 #\a #\b #\c)) - ((many (unit (lambda (c) (char= c #\x)))) "xxx" (list #\x #\x #\x)) - ((many (unit (lambda (c) (char= c #\x)))) "xxxyyy" (list #\x #\x #\x #\y #\y #\y))) - (deftest "nested parsers" - ((many (within (literal "(") (unit #\a) (literal ")"))) "(a)(a)(a)bc" (list #\a #\a #\a)) - ((many (comp ((a (unit #\a)) - (b (unit #\b))) - (list a b))) - "abababc" (list (list #\a #\b) (list #\a #\b) (list #\a #\b))) - ((many (comp ((a (unit #\1)) - (b (unit #\2))) - (concatenate 'string (list a b)))) - "121212xyz" (list "12" "12" "12"))) - (deftest "edge cases" - ((unit #\x) "" :failure) - ((many (unit #\x)) "" :failure) - ((optional (unit #\x)) "" nil) - ((literal "xyz") "" :failure) - ((many (literal "ab")) "ababab" (list (list #\a #\b) (list #\a #\b) (list #\a #\b))) - ((many (literal "ab")) "ababxab" (list (list #\a #\b) (list #\a #\b)))) - (format t "PASSED: ~a~&" *test-passed*) - (format t "FAILED: ~a~&" *test-failed*)) +(define-tests + ((unit) "hello" #\h) + ((unit #\h) "hello" #\h) + ((unit #\x) "hello" :failure) + ((unit #'alpha-char-p) "hello" #\h) + ((unit #'digit-char-p) "1abc" #\1) + ((unit #\@) "hello" :failure) + ((unit #\x) "" :failure) + ((many (unit #\h)) "hello" (list #\h)) + ((many (unit #\h)) "hhhhhhhello" (list #\h #\h #\h #\h #\h #\h #\h)) + ((many (unit #\h)) "ello" :failure) + ((many (unit #\x)) "hello" :failure) + ((many (unit #\h)) "" :failure) + ((many (unit #'alpha-char-p)) "abc123xyz" (list #\a #\b #\c)) + ((optional (many (unit #\h))) "hello" (list #\h)) + ((optional (many (unit #\h))) "hhhhhhhello" (list #\h #\h #\h #\h #\h #\h #\h)) + ((optional (many (unit #\h))) "ello" nil) + ((optional (many (unit #\h))) "" nil) + ((many (optional (unit #\h))) "hello" (list #\h)) + ((many (optional (unit #\h))) "hhhhhhhello" (list #\h #\h #\h #\h #\h #\h #\h)) + ((many (optional (unit #\h))) "ello" :failure) + ((many (optional (unit #\h))) "" :failure) + ((comp ((prefix (optional (literal "zy"))) + (match (if prefix + (fail "Reached prefix") + (unit)))) + match) + "zy" :failure) + ((comp ((prefix (optional (literal "zy"))) + (match (if prefix + (fail "Reached prefix") + (unit)))) + match) + "ezy" #\e) + ((many (comp ((prefix (optional (literal "zy"))) + (match (if prefix + (fail "Reached prefix") + (unit)))) + match)) + "the quick brown fox jumps over the lazy dog." + (coerce "the quick brown fox jumps over the la" 'list)) + ((optional + (many + (comp ((prefix (optional (literal "zy"))) + (match (if prefix + (fail "Reached prefix") + (unit)))) + match))) + "the quick brown fox jumps over the lazy dog." + (coerce "the quick brown fox jumps over the la" 'list)) + ((literal "hello") "hello world" (list #\h #\e #\l #\l #\o)) + ((literal "hello") "hello" (list #\h #\e #\l #\l #\o)) + ((literal "hello") "help" :failure) + ((literal "hello") "world" :failure) + ((literal "") "hello" (list)) + ((literal "ab") "abc" (list #\a #\b)) + ((one-of (unit #\a) (unit #\b)) "abc" #\a) + ((one-of (unit #\b) (unit #\a)) "abc" #\a) + ((one-of (unit #\c) (unit #\d)) "abc" :failure) + ((one-of (unit #\h) + (comp ((_ (unit #\()) + (body (optional (many (unit #\h)))) + (_ (unit #\)))) + body) + (unit)) + "(hhh)ello" (list #\h #\h #\h)) + ((many (unit #'whitespace?)) " abc" (list #\Space #\Space)) + ((many (unit #'whitespace?)) (format nil "~a~aabc" #\Tab #\Newline) (list #\Tab #\Newline)) + ((many (unit #'whitespace?)) "abc" :failure) + ((many (unit #'whitespace?)) "" :failure) + ((repeat (unit #\h) 3) "hhhello" (list #\h #\h #\h)) + ((repeat (unit #\h) 3) "hh" :failure) + ((repeat (unit #\x) 3) "hello" :failure) + ((within (literal "(") (many (unit #\a)) (literal ")")) "(aaa)bc" (list #\a #\a #\a)) + ((within (literal "[") (many (unit #\x)) (literal "]")) "[xxxx]bc" (list #\x #\x #\x #\x)) + ((within (literal "(") (many (unit #\a)) (literal ")")) "((aaa)bc" :failure) + ((within (literal "(") (many (unit #\a)) (literal ")")) "(aaabc" :failure) + ((comp ((a (unit #\a)) + (b (unit #\b))) + (format nil "~a~a" a b)) + "abc" "ab") + ((comp ((a (many (unit #\a))) + (b (many (unit #\b)))) + (format nil "~a ~a" a b)) + "aaabbbccc" "(a a a) (b b b)") + ((comp ((a (unit #\1)) + (b (unit #\2)) + (c (unit #\3))) + (list a b c)) + "12345" (list #\1 #\2 #\3)) + ((comp ((_ (unit #\{)) + (body (optional (many (unit #\h)))) + (_ (unit #\}))) + body) + "{hhh}" (list #\h #\h #\h)) + (lazy-test "(hhh)ello" (list #\h #\h #\h)) + ((comp ((a (literal "hello")) + (b (literal "world"))) + (format nil "~a ~a" a b)) + "helloworld" "(h e l l o) (w o r l d)") + ((comp ((a (literal "hello")) + (b (literal "world"))) + (format nil "~a ~a" a b)) + "hello there" :failure) + ((comp ((a (literal "foo")) + (b (literal "bar")) + (c (literal "baz"))) + (list a b c)) + "foobarbaz" (list (list #\f #\o #\o) (list #\b #\a #\r) (list #\b #\a #\z))) + ((comp ((a (literal "foo")) + (b (literal "bar")) + (c (literal "baz"))) + (list a b c)) + "fooquxbaz" :failure) + ((many (unit (lambda (c) (char= c #\0)))) "000123" (list #\0 #\0 #\0 #\1 #\2 #\3)) + ((many (unit (lambda (c) (oddp (digit-char-p c))))) "13579abc" (list #\1 #\3 #\5 #\7 #\9 #\a #\b #\c)) + ((many (unit (lambda (c) (char= c #\x)))) "xxx" (list #\x #\x #\x)) + ((many (unit (lambda (c) (char= c #\x)))) "xxxyyy" (list #\x #\x #\x #\y #\y #\y)) + ((many (within (literal "(") (unit #\a) (literal ")"))) "(a)(a)(a)bc" (list #\a #\a #\a)) + ((many (comp ((a (unit #\a)) + (b (unit #\b))) + (list a b))) + "abababc" (list (list #\a #\b) (list #\a #\b) (list #\a #\b))) + ((many (comp ((a (unit #\1)) + (b (unit #\2))) + (concatenate 'string (list a b)))) + "121212xyz" (list "12" "12" "12")) + ((unit #\x) "" :failure) + ((many (unit #\x)) "" :failure) + ((optional (unit #\x)) "" nil) + ((literal "xyz") "" :failure) + ((many (literal "ab")) "ababab" (list (list #\a #\b) (list #\a #\b) (list #\a #\b))) + ((many (literal "ab")) "ababxab" (list (list #\a #\b) (list #\a #\b)))) |