tests/file-systems.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (test-file-systems)
  20   #:use-module (guix store)
  21   #:use-module (guix modules)
  22   #:use-module (gnu system file-systems)
  23   #:use-module (srfi srfi-1)
  24   #:use-module (srfi srfi-64)
  25   #:use-module (ice-9 match))
  26
  27 ;; Test the (gnu system file-systems) module.
  28
  29 (test-begin "file-systems")
  30
  31 (test-assert "file-system-needed-for-boot?"
  32   (let-syntax ((dummy-fs (syntax-rules ()
  33                            ((_ directory)
  34                             (file-system
  35                               (device "foo")
  36                               (mount-point directory)
  37                               (type "ext4"))))))
  38     (parameterize ((%store-prefix "/gnu/guix/store"))
  39       (and (file-system-needed-for-boot? (dummy-fs "/"))
  40            (file-system-needed-for-boot? (dummy-fs "/gnu"))
  41            (file-system-needed-for-boot? (dummy-fs "/gnu/guix"))
  42            (file-system-needed-for-boot? (dummy-fs "/gnu/guix/store"))
  43            (not (file-system-needed-for-boot?
  44                  (dummy-fs "/gnu/guix/store/foo")))
  45            (not (file-system-needed-for-boot? (dummy-fs "/gn")))
  46            (not (file-system-needed-for-boot?
  47                  (file-system
  48                    (inherit (dummy-fs (%store-prefix)))
  49                    (device "/foo")
  50                    (flags '(bind-mount read-only)))))))))
  51
  52 (test-assert "does not pull (guix config)"
  53   ;; This module is meant both for the host side and "build side", so make
  54   ;; sure it doesn't pull in (guix config), which depends on the user's
  55   ;; config.
  56   (not (member '(guix config)
  57                (source-module-closure '((gnu system file-systems))))))
  58
  59 (test-equal "does not pull (gnu packages …)"
  60   ;; Same story: (gnu packages …) should not be pulled.
  61   #f
  62   (find (match-lambda
  63           (('gnu 'packages _ ..1) #t)
  64           (_ #f))
  65         (source-module-closure '((gnu system file-systems)))))
  66
  67 (test-end)