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

discovery: Recurse into directories pointed to by a symlink.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2017-07-03 23:35:56 +02:00
parent cc1dfc202f
commit 960c6ce96d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 26 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
guix/discovery.scm
View file

@ -60,11 +60,21 @@ (define (entry-type name properties)
(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))))))
'()

14
tests/discovery.scm
View file

@ -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 @@ (define %top-srcdir
((('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"))