discovery: 'scheme-files' returns '() for a non-accessible directory.

Fixes a regression introduced in
d27cc3bfaafe6b5b0831e88afb1c46311d382a0b.

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

@ -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"))))