tribes/guix
1
0
Fork 1
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-05-28 03:51:53 +02:00
Code Activity

file-systems: 'file-system-needed-for-boot?' is #t for parents of the store.

Browse Source 
Suggested by John Darrington <john@darrington.wattle.id.au>.

* gnu/system/file-systems.scm (%not-slash): New variable.
(file-prefix?): New procedure.
(file-system-needed-for-boot?): Use it to check whether FS holds the
store.
* tests/file-systems.scm ("file-system-needed-for-boot?"): New test.
* gnu/tests/install.scm (%separate-store-os)[file-systems]: Remove
'needed-for-boot?' field for "/gnu".
This commit is contained in:
Ludovic Courtès
2017-01-16 22:33:46 +01:00
parent b91cfa22e1
commit 384344198d
3 changed files with 58 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/file-systems.scm
+23 -1
View File
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,6 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-file-systems)
#:use-module (guix store)
#:use-module (gnu system file-systems)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors))
@@ -50,4 +51,25 @@
(string-contains message "invalid UUID")
(equal? form '(uuid "foobar"))))))
(test-assert "file-system-needed-for-boot?"
(let-syntax ((dummy-fs (syntax-rules ()
((_ directory)
(file-system
(device "foo")
(mount-point directory)
(type "ext4"))))))
(parameterize ((%store-prefix "/gnu/guix/store"))
(and (file-system-needed-for-boot? (dummy-fs "/"))
(file-system-needed-for-boot? (dummy-fs "/gnu"))
(file-system-needed-for-boot? (dummy-fs "/gnu/guix"))
(file-system-needed-for-boot? (dummy-fs "/gnu/guix/store"))
(not (file-system-needed-for-boot?
(dummy-fs "/gnu/guix/store/foo")))
(not (file-system-needed-for-boot? (dummy-fs "/gn")))
(not (file-system-needed-for-boot?
(file-system
(inherit (dummy-fs (%store-prefix)))
(device "/foo")
(flags '(bind-mount read-only)))))))))
(test-end)