251 lines
7.2 KiB
Scheme
251 lines
7.2 KiB
Scheme
;;; Gash -- Guile As SHell
|
||
;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
|
||
;;;
|
||
;;; This file is part of Gash.
|
||
;;;
|
||
;;; Gash is free software: you can redistribute it and/or modify
|
||
;;; it under the terms of the GNU General Public License as published by
|
||
;;; the Free Software Foundation, either version 3 of the License, or
|
||
;;; (at your option) any later version.
|
||
;;;
|
||
;;; Gash is distributed in the hope that it will be useful,
|
||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;;; GNU General Public License for more details.
|
||
;;;
|
||
;;; You should have received a copy of the GNU General Public License
|
||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
(define-module (test-pattern)
|
||
#:use-module (gash pattern)
|
||
#:use-module (srfi srfi-64)
|
||
#:use-module (tests unit automake))
|
||
|
||
;;; Commentary:
|
||
;;;
|
||
;;; Tests for the pattern module.
|
||
;;;
|
||
;;; Code:
|
||
|
||
(test-begin "pattern")
|
||
|
||
|
||
;;; Basic matching
|
||
|
||
(test-assert "Matches single characters"
|
||
(pattern-match? (parse-pattern "a") "a"))
|
||
|
||
(test-assert "Matches a sequence of characters"
|
||
(pattern-match? (parse-pattern "abc") "abc"))
|
||
|
||
(test-assert "Matches an empty string"
|
||
(pattern-match? (parse-pattern "") ""))
|
||
|
||
(test-assert "Fails on pattern too long"
|
||
(not (pattern-match? (parse-pattern "ab") "a")))
|
||
|
||
(test-assert "Fails on pattern too short"
|
||
(not (pattern-match? (parse-pattern "a") "ab")))
|
||
|
||
|
||
;;; Question marks
|
||
|
||
(test-assert "Matches a question mark with anything"
|
||
(pattern-match? (parse-pattern "???") "abc"))
|
||
|
||
(test-assert "Does not match question mark with empty string"
|
||
(not (pattern-match? (parse-pattern "?") "")))
|
||
|
||
|
||
;;; Bracket expressions
|
||
|
||
(test-assert "Matches with bracket expressions"
|
||
(pattern-match? (parse-pattern "[abc][def][ghi]") "aei"))
|
||
|
||
(test-assert "Fails on non-matching bracket expressions"
|
||
(not (pattern-match? (parse-pattern "[abc][def][ghi]") "aex")))
|
||
|
||
(test-assert "Matches unterminated bracket expression normally"
|
||
(pattern-match? (parse-pattern "a[bc") "a[bc"))
|
||
|
||
(test-assert "Matches with bracket expressions with left brackets"
|
||
(pattern-match? (parse-pattern "a[[]c") "a[c"))
|
||
|
||
(test-assert "Matches with bracket expressions with right brackets"
|
||
(pattern-match? (parse-pattern "a[]]c") "a]c"))
|
||
|
||
(test-assert "Matches with bracket expressions starting with hyphen"
|
||
(pattern-match? (parse-pattern "a[-b]c") "a-c"))
|
||
|
||
(test-assert "Matches with bracket expressions ending with hyphen"
|
||
(pattern-match? (parse-pattern "a[b-]c") "a-c"))
|
||
|
||
(test-assert "Matches with bracket expressions containing bang"
|
||
(pattern-match? (parse-pattern "a[b!]c") "a!c"))
|
||
|
||
(test-assert "Matches with negated bracket expressions"
|
||
(pattern-match? (parse-pattern "a[!x]c") "abc"))
|
||
|
||
(test-assert "Fails on non-matching negated bracket expressions"
|
||
(not (pattern-match? (parse-pattern "a[!x]c") "axc")))
|
||
|
||
;; We do not fully support the following features. However, rather
|
||
;; than do something strange, we raise explicit errors when they are
|
||
;; encountered.
|
||
|
||
(test-error "Does not allow collating symbols"
|
||
(parse-pattern "[[.ch.]]"))
|
||
|
||
(test-assert "Allows unterminated collating symbols"
|
||
(parse-pattern "[[.ch]"))
|
||
|
||
(test-error "Does not allow equivalence classes"
|
||
(parse-pattern "[[=a=]]"))
|
||
|
||
(test-assert "Allows unterminated equivalence classes"
|
||
(parse-pattern "[[=a]"))
|
||
|
||
(test-error "Does not allow character classes"
|
||
(parse-pattern "[[:space:]]"))
|
||
|
||
(test-assert "Allows unterminated character classes"
|
||
(parse-pattern "[[:space]"))
|
||
|
||
(test-error "Does not allow general character ranges"
|
||
(parse-pattern "[<->]"))
|
||
|
||
(test-assert "Allows [a-z]"
|
||
(parse-pattern "[a-z]"))
|
||
|
||
(test-assert "Allows [A-Z]"
|
||
(parse-pattern "[A-Z]"))
|
||
|
||
(test-assert "Allows [0-9]"
|
||
(parse-pattern "[0-9]"))
|
||
|
||
(test-assert "Matches with allowed character ranges"
|
||
(pattern-match? (parse-pattern "[a-z][A-Z][0-9]") "mJ2"))
|
||
|
||
(test-assert "Allows bad ranges in not-quite bracket expressions"
|
||
(pattern-plain? (parse-pattern "[]-foo")))
|
||
|
||
|
||
;;; Asterisks
|
||
|
||
(test-assert "Matches with asterisk"
|
||
(pattern-match? (parse-pattern "*") "abc"))
|
||
|
||
(test-assert "Matches empty string with asterisk"
|
||
(pattern-match? (parse-pattern "*") ""))
|
||
|
||
(test-assert "Matches with trailing asterisk"
|
||
(pattern-match? (parse-pattern "foo*") "foobar"))
|
||
|
||
(test-assert "Fails on non-matching trailing asterisk"
|
||
(not (pattern-match? (parse-pattern "foo*") "goobar")))
|
||
|
||
(test-assert "Matches with leading asterisk"
|
||
(pattern-match? (parse-pattern "*bar") "foobar"))
|
||
|
||
(test-assert "Fails on non-matching leading asterisk"
|
||
(not (pattern-match? (parse-pattern "*bar") "foobaz")))
|
||
|
||
(test-assert "Fails on non-matching leading asterisk (internal match)"
|
||
(not (pattern-match? (parse-pattern "*bar") "foobarbaz")))
|
||
|
||
(test-assert "Matches with internal asterisk"
|
||
(pattern-match? (parse-pattern "foo*bar") "foo boo! bar"))
|
||
|
||
(test-assert "Fails on non-matching internal asterisk (start)"
|
||
(not (pattern-match? (parse-pattern "foo*bar") "goo boo! bar")))
|
||
|
||
(test-assert "Fails on non-matching internal asterisk (end)"
|
||
(not (pattern-match? (parse-pattern "foo*bar") "foo boo! baz")))
|
||
|
||
|
||
;;; Quoting
|
||
|
||
;; TODO: Test quoting.
|
||
|
||
|
||
;;; Plain patterns
|
||
|
||
(test-assert "Recognizes plain patterns"
|
||
(pattern-plain? (parse-pattern "foo")))
|
||
|
||
(test-assert "Asterisks at the start are not plain"
|
||
(not (pattern-plain? (parse-pattern "*foo"))))
|
||
|
||
(test-assert "Asterisks at the end are not plain"
|
||
(not (pattern-plain? (parse-pattern "foo*"))))
|
||
|
||
(test-assert "Asterisks in the middle are not plain"
|
||
(not (pattern-plain? (parse-pattern "f*o"))))
|
||
|
||
(test-assert "Question marks are not plain"
|
||
(not (pattern-plain? (parse-pattern "f?o"))))
|
||
|
||
(test-assert "Character classes are not plain"
|
||
(not (pattern-plain? (parse-pattern "[fo]o"))))
|
||
|
||
|
||
;;; Dropping
|
||
|
||
;; Dropping on the left.
|
||
|
||
(test-equal "Drops by a pattern"
|
||
"obar"
|
||
(pattern-drop (parse-pattern "*o") "foobar"))
|
||
|
||
(test-equal "Drops by a pattern (greedy)"
|
||
"bar"
|
||
(pattern-drop (parse-pattern "*o") "foobar" #:greedy? #t))
|
||
|
||
(test-equal "Does not drop by an empty pattern"
|
||
"foobar"
|
||
(pattern-drop (parse-pattern "") "foobar"))
|
||
|
||
(test-equal "Does not drop by a non-matching pattern"
|
||
"foobar"
|
||
(pattern-drop (parse-pattern "*x*") "foobar"))
|
||
|
||
(test-equal "Drops by a pattern ending with a wildcard"
|
||
"oobar"
|
||
(pattern-drop (parse-pattern "f*") "foobar"))
|
||
|
||
(test-equal "Drops by a pattern ending with a wildcard (greedy)"
|
||
""
|
||
(pattern-drop (parse-pattern "f*") "foobar" #:greedy? #t))
|
||
|
||
;; Dropping on the right.
|
||
|
||
(test-equal "Drops-right by a pattern"
|
||
"buz"
|
||
(pattern-drop-right (parse-pattern "z*") "buzzy"))
|
||
|
||
(test-equal "Drops-right by a pattern (greedy)"
|
||
"bu"
|
||
(pattern-drop-right (parse-pattern "z*") "buzzy" #:greedy? #t))
|
||
|
||
(test-equal "Does not drop-right by an empty pattern"
|
||
"buzzy"
|
||
(pattern-drop-right (parse-pattern "") "buzzy"))
|
||
|
||
(test-equal "Does not drop-right by a non-matching pattern"
|
||
"buzzy"
|
||
(pattern-drop-right (parse-pattern "*x*") "buzzy"))
|
||
|
||
(test-equal "Drops-right by a pattern starting with a wildcard"
|
||
"buzz"
|
||
(pattern-drop-right (parse-pattern "*y") "buzzy"))
|
||
|
||
(test-equal "Drops-right by a pattern starting with a wildcard (greedy)"
|
||
""
|
||
(pattern-drop-right (parse-pattern "*y") "buzzy" #:greedy? #t))
|
||
|
||
(test-end)
|
||
|
||
;; Local Variables:
|
||
;; eval: (put 'test-error 'scheme-indent-function 1)
|
||
;; End:
|