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

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit d46c4423f46278bd2f96770ceb0667431414349e
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jun 18 00:02:56 2017 +0200

    discovery: 'scheme-files' returns '() for a non-accessible directory.
    
    Fixes a regression introduced in
    d27cc3bfaafe6b5b0831e88afb1c46311d382a0b.
    
    Reported by Ricardo Wurmus <address@hidden>.
    
    * 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.
---
 guix/discovery.scm  | 13 +++++++++++--
 tests/discovery.scm |  4 ++++
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/guix/discovery.scm b/guix/discovery.scm
index 6cf8d6d..292df2b 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 b838731..04de83f 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"))))