~ruther/guix-local

960c6ce96d746cf19829ad26e092ec5dad2a5c62 — Ludovic Courtès 8 years ago cc1dfc2
discovery: Recurse into directories pointed to by a symlink.

Reported by Christopher Baines <mail@cbaines.net>
and Alex Kost <alezost@gmail.com>
at <https://lists.gnu.org/archive/html/guix-devel/2017-06/msg00290.html>.

* guix/discovery.scm (scheme-files): When ENTRY is a symlink that
doesn't end in '.scm', call 'stat' and recurse if it points to a
directory.
* tests/discovery.scm ("scheme-modules recurses in symlinks to
directories"): New test.
2 files changed, 26 insertions(+), 2 deletions(-)

M guix/discovery.scm
M tests/discovery.scm
M guix/discovery.scm => guix/discovery.scm +12 -2
@@ 60,11 60,21 @@ DIRECTORY is not accessible."
                     (case (entry-type absolute properties)
                       ((directory)
                        (append (scheme-files absolute) result))
                       ((regular symlink)
                        ;; XXX: We don't recurse if we find a symlink.
                       ((regular)
                        (if (string-suffix? ".scm" name)
                            (cons absolute result)
                            result))
                       ((symlink)
                        (cond ((string-suffix? ".scm" name)
                               (cons absolute result))
                              ((stat absolute #f)
                               =>
                               (match-lambda
                                 (#f result)
                                 ((= stat:type 'directory)
                                  (append (scheme-files absolute)
                                          result))
                                 (_ result)))))
                       (else
                        result))))))
              '()

M tests/discovery.scm => tests/discovery.scm +14 -0
@@ 19,6 19,7 @@
(define-module (test-discovery)
  #:use-module (guix discovery)
  #:use-module (guix build-system)
  #:use-module (guix utils)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match))



@@ 32,6 33,19 @@
    ((('guix 'import _ ...) ..1)
     #t)))

(test-assert "scheme-modules recurses in symlinks to directories"
  (call-with-temporary-directory
   (lambda (directory)
     (mkdir (string-append directory "/guix"))
     (symlink (string-append %top-srcdir "/guix/import")
              (string-append directory "/guix/import"))

     ;; DIRECTORY/guix/import is a symlink but we want to make sure
     ;; 'scheme-modules' recurses into it.
     (match (map module-name (scheme-modules directory))
       ((('guix 'import _ ...) ..1)
        #t)))))

(test-equal "scheme-modules, non-existent directory"
  '()
  (scheme-modules "/does/not/exist"))