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

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

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)

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,
+# 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.
-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`"
+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 "$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

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
+;; 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)
+
+;; Local Variables:
+;; eval: (put 'test-assertm 'scheme-indent-function 2)
+;; End: