From e914b398af11f909e88a8bc85eeebb0768aacd54 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 16 Mar 2018 23:35:07 +0100
Subject: glob: Support square brackets in patterns.

* guix/glob.scm (wildcard-indices): Remove.
(parse-bracket): New procedure.
(compile-glob-pattern): Rewrite.  Support square brackets for sets and
ranges.
(glob-match?): Support sets and ranges.
* tests/glob.scm (test-compile-glob-pattern)
(test-glob-match): New macros.
Use them to rewrite the existing tests, and add new tests.
---
 tests/glob.scm | 67 ++++++++++++++++++++++++++++++++++------------------------
 1 file changed, 39 insertions(+), 28 deletions(-)

(limited to 'tests')

diff --git a/tests/glob.scm b/tests/glob.scm
index 033eeb10fe..71e2d3fce0 100644
--- a/tests/glob.scm
+++ b/tests/glob.scm
@@ -23,36 +23,47 @@
 
 (test-begin "glob")
 
-(test-equal "compile-glob-pattern, no wildcards"
-  "foo"
-  (compile-glob-pattern "foo"))
+(define-syntax test-compile-glob-pattern
+  (syntax-rules (=>)
+    ((_ pattern => result rest ...)
+     (begin
+       (test-equal (format #f "compile-glob-pattern, ~s" pattern)
+         result
+         (compile-glob-pattern pattern))
+       (test-compile-glob-pattern rest ...)))
+    ((_)
+     #t)))
 
-(test-equal "compile-glob-pattern, Kleene star"
-  '("foo" * "bar")
-  (compile-glob-pattern "foo*bar"))
+(define-syntax test-glob-match
+  (syntax-rules (matches and not)
+    ((_ (pattern-string matches strings ... (and not others ...)) rest ...)
+     (begin
+       (test-assert (format #f "glob-match? ~s" pattern-string)
+         (let ((pattern (compile-glob-pattern pattern-string)))
+           (and (glob-match? pattern strings) ...
+                (not (glob-match? pattern others)) ...)))
+       (test-glob-match rest ...)))
+    ((_)
+     #t)))
 
-(test-equal "compile-glob-pattern, question mark"
-  '(? "foo" *)
-  (compile-glob-pattern "?foo*"))
+(test-compile-glob-pattern
+ "foo" => "foo"
+ "?foo*" => '(? "foo" *)
+ "foo[1-5]" => '("foo" (range #\1 #\5))
+ "foo[abc]bar" => '("foo" (set #\a #\b #\c) "bar")
+ "foo[a[b]c]bar" => '("foo" (set #\a #\[ #\b #\] #\c) "bar")
+ "[123]x" => '((set #\1 #\2 #\3) "x")
+ "[a-z]" => '((range #\a #\z)))
 
-(test-assert "literal match"
-  (let ((pattern (compile-glob-pattern "foo")))
-    (and (glob-match? pattern "foo")
-         (not (glob-match? pattern "foobar"))
-         (not (glob-match? pattern "barfoo")))))
-
-(test-assert "trailing star"
-  (let ((pattern (compile-glob-pattern "foo*")))
-    (and (glob-match? pattern "foo")
-         (glob-match? pattern "foobar")
-         (not (glob-match? pattern "xfoo")))))
-
-(test-assert "question marks"
-  (let ((pattern (compile-glob-pattern "foo??bar")))
-    (and (glob-match? pattern "fooxxbar")
-         (glob-match? pattern "fooZZbar")
-         (not (glob-match? pattern "foobar"))
-         (not (glob-match? pattern "fooxxxbar"))
-         (not (glob-match? pattern "fooxxbarzz")))))
+(test-glob-match
+ ("foo" matches "foo" (and not "foobar" "barfoo"))
+ ("foo*" matches "foo" "foobar" (and not "xfoo"))
+ ("foo??bar" matches "fooxxbar" "fooZZbar"
+  (and not "foobar" "fooxxxbar" "fooxxbarzz"))
+ ("foo?" matches "foox" (and not "fooxx"))
+ ("ab[0-9]c" matches "ab0c" "ab7c" "ab9c"
+  (and not "ab-c" "ab00c" "ab3"))
+ ("ab[cdefg]" matches "abc" "abd" "abg"
+  (and not "abh" "abcd" "ab[")))
 
 (test-end "glob")
-- 
cgit v1.2.3