ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -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) (case (entry-type absolute properties)
((directory) ((directory)
(append (scheme-files absolute) result)) (append (scheme-files absolute) result))
((regular symlink) ((regular)
;; XXX: We don't recurse if we find a symlink.
(if (string-suffix? ".scm" name) (if (string-suffix? ".scm" name)
(cons absolute result) (cons absolute result)
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 (else
result)))))) result))))))
'() '()

14
tests/discovery.scm
View file

@ -19,6 +19,7 @@
(define-module (test-discovery) (define-module (test-discovery)
#:use-module (guix discovery) #:use-module (guix discovery)
#:use-module (guix build-system) #:use-module (guix build-system)
#:use-module (guix utils)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (ice-9 match)) #:use-module (ice-9 match))
@ -32,6 +33,19 @@ (define %top-srcdir
((('guix 'import _ ...) ..1) ((('guix 'import _ ...) ..1)
#t))) #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" (test-equal "scheme-modules, non-existent directory"
'() '()
(scheme-modules "/does/not/exist")) (scheme-modules "/does/not/exist"))