discovery: 'scheme-files' returns '() for a non-accessible directory.
Fixes a regression introduced in
d27cc3bfaa
.
Reported by Ricardo Wurmus <rekado@elephly.net>.
* guix/discovery.scm (scheme-files): Catch 'scandir*' system errors.
Return '() and optionally raise a warning upon 'system-error'.
* tests/discovery.scm ("scheme-modules, non-existent directory"): New
test.
This commit is contained in:
parent
3bacc655c5
commit
d46c4423f4
|
@ -38,7 +38,8 @@
|
||||||
|
|
||||||
(define* (scheme-files directory)
|
(define* (scheme-files directory)
|
||||||
"Return the list of Scheme files found under DIRECTORY, recursively. The
|
"Return the list of Scheme files found under DIRECTORY, recursively. The
|
||||||
returned list is sorted in alphabetical order."
|
returned list is sorted in alphabetical order. Return the empty list if
|
||||||
|
DIRECTORY is not accessible."
|
||||||
(define (entry-type name properties)
|
(define (entry-type name properties)
|
||||||
(match (assoc-ref properties 'type)
|
(match (assoc-ref properties 'type)
|
||||||
('unknown
|
('unknown
|
||||||
|
@ -67,7 +68,15 @@ returned list is sorted in alphabetical order."
|
||||||
(else
|
(else
|
||||||
result))))))
|
result))))))
|
||||||
'()
|
'()
|
||||||
(scandir* directory)))
|
(catch 'system-error
|
||||||
|
(lambda ()
|
||||||
|
(scandir* directory))
|
||||||
|
(lambda args
|
||||||
|
(let ((errno (system-error-errno args)))
|
||||||
|
(unless (= errno ENOENT)
|
||||||
|
(warning (G_ "cannot access `~a': ~a~%")
|
||||||
|
directory (strerror errno)))
|
||||||
|
'())))))
|
||||||
|
|
||||||
(define file-name->module-name
|
(define file-name->module-name
|
||||||
(let ((not-slash (char-set-complement (char-set #\/))))
|
(let ((not-slash (char-set-complement (char-set #\/))))
|
||||||
|
|
|
@ -32,6 +32,10 @@
|
||||||
((('guix 'import _ ...) ..1)
|
((('guix 'import _ ...) ..1)
|
||||||
#t)))
|
#t)))
|
||||||
|
|
||||||
|
(test-equal "scheme-modules, non-existent directory"
|
||||||
|
'()
|
||||||
|
(scheme-modules "/does/not/exist"))
|
||||||
|
|
||||||
(test-assert "all-modules"
|
(test-assert "all-modules"
|
||||||
(match (map module-name
|
(match (map module-name
|
||||||
(all-modules `((,%top-srcdir . "guix/build-system"))))
|
(all-modules `((,%top-srcdir . "guix/build-system"))))
|
||||||
|
|
Loading…
Reference in New Issue