Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

348 lines (268 sloc) 10.869 kb
(in-package :parser-combinators-tests)
(defsuite* (parsers-tests :in parser-combinators-tests))
;;; test for predefined parsers
;;; at least some of them, this is boring, write automatic genetor
(defmacro defparsertest (test-name parser (&rest should-pairs) (&rest fails))
(with-gensyms (result)
`(deftest ,test-name ()
,@(iter (for (string should) on should-pairs by #'cddr)
(collect `(let ((,result (current-result (parse-string ,parser ,string))))
(when (is ,result "Failed to parse ~s" ,string)
(is (equal ,should
(tree-of ,result)))))))
,@(iter (for string in fails)
(collect `(is (null (current-result (parse-string ,parser ,string)))))))))
(defparsertest test-char? (char? #\a)
("a" #\a)
("b"))
(defparsertest test-digit? (digit?)
("5" #\5)
("b"))
(defparsertest test-lower? (lower?)
("a" #\a)
("A" "5"))
(defparsertest test-upper? (upper?)
("A" #\A)
("a" "5"))
(defparsertest test-alphanum? (alphanum?)
("A" #\A "b" #\b "1" #\1 "5" #\5)
(" " ","))
(defparsertest test-whitespace? (whitespace?)
(" " nil " " nil)
("a" ","))
(defparsertest test-whitespace* (whitespace*)
(" " nil " " nil)
("a" ","))
(defparsertest test-whitespace?2 (whitespace? :accept-empty t)
("" nil)
())
(defparsertest test-whitespace*2 (whitespace* :accept-empty t)
("" nil)
())
(defparsertest test-word? (word?)
("abc" "abc" "123" "123" "abc!def" "abc")
(" " ";,!"))
(defparsertest test-word* (word*)
("abc" "abc" "123" "123" "abc!def" "abc")
(" " ";,!"))
(defparsertest test-pure-word? (pure-word?)
("abc" "abc" "abc!def" "abc")
(" " ";,!" "123"))
(defparsertest test-pure-word* (pure-word*)
("abc" "abc" "abc!def" "abc")
(" " ";,!" "123"))
(defparsertest test-string? (string? (list #\a #\b #\c) :result-type 'list)
("abc" (list #\a #\b #\c) "abcd" (list #\a #\b #\c))
("cde" "abd" "aBc"))
(defparsertest test-string?-chain (seq-list? "abc" "def")
("abcdef" (list "abc" "def") "abcdefgh" (list "abc" "def"))
("abcedef"))
(deftest test-string?-endcontext ()
(is (null (nth-value 1 (parse-string* "abc" "abc")))))
(defparsertest test-string?-char-equal (string? (list #\a #\b #\c) :test #'char-equal :result-type 'string)
("aBc" "aBc" "ABC" "ABC" "abCd" "abC")
("cde" "abd"))
(defparsertest test-many? (many? (letter?))
("abc" (list #\a #\b #\c) "cdef" (list #\c #\d #\e #\f) "Aaa12" (list #\A #\a #\a) "" nil
"123" nil " ," nil " a" nil)
())
(defparsertest test-many1? (many1? (letter?))
("abc" (list #\a #\b #\c))
("" "123" " a"))
(defparsertest test-times? (times? (letter?) 3)
("abc" (list #\a #\b #\c) "abcd" (list #\a #\b #\c))
("" "a" "ab"))
(defparsertest test-atleast? (atleast? (letter?) 3)
("abc" (list #\a #\b #\c) "abcd" (list #\a #\b #\c #\d))
("" "a" "ab"))
(defparsertest test-atmost? (atmost? (letter?) 3)
("a" (list #\a) "ab" (list #\a #\b) "abc" (list #\a #\b #\c) "abcd" (list #\a #\b #\c) "" nil "1" nil)
())
(defparsertest test-between? (between? (letter?) 2 3)
("ab" (list #\a #\b) "abc" (list #\a #\b #\c) "abcd" (list #\a #\b #\c))
("a" ""))
(defparsertest test-int? (int?)
("5" 5 "12" 12 "145" 145 "-56" -56)
("a" "b" " "))
(defparsertest test-sepby1? (sepby1? (int?) (char? #\,))
("1,2,3" (list 1 2 3) "4,-5,6" (list 4 -5 6) "23" (list 23))
("" " " "abc"))
(defparsertest test-bracket? (bracket? (char? #\[) (sepby1? (int?) (char? #\,)) (char? #\]))
("[1,2,3]" (list 1 2 3) "[4,-5,6]" (list 4 -5 6) "[23]" (list 23))
("" " " "abc" "1,2,3" "[4,5,6"))
(defparsertest test-sepby? (sepby? (int?) (char? #\,))
("1,2,3" (list 1 2 3) "4,-5,6" (list 4 -5 6) "23" (list 23) "" nil "abc" nil)
())
(defparsertest test-nat? (nat?)
("1" 1 "23" 23)
("-1"))
(defparsertest test-nat?2 (seq-list? (nat?) "15")
("1015" '(10 "15"))
())
(defparsertest test-chainl1? (chainl1? (digit?) (result #'list))
("123" (list (list #\1 #\2) #\3))
(""))
(defparsertest test-chainr1? (chainr1? (digit?) (result #'list))
("123" (list #\1 (list #\2 #\3)))
(""))
(defparsertest test-find? (find? "ab")
("cacbcacab" "ab")
("" "cacacbac"))
(defparsertest test-find?-context (seq-list? (find? "aa") "bbaacc")
("aabbaacc" (list "aa" "bbaacc"))
())
(defparsertest test-find* (find* "ab")
("cacbcacab" "ab")
("" "cacacbac"))
(defparsertest test-find*-context (seq-list* (find* "aa") "bbaacc")
("aabbaacc" (list "aa" "bbaacc"))
())
(defparsertest test-find-after? (find-after? #\c "ab")
("ccccccab" "ab" "cab" "ab")
("" "acb" "bcccab"))
(defparsertest test-find-after-collect? (find-after-collect? #\a "cc" 'string)
("aaaacc" '("aaaa" . "cc"))
("aaaa" "aaac"))
(defparsertest test-many* (many* (letter?))
("abc" (list #\a #\b #\c) "cdef" (list #\c #\d #\e #\f) "Aaa12" (list #\A #\a #\a) "" nil
"123" nil " ," nil " a" nil)
())
(defparsertest test-many1* (many1* (letter?))
("abc" (list #\a #\b #\c))
("" "123" " a"))
(defparsertest test-atleast* (atleast* (letter?) 3)
("abc" (list #\a #\b #\c) "abcd" (list #\a #\b #\c #\d))
("" "a" "ab"))
(defparsertest test-atmost* (atmost* (letter?) 3)
("a" (list #\a) "ab" (list #\a #\b) "abc" (list #\a #\b #\c) "abcd" (list #\a #\b #\c) "" nil "1" nil)
())
(defparsertest test-between* (between* (letter?) 2 3)
("ab" (list #\a #\b) "abc" (list #\a #\b #\c) "abcd" (list #\a #\b #\c))
("a" ""))
(defparsertest test-sepby1* (sepby1* (int?) (char? #\,))
("1,2,3" (list 1 2 3) "4,-5,6" (list 4 -5 6) "23" (list 23))
("" " " "abc"))
(defparsertest test-sepby* (sepby* (int?) (char? #\,))
("1,2,3" (list 1 2 3) "4,-5,6" (list 4 -5 6) "23" (list 23) "" nil "abc" nil)
())
(defparsertest test-chainl1* (chainl1* (digit?) (result #'list))
("123" (list (list #\1 #\2) #\3))
(""))
(defparsertest test-chainr1* (chainr1* (digit?) (result #'list))
("123" (list #\1 (list #\2 #\3)))
(""))
(defparsertest test-nat* (nat*)
("1" 1 "23" 23)
("-1"))
(defparsertest test-int* (int*)
("5" 5 "12" 12 "145" 145 "-56" -56)
("a" "b" " "))
(defparsertest test-find-after* (find-after* "ab" "cd")
("abababcd" "cd" "cd" "cd")
("ababab" "adbacd"))
(defparsertest test-gather-before-token* (gather-before-token* #\a :result-type 'string :accept-end t)
("cccddda" "cccddd" "gthj" "gthj")
())
(defparsertest test-gather-before-token*-chain
(seq-list* (gather-before-token* #\a :result-type 'string :accept-end t)
(gather-before-token* #\b :result-type 'string :accept-end t :accept-empty t))
("cccdddaghb" (list "cccddd" "agh") "gthj" (list "gthj" ""))
())
(defparsertest test-find-before-token* (find-before-token* "ab" #\c)
("abababc" (list "ab" "ab" "ab"))
("def"))
(deftest test-memo ()
(is (equal '(("12" "3") ("12") ("1" "23") ("1" "2" "3") ("1" "2") ("1") NIL)
(mapcar #'tree-of
(gather-results
(parse-string (many? (between? (memoize? (digit?)) 1 2 'string))
"123"))))))
(deftest test-context ()
(is (equal "1234"
(tree-of (current-result
(parse-string (mdo (<- c1 (context?))
(many* (digit?))
(<- c2 (context?))
(result (context-interval c1 c2)))
"1234abc")))))
(is (equal "1234"
(tree-of (current-result
(parse-string (mdo (<- c1 (context?))
(many* (digit?))
(<- c2 (context?))
(result (context-interval c1 c2)))
"1234"))))))
(defparsertest test-mdo-constants (mdo (times? "ab" 2)
#\c
"defg")
("ababcdefg" "defg")
("ababccdefg"))
(defparsertest test-find-before? (mdo (<- word (word?))
(<- term #\;)
(result (list term word)))
("alamakota;" '(#\; "alamakota"))
("alamakota" ";"))
(defparsertest test-find-before* (mdo (<- word (word?))
(<- term #\;)
(result (list term word)))
("alamakota;" '(#\; "alamakota"))
("alamakota" ";"))
(defparsertest test-end? (mdo (<- word (word?))
(<- end (end?))
(result (list word end)))
("alamakota" '("alamakota" t))
("alamakota " ""))
(defparsertest test-empty? (end?)
("" t)
("abc"))
(defparsertest test-seq-list? (seq-list? #\a #\b #\c)
("abc" '(#\a #\b #\c))
("abd"))
(defparsertest test-named-seq? (named-seq? (<- a #\a) #\b (<- c #\c)
(list a 'b c))
("abc" '(#\a b #\c))
("acb"))
(defparsertest test-seq-list* (seq-list* #\a #\b #\c)
("abc" '(#\a #\b #\c))
("abd"))
(defparsertest test-named-seq* (named-seq* (<- a #\a) #\b (<- c #\c)
(list a 'b c))
("abc" '(#\a b #\c))
("acb"))
(defparsertest test-hook? (hook? #'1+ (nat*))
("5" 6 "28" 29)
("aa"))
(defparsertest test-chook? (chook? 5 "abc")
("abc" 5)
("bac"))
(defparsertest test-validate? (validate? (many* (item)) (curry #'length= 5))
("12345" '(#\1 #\2 #\3 #\4 #\5))
("1234" "123456"))
(defparsertest test-except? (except? (many* (item)) "a")
("123" '(#\1 #\2 #\3) "cba" '(#\c #\b #\a))
("abc"))
(defparsertest test-except?2 (except? (gather-before-token* #\; :accept-empty t :accept-end t) (end?))
("123;" '(#\1 #\2 #\3) ";" nil "123" '(#\1 #\2 #\3))
(""))
(defparsertest test-opt? (named-seq? (<- a "a") (<- b (opt? "b")) (<- c "c") (list a b c))
("abc" '(#\a #\b #\c) "ac" '(#\a nil #\c))
("abbc" "aabc"))
(defparsertest test-opt* (named-seq* (<- a "a") (<- b (opt* "b")) (<- c "c") (list a b c))
("abc" '(#\a #\b #\c) "ac" '(#\a nil #\c))
("abbc" "aabc"))
(defparsertest test-nested? (nested? "A" :min 1)
("AA(A(AA)A)A" '(#\A #\A (#\A (#\A #\A) #\A) #\A)
"AAAA" '(#\A #\A #\A #\A))
("BAF"))
(defparsertest test-curtail? (curtail? e (choice (seq-list? e #\+ e) #\A))
("A" #\A "A+A" '(#\A #\+ #\A) "A+A+A" '((#\A #\+ #\A) #\+ #\A))
())
(defparsertest test-quoted? (quoted? :quote-char #\' :escape-char #\- :include-quotes t)
("'AAA'" "'AAA'" "'AB-'C'" "'AB-'C'")
("AAA"))
(defparsertest test-quoted?2 (quoted? :quote-char #\' :escape-char #\- :include-quotes nil)
("'AAA'" "AAA" "'AB-'C'" "AB'C")
("AAA"))
(defparsertest test-quoted?3 (quoted? :left-quote-char #\1 :right-quote-char #\2 :escape-char #\3 :include-quotes nil)
("1AAA2" "AAA" "1AB32C2" "AB2C")
("AAA"))
Jump to Line
Something went wrong with that request. Please try again.