[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/03: discovery: Recurse into directories pointed to by a symlink.
From: |
Ludovic Courtès |
Subject: |
03/03: discovery: Recurse into directories pointed to by a symlink. |
Date: |
Mon, 3 Jul 2017 17:53:25 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 960c6ce96d746cf19829ad26e092ec5dad2a5c62
Author: Ludovic Courtès <address@hidden>
Date: Mon Jul 3 23:35:56 2017 +0200
discovery: Recurse into directories pointed to by a symlink.
Reported by Christopher Baines <address@hidden>
and Alex Kost <address@hidden>
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.
---
guix/discovery.scm | 14 ++++++++++++--
tests/discovery.scm | 14 ++++++++++++++
2 files changed, 26 insertions(+), 2 deletions(-)
diff --git a/guix/discovery.scm b/guix/discovery.scm
index 292df2b..2741725 100644
--- a/guix/discovery.scm
+++ b/guix/discovery.scm
@@ -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))))))
'()
diff --git a/tests/discovery.scm b/tests/discovery.scm
index 04de83f..753e6a8 100644
--- a/tests/discovery.scm
+++ b/tests/discovery.scm
@@ -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"))