me
/
guix
Archived
1
0
Fork 0

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'.
master
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 '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))

View File

@ -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 @@
#: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 @@
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)

View File

@ -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

View File

@ -29,15 +29,12 @@
#: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,37 +48,43 @@
(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
(mlet* %store-monad (unless store (tests-skip 1))
((profile (profile-derivation (packages->manifest (test-assertm "self-contained-tarball" store
(list %bootstrap-guile)) (mlet* %store-monad
#:hooks '() ((profile (profile-derivation (packages->manifest
#:locales? #f)) (list %bootstrap-guile))
(tarball (self-contained-tarball "pack" profile #:hooks '()
#:symlinks '(("/bin/Guile" #:locales? #f))
-> "bin/guile")) (tarball (self-contained-tarball "pack" profile
#:compressor %gzip-compressor #:symlinks '(("/bin/Guile"
#:archiver %tar-bootstrap)) -> "bin/guile"))
(check (gexp->derivation #:compressor %gzip-compressor
"check-tarball" #:archiver %tar-bootstrap))
#~(let ((bin (string-append "." #$profile "/bin"))) (check (gexp->derivation
(setenv "PATH" "check-tarball"
(string-append #$%tar-bootstrap "/bin")) #~(let ((bin (string-append "." #$profile "/bin")))
(system* "tar" "xvf" #$tarball) (setenv "PATH"
(mkdir #$output) (string-append #$%tar-bootstrap "/bin"))
(exit (system* "tar" "xvf" #$tarball)
(and (file-exists? (string-append bin "/guile")) (mkdir #$output)
(string=? (string-append #$%bootstrap-guile "/bin") (exit
(readlink bin)) (and (file-exists? (string-append bin "/guile"))
(string=? (string-append ".." #$profile (string=? (string-append #$%bootstrap-guile "/bin")
"/bin/guile") (readlink bin))
(readlink "bin/Guile")))))))) (string=? (string-append ".." #$profile
(built-derivations (list check)))) "/bin/guile")
(readlink "bin/Guile"))))))))
(built-derivations (list check)))))
(test-end) (test-end)
;; Local Variables:
;; eval: (put 'test-assertm 'scheme-indent-function 2)
;; End: