diff options
| -rw-r--r-- | guix/discovery.scm | 14 | ||||
| -rw-r--r-- | tests/discovery.scm | 14 |
2 files changed, 26 insertions, 2 deletions
diff --git a/guix/discovery.scm b/guix/discovery.scm index 292df2bd9c..2741725b9d 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 04de83f085..753e6a8979 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")) |