summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2018-11-07 21:09:57 +0100
committerMarius Bakke <mbakke@fastmail.com>2018-11-07 21:09:57 +0100
commit55174e668f2985d1c4efda4fbf58f4061dde0db2 (patch)
treef55f7e50fff1a1c3d1e6d2e932a7ef19347e5011 /tests
parent1badc85068ee0be2a028c1b94a3dd285901bc391 (diff)
parentb31e1561611ebe4916890183b24e6e13cb83bf59 (diff)
downloadpatches-55174e668f2985d1c4efda4fbf58f4061dde0db2.tar
patches-55174e668f2985d1c4efda4fbf58f4061dde0db2.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/guix-pack-relocatable.sh61
-rw-r--r--tests/guix-pack.sh28
-rw-r--r--tests/pack.scm156
3 files changed, 211 insertions, 34 deletions
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
new file mode 100644
index 0000000000..554416627b
--- /dev/null
+++ b/tests/guix-pack-relocatable.sh
@@ -0,0 +1,61 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the 'guix pack --relocatable' using the external store, if any.
+#
+
+guix pack --version
+
+# 'guix pack --relocatable' requires a C compiler and libc.a, which our
+# bootstrap binaries don't provide. To make the test relatively inexpensive,
+# run it on the user's global store if possible, on the grounds that binaries
+# may already be there or can be built or downloaded inexpensively.
+
+NIX_STORE_DIR="`guile -c '(use-modules (guix config))(display %storedir)'`"
+localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
+GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
+export NIX_STORE_DIR GUIX_DAEMON_SOCKET
+
+if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
+then
+ exit 77
+fi
+
+STORE_PARENT="`dirname $NIX_STORE_DIR`"
+export STORE_PARENT
+if test "$STORE_PARENT" = "/"; then exit 77; fi
+
+# This test requires user namespaces and associated command-line tools.
+if ! unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"'
+then
+ exit 77
+fi
+
+test_directory="`mktemp -d`"
+export test_directory
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
+
+tarball="`guix pack -R -S /Bin=bin sed`"
+(cd "$test_directory"; tar xvf "$tarball")
+
+# Run that relocatable 'sed' in a user namespace where we "erase" the store by
+# mounting an empty file system on top of it. That way, we exercise the
+# wrapper code that creates the user namespace and bind-mounts the store.
+unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"; echo "$STORE_PARENT"/*; "$test_directory/Bin/sed" --version > "$test_directory/output"'
+grep 'GNU sed' "$test_directory/output"
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index cd721a60e9..a43f4d128f 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -29,39 +29,27 @@ fi
guix pack --version
-# Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa, 'guix pack'
-# produces derivations that refer to guile-sqlite3 and libgcrypt. To make
-# that relatively inexpensive, run the test in the user's global store if
-# possible, on the grounds that binaries may already be there or can be built
-# or downloaded inexpensively.
-
-NIX_STORE_DIR="`guile -c '(use-modules (guix config))(display %storedir)'`"
-localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
-GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
-export NIX_STORE_DIR GUIX_DAEMON_SOCKET
-
-if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
-then
- exit 77
-fi
+# Use --no-substitutes because we need to verify we can do this ourselves.
+GUIX_BUILD_OPTIONS="--no-substitutes"
+export GUIX_BUILD_OPTIONS
# Build a tarball with no compression.
-guix pack --compression=none guile-bootstrap
+guix pack --compression=none --bootstrap guile-bootstrap
# Build a tarball (with compression). Check that '-e' works as well.
-out1="`guix pack guile-bootstrap`"
-out2="`guix pack -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
+out1="`guix pack --bootstrap guile-bootstrap`"
+out2="`guix pack --bootstrap -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
test -n "$out1"
test "$out1" = "$out2"
# Build a tarball with a symlink.
-the_pack="`guix pack -S /opt/gnu/bin=bin guile-bootstrap`"
+the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
# Try to extract it. Note: we cannot test whether /opt/gnu/bin/guile itself
# exists because /opt/gnu/bin may be an absolute symlink to a store item that
# has been GC'd.
test_directory="`mktemp -d`"
-trap 'rm -rf "$test_directory"' EXIT
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
cd "$test_directory"
tar -xf "$the_pack"
test -L opt/gnu/bin
diff --git a/tests/pack.scm b/tests/pack.scm
index 4eb5be92ff..40473a9fe9 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -22,20 +22,26 @@
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix profiles)
+ #:use-module (guix packages)
#:use-module (guix monads)
#:use-module (guix grafts)
#:use-module (guix tests)
#:use-module (guix gexp)
#:use-module (gnu packages bootstrap)
+ #:use-module ((gnu packages compression) #:select (squashfs-tools-next))
#:use-module (srfi srfi-64))
+(define %store
+ (open-connection-for-tests))
+
;; Globally disable grafts because they can trigger early builds.
(%graft? #f)
(define-syntax-rule (test-assertm name store exp)
(test-assert name
- (run-with-store store exp
- #:guile-for-build (%guile-for-build))))
+ (let ((guile (package-derivation store %bootstrap-guile)))
+ (run-with-store store exp
+ #:guile-for-build guile))))
(define %gzip-compressor
;; Compressor that uses the bootstrap 'gzip'.
@@ -48,6 +54,58 @@
(test-begin "pack")
+(unless (network-reachable?) (test-skip 1))
+(test-assertm "self-contained-tarball" %store
+ (mlet* %store-monad
+ ((profile (profile-derivation (packages->manifest
+ (list %bootstrap-guile))
+ #:hooks '()
+ #:locales? #f))
+ (tarball (self-contained-tarball "pack" profile
+ #:symlinks '(("/bin/Guile"
+ -> "bin/guile"))
+ #:compressor %gzip-compressor
+ #:archiver %tar-bootstrap))
+ (check (gexp->derivation
+ "check-tarball"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-1))
+
+ (define store
+ ;; The unpacked store.
+ (string-append "." (%store-directory) "/"))
+
+ (define (canonical? file)
+ ;; Return #t if FILE is read-only and its mtime is 1.
+ (let ((st (lstat file)))
+ (or (not (string-prefix? store file))
+ (eq? 'symlink (stat:type st))
+ (and (= 1 (stat:mtime st))
+ (zero? (logand #o222
+ (stat:mode st)))))))
+
+ (define bin
+ (string-append "." #$profile "/bin"))
+
+ (setenv "PATH"
+ (string-append #$%tar-bootstrap "/bin"))
+ (system* "tar" "xvf" #$tarball)
+ (mkdir #$output)
+ (exit
+ (and (file-exists? (string-append bin "/guile"))
+ (file-exists? store)
+ (every canonical?
+ (find-files "." (const #t)
+ #:directories? #t))
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (readlink bin))
+ (string=? (string-append ".." #$profile
+ "/bin/guile")
+ (readlink "bin/Guile")))))))))
+ (built-derivations (list check))))
+
;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of
;; commit c45477d2a1a651485feede20fe0f3d15aec48b39 and related changes. Thus,
;; run it on the user's store, if it's available, on the grounds that these
@@ -56,17 +114,15 @@
(with-external-store store
(unless store (test-skip 1))
- (test-assertm "self-contained-tarball" store
+ (test-assertm "self-contained-tarball + localstatedir" store
(mlet* %store-monad
- ((profile (profile-derivation (packages->manifest
+ ((guile (set-guile-for-build (default-guile)))
+ (profile (profile-derivation (packages->manifest
(list %bootstrap-guile))
#:hooks '()
#:locales? #f))
- (tarball (self-contained-tarball "pack" profile
- #:symlinks '(("/bin/Guile"
- -> "bin/guile"))
- #:compressor %gzip-compressor
- #:archiver %tar-bootstrap))
+ (tarball (self-contained-tarball "tar-pack" profile
+ #:localstatedir? #t))
(check (gexp->derivation
"check-tarball"
#~(let ((bin (string-append "." #$profile "/bin")))
@@ -75,12 +131,84 @@
(system* "tar" "xvf" #$tarball)
(mkdir #$output)
(exit
- (and (file-exists? (string-append bin "/guile"))
+ (and (file-exists? "var/guix/db/db.sqlite")
(string=? (string-append #$%bootstrap-guile "/bin")
- (readlink bin))
- (string=? (string-append ".." #$profile
- "/bin/guile")
- (readlink "bin/Guile"))))))))
+ (readlink bin))))))))
+ (built-derivations (list check))))
+
+ (unless store (test-skip 1))
+ (test-assertm "docker-image + localstatedir" store
+ (mlet* %store-monad
+ ((guile (set-guile-for-build (default-guile)))
+ (profile (profile-derivation (packages->manifest
+ (list %bootstrap-guile))
+ #:hooks '()
+ #:locales? #f))
+ (tarball (docker-image "docker-pack" profile
+ #:symlinks '(("/bin/Guile" -> "bin/guile"))
+ #:localstatedir? #t))
+ (check (gexp->derivation
+ "check-tarball"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (define bin
+ (string-append "." #$profile "/bin"))
+
+ (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+ (mkdir "base")
+ (with-directory-excursion "base"
+ (invoke "tar" "xvf" #$tarball))
+
+ (match (find-files "base" "layer.tar")
+ ((layer)
+ (invoke "tar" "xvf" layer)))
+
+ (when
+ (and (file-exists? (string-append bin "/guile"))
+ (file-exists? "var/guix/db/db.sqlite")
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (pk 'binlink (readlink bin)))
+ (string=? (string-append #$profile "/bin/guile")
+ (pk 'guilelink (readlink "bin/Guile"))))
+ (mkdir #$output)))))))
+ (built-derivations (list check))))
+
+ (unless store (test-skip 1))
+ (test-assertm "squashfs-image + localstatedir" store
+ (mlet* %store-monad
+ ((guile (set-guile-for-build (default-guile)))
+ (profile (profile-derivation (packages->manifest
+ (list %bootstrap-guile))
+ #:hooks '()
+ #:locales? #f))
+ (image (squashfs-image "squashfs-pack" profile
+ #:symlinks '(("/bin" -> "bin"))
+ #:localstatedir? #t))
+ (check (gexp->derivation
+ "check-tarball"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (define bin
+ (string-append "." #$profile "/bin"))
+
+ (setenv "PATH"
+ (string-append #$squashfs-tools-next "/bin"))
+ (invoke "unsquashfs" #$image)
+ (with-directory-excursion "squashfs-root"
+ (when (and (file-exists? (string-append bin
+ "/guile"))
+ (file-exists? "var/guix/db/db.sqlite")
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (pk 'binlink (readlink bin)))
+ (string=? (string-append #$profile "/bin")
+ (pk 'guilelink (readlink "bin"))))
+ (mkdir #$output))))))))
(built-derivations (list check)))))
(test-end)