~ruther/guix-local

d46c4423f46278bd2f96770ceb0667431414349e — Ludovic Courtès 8 years ago 3bacc65
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.
2 files changed, 15 insertions(+), 2 deletions(-)

M guix/discovery.scm
M tests/discovery.scm
M guix/discovery.scm => guix/discovery.scm +11 -2
@@ 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 #\/))))

M tests/discovery.scm => tests/discovery.scm +4 -0
@@ 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"))))