ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix: Add globstar support.

Browse source 
* guix/glob.scm (string->sglob)
(glob-match?): Add globstar support.
* tests/glob.scm: Update accordingly.

Signed-off-by: Jelle Licht <jlicht@fsfe.org>
This commit is contained in:
Giacomo Leidi 2020-05-12 23:31:30 +02:00 committed by Jelle Licht
parent 52e14cb798
commit 371ba7b4be
No known key found for this signature in database
GPG key ID: DA4597F947B41025
2 changed files with 21 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
guix/glob.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -61,6 +62,11 @@ (define (cons-string chars lst)
(flatten (reverse (if (null? pending) (flatten (reverse (if (null? pending)
result result
(cons-string pending result))))) (cons-string pending result)))))
((#\* #\* #\/ . rest)
(if (zero? brackets)
(loop rest '() 0
(cons* '**/ (cons-string pending result)))
(loop rest (cons '**/ pending) brackets result)))
(((and chr (or #\? #\*)) . rest) (((and chr (or #\? #\*)) . rest)
(let ((wildcard (match chr (let ((wildcard (match chr
(#\? '?) (#\? '?)
@ -121,6 +127,15 @@ (define (glob-match? pattern str)
(string-null? str)) (string-null? str))
(('*) (('*)
#t) #t)
(('**/)
#t)
(('**/ suffix . rest)
(let ((rest (if (eq? '* suffix) (cdr rest) rest))
(suffix (if (eq? '* suffix) (car rest) suffix)))
(match (string-contains str suffix)
(#f #f)
(index (loop rest (string-drop str
(+ index (string-length suffix))))))))
(('* suffix . rest) (('* suffix . rest)
(match (string-contains str suffix) (match (string-contains str suffix)
(#f #f) (#f #f)

8
tests/glob.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -53,7 +54,8 @@ (define-syntax test-glob-match
"foo[abc]bar" => '("foo" (set #\a #\b #\c) "bar") "foo[abc]bar" => '("foo" (set #\a #\b #\c) "bar")
"foo[a[b]c]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") "[123]x" => '((set #\1 #\2 #\3) "x")
"[a-z]" => '((range #\a #\z))) "[a-z]" => '((range #\a #\z))
"**/*.scm" => '(**/ * ".scm"))
(test-glob-match (test-glob-match
("foo" matches "foo" (and not "foobar" "barfoo")) ("foo" matches "foo" (and not "foobar" "barfoo"))
@ -64,6 +66,8 @@ (define-syntax test-glob-match
("ab[0-9]c" matches "ab0c" "ab7c" "ab9c" ("ab[0-9]c" matches "ab0c" "ab7c" "ab9c"
(and not "ab-c" "ab00c" "ab3")) (and not "ab-c" "ab00c" "ab3"))
("ab[cdefg]" matches "abc" "abd" "abg" ("ab[cdefg]" matches "abc" "abd" "abg"
(and not "abh" "abcd" "ab["))) (and not "abh" "abcd" "ab["))
("foo/**/*.scm" matches "foo/bar/baz.scm" "foo/bar.scm" "foo/bar/baz/zab.scm"
(and not "foo/bar/baz.java" "foo/bar.smc")))
(test-end "glob") (test-end "glob")