diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-06-18 00:02:56 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-06-18 00:14:07 +0200 |
| commit | d46c4423f46278bd2f96770ceb0667431414349e (patch) | |
| tree | 60c92c81fa91db7b602ec7a6bdec8f6184b11e66 | |
| parent | 3bacc655c5fd988f0199ef259adcb4fb3754042e (diff) | |
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.
| -rw-r--r-- | guix/discovery.scm | 13 | ||||
| -rw-r--r-- | tests/discovery.scm | 4 |
2 files changed, 15 insertions, 2 deletions
diff --git a/guix/discovery.scm b/guix/discovery.scm index 6cf8d6d566..292df2bd9c 100644 --- a/guix/discovery.scm +++ b/guix/discovery.scm @@ -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 #\/)))) diff --git a/tests/discovery.scm b/tests/discovery.scm index b838731e16..04de83f085 100644 --- a/tests/discovery.scm +++ b/tests/discovery.scm @@ -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")))) |