tests: Run 'guix pack' tests using the external store.

Fixes <https://bugs.gnu.org/32184>.

* guix/tests.scm (call-with-external-store): New procedure.
(with-external-store): New macro.
* tests/pack.scm (%store): Remove.
(test-assertm): Add 'store' parameter.
("self-contained-tarball"): Wrap in 'with-external-store'.
* tests/guix-pack.sh: Connect to the external store, if possible, by
setting NIX_STORE_DIR and GUIX_DAEMON_SOCKET.  Remove most uses of
'--bootstrap'.
This commit is contained in:
Ludovic Courtès 2018-10-19 17:58:00 +02:00
parent fbdb7b9526
commit 19c924af4f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 95 additions and 48 deletions

View File

@ -45,6 +45,7 @@
(eval . (put 'manifest-pattern 'scheme-indent-function 0))
(eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
(eval . (put 'with-store 'scheme-indent-function 1))
(eval . (put 'with-external-store 'scheme-indent-function 1))
(eval . (put 'with-error-handling 'scheme-indent-function 0))
(eval . (put 'with-mutex 'scheme-indent-function 1))
(eval . (put 'with-atomic-file-output 'scheme-indent-function 1))

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 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 (guix tests)
#:use-module ((guix config) #:select (%storedir %localstatedir))
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
@ -30,6 +31,7 @@
#:use-module (ice-9 binary-ports)
#:use-module (web uri)
#:export (open-connection-for-tests
with-external-store
random-text
random-bytevector
file=?
@ -74,6 +76,39 @@
store)))
(define (call-with-external-store proc)
"Call PROC with an open connection to the external store or #f it there is
no external store to talk to."
(parameterize ((%daemon-socket-uri
(string-append %localstatedir
"/guix/daemon-socket/socket"))
(%store-prefix %storedir))
(define store
(catch #t
(lambda ()
(open-connection))
(const #f)))
(dynamic-wind
(const #t)
(lambda ()
;; Since we're using a different store we must clear the
;; package-derivation cache.
(hash-clear! (@@ (guix packages) %derivation-cache))
(proc store))
(lambda ()
(when store
(close-connection store))))))
(define-syntax-rule (with-external-store store exp ...)
"Evaluate EXP with STORE bound to the external store rather than the
temporary test store, or #f if there is no external store to talk to.
This is meant to be used for tests that need to build packages that would be
too expensive to build entirely in the test store."
(call-with-external-store (lambda (store) exp ...)))
(define (random-seed)
(or (and=> (getenv "GUIX_TESTS_RANDOM_SEED")
number->string)

View File

@ -1,5 +1,6 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@ -28,26 +29,33 @@ fi
guix pack --version
# FIXME: Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa,
# '--bootstrap' is mostly ineffective since 'guix pack' produces derivations
# that refer to guile-sqlite3 and libgcrypt. For now we just skip the test.
exit 77
# 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.
# Use --no-substitutes because we need to verify we can do this ourselves.
GUIX_BUILD_OPTIONS="--no-substitutes"
export GUIX_BUILD_OPTIONS
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
# Build a tarball with no compression.
guix pack --compression=none --bootstrap guile-bootstrap
guix pack --compression=none guile-bootstrap
# Build a tarball (with compression). Check that '-e' works as well.
out1="`guix pack --bootstrap guile-bootstrap`"
out2="`guix pack --bootstrap -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
out1="`guix pack guile-bootstrap`"
out2="`guix pack -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
test -n "$out1"
test "$out1" = "$out2"
# Build a tarball with a symlink.
the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
the_pack="`guix pack -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

View File

@ -29,15 +29,12 @@
#:use-module (gnu packages bootstrap)
#: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 exp)
(define-syntax-rule (test-assertm name store exp)
(test-assert name
(run-with-store %store exp
(run-with-store store exp
#:guile-for-build (%guile-for-build))))
(define %gzip-compressor
@ -51,37 +48,43 @@
(test-begin "pack")
;; FIXME: The following test would rebuild the world (and likely fail) as a
;; consequence of commit c45477d2a1a651485feede20fe0f3d15aec48b39 (and related
;; changes) that made guile-sqlite3 a dependency of the derivation.
;; See <https://bugs.gnu.org/32184>.
(test-skip 1)
;; 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
;; dependencies may be already there, or we can get substitutes or build them
;; quite inexpensively; see <https://bugs.gnu.org/32184>.
(test-assertm "self-contained-tarball"
(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"
#~(let ((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"))
(string=? (string-append #$%bootstrap-guile "/bin")
(readlink bin))
(string=? (string-append ".." #$profile
"/bin/guile")
(readlink "bin/Guile"))))))))
(built-derivations (list check))))
(with-external-store store
(unless store (tests-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"
#~(let ((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"))
(string=? (string-append #$%bootstrap-guile "/bin")
(readlink bin))
(string=? (string-append ".." #$profile
"/bin/guile")
(readlink "bin/Guile"))))))))
(built-derivations (list check)))))
(test-end)
;; Local Variables:
;; eval: (put 'test-assertm 'scheme-indent-function 2)
;; End: