From 371ba7b4be81895d202519824bf19893bfdb2526 Mon Sep 17 00:00:00 2001
From: Giacomo Leidi <goodoldpaul@autistici.org>
Date: Tue, 12 May 2020 23:31:30 +0200
Subject: [PATCH] guix: Add globstar support.

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

Signed-off-by: Jelle Licht <jlicht@fsfe.org>
---
 guix/glob.scm  | 15 +++++++++++++++
 tests/glob.scm |  8 ++++++--
 2 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/guix/glob.scm b/guix/glob.scm
index a9fc744802..d73783cd30 100644
--- a/guix/glob.scm
+++ b/guix/glob.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -61,6 +62,11 @@ (define (cons-string chars lst)
        (flatten (reverse (if (null? 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)
        (let ((wildcard (match chr
                          (#\? '?)
@@ -121,6 +127,15 @@ (define (glob-match? pattern str)
       (string-null? str))
      (('*)
       #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)
       (match (string-contains str suffix)
         (#f    #f)
diff --git a/tests/glob.scm b/tests/glob.scm
index 3134069789..2a5a40c3c6 100644
--- a/tests/glob.scm
+++ b/tests/glob.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; 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[a[b]c]bar" => '("foo" (set #\a #\[ #\b #\] #\c) "bar")
  "[123]x" => '((set #\1 #\2 #\3) "x")
- "[a-z]" => '((range #\a #\z)))
+ "[a-z]" => '((range #\a #\z))
+ "**/*.scm" => '(**/ * ".scm"))
 
 (test-glob-match
  ("foo" matches "foo" (and not "foobar" "barfoo"))
@@ -64,6 +66,8 @@ (define-syntax test-glob-match
  ("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[")))
+  (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")