mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-23 21:17:11 -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:
Ludovic Courtès
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 '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))
|
||||
|
|
|
|||
|
|
@ -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 @@ (define-module (guix tests)
|
|||
#: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 @@ (define* (open-connection-for-tests #:optional (uri (%daemon-socket-uri)))
|
|||
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -29,15 +29,12 @@ (define-module (test-pack)
|
|||
#: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 @@ (define %tar-bootstrap %bootstrap-coreutils&co)
|
|||
|
||||
(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:
|
||||
|
|
|
|||
Loading…
Reference in a new issue