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:
Ludovic Courtès 2017-06-18 00:02:56 +02:00
parent 3bacc655c5
commit d46c4423f4
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 15 additions and 2 deletions

View File

@ -38,7 +38,8 @@
(define* (scheme-files directory)
"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)
(match (assoc-ref properties 'type)
('unknown
@ -67,7 +68,15 @@ returned list is sorted in alphabetical order."
(else
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
(let ((not-slash (char-set-complement (char-set #\/))))

View File

@ -32,6 +32,10 @@
((('guix 'import _ ...) ..1)
#t)))
(test-equal "scheme-modules, non-existent directory"
'()
(scheme-modules "/does/not/exist"))
(test-assert "all-modules"
(match (map module-name
(all-modules `((,%top-srcdir . "guix/build-system"))))