diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2023-03-13 13:52:38 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2023-06-18 23:36:25 +0200 |
| commit | 1261ce15233cbf7e24de9959df86a23b46314a28 (patch) | |
| tree | 4745d38afb66475ade2e66fc52a7b9bd3bdb8e3b | |
| parent | 81231bf236509a50c1b81191989cf6358f497e1b (diff) | |
store: Tolerate non-existent GC root directories.
* guix/store/roots.scm (gc-roots): Wrap 'scandir*' call in 'catch'.
* tests/store-roots.scm ("gc-roots, initial"): New test. Move
'open-connection' call below.
| -rw-r--r-- | guix/store/roots.scm | 12 | ||||
| -rw-r--r-- | tests/store-roots.scm | 18 |
2 files changed, 25 insertions, 5 deletions
diff --git a/guix/store/roots.scm b/guix/store/roots.scm index 222f69c5c0..6b949b5a86 100644 --- a/guix/store/roots.scm +++ b/guix/store/roots.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2017, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012-2014, 2017, 2019, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -105,7 +105,15 @@ are user-controlled symlinks stored anywhere on the file system." (map (match-lambda ((file . properties) (cons (scope file) properties))) - (scandir* directory regular?))))) + (catch 'system-error + (lambda () + (scandir* directory regular?)) + (lambda args + (if (= ENOENT + (system-error-errno + args)) + '() + (apply throw args)))))))) (loop (append rest (map first sub-directories)) (append (map canonical-root (filter symlink? files)) roots) diff --git a/tests/store-roots.scm b/tests/store-roots.scm index 5bcf1bc87e..9877987a65 100644 --- a/tests/store-roots.scm +++ b/tests/store-roots.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019, 2023 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,14 +21,26 @@ #:use-module (guix store) #:use-module (guix store roots) #:use-module ((guix utils) #:select (call-with-temporary-directory)) + #:use-module ((guix build utils) #:select (delete-file-recursively)) + #:use-module ((guix config) #:select (%state-directory)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64)) -(define %store - (open-connection)) +(define %store #f) (test-begin "store-roots") +(test-equal "gc-roots, initial" + (list (string-append %state-directory "/profiles")) + (begin + ;; 'gc-roots' should gracefully handle lack of that directory. + (delete-file-recursively (string-append %state-directory "/profiles")) + (gc-roots))) + +;; The 'open-connection' call below gets guix-daemon to create +;; %STATE-DIRECTORY/profiles. +(set! %store (open-connection)) + (test-assert "gc-roots, regular root" (let* ((item (add-text-to-store %store "something" (random-text))) |