amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

glob: Add an extra glob pattern compilation stage.

Browse source 
* guix/glob.scm (compile-glob-pattern): Rename to...
(string->sglob): ... this.
(compile-sglob, string->compiled-sglob): New procedures.
(glob-match?): Replace '?, 'range, and 'set with a single clause.
* tests/glob.scm (test-compile-glob-pattern): Rename to...
(test-string->sglob): ... this.  Adjust accordingly.
(test-glob-match): Use 'string->compiled-sglob' instead of
'compile-glob-pattern'.
* gnu/build/linux-modules.scm (read-module-aliases): Use
'string->compiled-sglob' instead of 'compile-glob-pattern'.
This commit is contained in:
Ludovic Courtès 2018-03-18 22:54:34 +01:00
parent e914b398af
commit 71e08fde28
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 41 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

12
tests/glob.scm
View file

@ -23,14 +23,14 @@
(test-begin "glob")
(define-syntax test-compile-glob-pattern
(define-syntax test-string->sglob
(syntax-rules (=>)
((_ pattern => result rest ...)
(begin
(test-equal (format #f "compile-glob-pattern, ~s" pattern)
(test-equal (format #f "string->sglob, ~s" pattern)
result
(compile-glob-pattern pattern))
(test-compile-glob-pattern rest ...)))
(string->sglob pattern))
(test-string->sglob rest ...)))
((_)
#t)))
@ -39,14 +39,14 @@
((_ (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)))
(let ((pattern (string->compiled-sglob pattern-string)))
(and (glob-match? pattern strings) ...
(not (glob-match? pattern others)) ...)))
(test-glob-match rest ...)))
((_)
#t)))
(test-compile-glob-pattern
(test-string->sglob
"foo" => "foo"
"?foo*" => '(? "foo" *)
"foo[1-5]" => '("foo" (range #\1 #\5))