diff options
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | guix/tests.scm | 37 | ||||
| -rw-r--r-- | tests/guix-pack.sh | 30 | ||||
| -rw-r--r-- | tests/pack.scm | 75 |
4 files changed, 95 insertions, 48 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 793117c0ae..1a3a05f100 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -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)) diff --git a/guix/tests.scm b/guix/tests.scm index 06e9f8da0b..bcf9b990e5 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -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) diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index bf367fa429..cd721a60e9 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -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 diff --git a/tests/pack.scm b/tests/pack.scm index c57c6848ff..7f867894c2 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -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: |