mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
fbdb7b9526
commit
19c924af4f
4 changed files with 95 additions and 48 deletions
|
@ -45,6 +45,7 @@
|
||||||
(eval . (put 'manifest-pattern 'scheme-indent-function 0))
|
(eval . (put 'manifest-pattern 'scheme-indent-function 0))
|
||||||
(eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
|
(eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
|
||||||
(eval . (put 'with-store '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-error-handling 'scheme-indent-function 0))
|
||||||
(eval . (put 'with-mutex 'scheme-indent-function 1))
|
(eval . (put 'with-mutex 'scheme-indent-function 1))
|
||||||
(eval . (put 'with-atomic-file-output 'scheme-indent-function 1))
|
(eval . (put 'with-atomic-file-output 'scheme-indent-function 1))
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -17,6 +17,7 @@
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (guix tests)
|
(define-module (guix tests)
|
||||||
|
#:use-module ((guix config) #:select (%storedir %localstatedir))
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
|
@ -30,6 +31,7 @@ (define-module (guix tests)
|
||||||
#:use-module (ice-9 binary-ports)
|
#:use-module (ice-9 binary-ports)
|
||||||
#:use-module (web uri)
|
#:use-module (web uri)
|
||||||
#:export (open-connection-for-tests
|
#:export (open-connection-for-tests
|
||||||
|
with-external-store
|
||||||
random-text
|
random-text
|
||||||
random-bytevector
|
random-bytevector
|
||||||
file=?
|
file=?
|
||||||
|
@ -74,6 +76,39 @@ (define* (open-connection-for-tests #:optional (uri (%daemon-socket-uri)))
|
||||||
|
|
||||||
store)))
|
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)
|
(define (random-seed)
|
||||||
(or (and=> (getenv "GUIX_TESTS_RANDOM_SEED")
|
(or (and=> (getenv "GUIX_TESTS_RANDOM_SEED")
|
||||||
number->string)
|
number->string)
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
# GNU Guix --- Functional package management for GNU
|
# GNU Guix --- Functional package management for GNU
|
||||||
# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
|
# Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
|
||||||
|
# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
|
||||||
#
|
#
|
||||||
# This file is part of GNU Guix.
|
# This file is part of GNU Guix.
|
||||||
#
|
#
|
||||||
|
@ -28,26 +29,33 @@ fi
|
||||||
|
|
||||||
guix pack --version
|
guix pack --version
|
||||||
|
|
||||||
# FIXME: Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa,
|
# Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa, 'guix pack'
|
||||||
# '--bootstrap' is mostly ineffective since 'guix pack' produces derivations
|
# produces derivations that refer to guile-sqlite3 and libgcrypt. To make
|
||||||
# that refer to guile-sqlite3 and libgcrypt. For now we just skip the test.
|
# that relatively inexpensive, run the test in the user's global store if
|
||||||
exit 77
|
# 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.
|
NIX_STORE_DIR="`guile -c '(use-modules (guix config))(display %storedir)'`"
|
||||||
GUIX_BUILD_OPTIONS="--no-substitutes"
|
localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
|
||||||
export GUIX_BUILD_OPTIONS
|
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.
|
# 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.
|
# Build a tarball (with compression). Check that '-e' works as well.
|
||||||
out1="`guix pack --bootstrap guile-bootstrap`"
|
out1="`guix pack guile-bootstrap`"
|
||||||
out2="`guix pack --bootstrap -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
|
out2="`guix pack -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
|
||||||
test -n "$out1"
|
test -n "$out1"
|
||||||
test "$out1" = "$out2"
|
test "$out1" = "$out2"
|
||||||
|
|
||||||
# Build a tarball with a symlink.
|
# 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
|
# 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
|
# exists because /opt/gnu/bin may be an absolute symlink to a store item that
|
||||||
|
|
|
@ -29,15 +29,12 @@ (define-module (test-pack)
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
#:use-module (srfi srfi-64))
|
#:use-module (srfi srfi-64))
|
||||||
|
|
||||||
(define %store
|
|
||||||
(open-connection-for-tests))
|
|
||||||
|
|
||||||
;; Globally disable grafts because they can trigger early builds.
|
;; Globally disable grafts because they can trigger early builds.
|
||||||
(%graft? #f)
|
(%graft? #f)
|
||||||
|
|
||||||
(define-syntax-rule (test-assertm name exp)
|
(define-syntax-rule (test-assertm name store exp)
|
||||||
(test-assert name
|
(test-assert name
|
||||||
(run-with-store %store exp
|
(run-with-store store exp
|
||||||
#:guile-for-build (%guile-for-build))))
|
#:guile-for-build (%guile-for-build))))
|
||||||
|
|
||||||
(define %gzip-compressor
|
(define %gzip-compressor
|
||||||
|
@ -51,13 +48,15 @@ (define %tar-bootstrap %bootstrap-coreutils&co)
|
||||||
|
|
||||||
(test-begin "pack")
|
(test-begin "pack")
|
||||||
|
|
||||||
;; FIXME: The following test would rebuild the world (and likely fail) as a
|
;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of
|
||||||
;; consequence of commit c45477d2a1a651485feede20fe0f3d15aec48b39 (and related
|
;; commit c45477d2a1a651485feede20fe0f3d15aec48b39 and related changes. Thus,
|
||||||
;; changes) that made guile-sqlite3 a dependency of the derivation.
|
;; run it on the user's store, if it's available, on the grounds that these
|
||||||
;; See <https://bugs.gnu.org/32184>.
|
;; dependencies may be already there, or we can get substitutes or build them
|
||||||
(test-skip 1)
|
;; quite inexpensively; see <https://bugs.gnu.org/32184>.
|
||||||
|
|
||||||
(test-assertm "self-contained-tarball"
|
(with-external-store store
|
||||||
|
(unless store (tests-skip 1))
|
||||||
|
(test-assertm "self-contained-tarball" store
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((profile (profile-derivation (packages->manifest
|
((profile (profile-derivation (packages->manifest
|
||||||
(list %bootstrap-guile))
|
(list %bootstrap-guile))
|
||||||
|
@ -82,6 +81,10 @@ (define %tar-bootstrap %bootstrap-coreutils&co)
|
||||||
(string=? (string-append ".." #$profile
|
(string=? (string-append ".." #$profile
|
||||||
"/bin/guile")
|
"/bin/guile")
|
||||||
(readlink "bin/Guile"))))))))
|
(readlink "bin/Guile"))))))))
|
||||||
(built-derivations (list check))))
|
(built-derivations (list check)))))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; eval: (put 'test-assertm 'scheme-indent-function 2)
|
||||||
|
;; End:
|
||||||
|
|
Loading…
Reference in a new issue