summary refs log tree commit diff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2014-08-23 20:43:51 -0400
committerMark H Weaver <mhw@netris.org>2014-08-23 20:43:51 -0400
commitce3e35ed6af5c502029fb79cb5e2bdbca528d841 (patch)
treef2db16e01972bc8dcf5d69e4c94b8c4da52e9547
parentfa5731baabdb4a9240aad2154847f352aed02d6e (diff)
parentf0dafadcfc0336e8d437f39c3563029eaa0f7953 (diff)
downloadguix-ce3e35ed6af5c502029fb79cb5e2bdbca528d841.tar.gz
Merge branch 'master' into core-updates
-rw-r--r--Makefile.am5
-rw-r--r--THANKS1
-rw-r--r--gnu/packages.scm88
-rw-r--r--gnu/packages/bdw-gc.scm4
-rw-r--r--gnu/packages/gnupg.scm4
-rw-r--r--gnu/packages/video.scm4
-rw-r--r--guix/download.scm2
-rw-r--r--guix/git-download.scm79
-rw-r--r--guix/profiles.scm221
-rw-r--r--guix/scripts/package.scm145
-rw-r--r--guix/svn-download.scm58
-rw-r--r--guix/tests.scm70
-rw-r--r--tests/builders.scm9
-rw-r--r--tests/derivations.scm12
-rw-r--r--tests/gexp.scm15
-rw-r--r--tests/monads.scm6
-rw-r--r--tests/nar.scm19
-rw-r--r--tests/packages.scm9
-rw-r--r--tests/profiles.scm35
-rw-r--r--tests/store.scm14
-rw-r--r--tests/union.scm9
21 files changed, 486 insertions, 323 deletions
diff --git a/Makefile.am b/Makefile.am
index 17a676ac54..fff5958355 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -99,6 +99,9 @@ MODULES +=					\
 
 endif BUILD_DAEMON_OFFLOAD
 
+# Internal module with test suite support.
+noinst_DATA = guix/tests.scm
+
 # Because of the autoload hack in (guix build download), we must build it
 # first to avoid errors on systems where (gnutls) is unavailable.
 guix/scripts/download.go: guix/build/download.go
@@ -113,7 +116,7 @@ KCONFIGS =					\
 EXAMPLES =					\
   gnu/system/os-config.tmpl
 
-GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go
+GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go guix/tests.go
 
 nobase_dist_guilemodule_DATA = $(MODULES) $(KCONFIGS) $(EXAMPLES)
 nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm
diff --git a/THANKS b/THANKS
index 95427f9bee..d15cafa987 100644
--- a/THANKS
+++ b/THANKS
@@ -16,6 +16,7 @@ infrastructure help:
 	     John Darrington <jmd@gnu.org>
 	   Rafael Ferreira <rafael.f.f1@gmail.com>
 	Christian Grothoff <christian@grothoff.org>
+          Brandon Invergo <brandon@gnu.org>
 	  Jeffrin Jose <ahiliation@yahoo.co.in>
 	     Kete <kete@ninthfloor.org>
              Alex Kost <alezost@gmail.com>
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 77d9d3ee82..14ad75561c 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -22,6 +22,8 @@
   #:use-module (guix packages)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module ((guix ftp-client) #:select (ftp-open))
+  #:use-module (guix gnu-maintenance)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
@@ -41,7 +43,9 @@
 
             package-direct-dependents
             package-transitive-dependents
-            package-covering-dependents))
+            package-covering-dependents
+
+            check-package-freshness))
 
 ;;; Commentary:
 ;;;
@@ -50,8 +54,6 @@
 ;;;
 ;;; Code:
 
-(define _ (cut gettext <> "guix"))
-
 ;; By default, we store patches and bootstrap binaries alongside Guile
 ;; modules.  This is so that these extra files can be found without
 ;; requiring a special setup, such as a specific installation directory
@@ -60,7 +62,7 @@
 
 (define %patch-path
   (make-parameter
-   (map (cut string-append <>  "/gnu/packages/patches")
+   (map (cut string-append <> "/gnu/packages/patches")
         %load-path)))
 
 (define %bootstrap-binaries-path
@@ -246,3 +248,81 @@ include all of PACKAGES and all packages that depend on PACKAGES."
      (lambda (node) (vhash-refq dependency-dag node))
      ;; Start with the dependents to avoid including PACKAGES in the result.
      (package-direct-dependents packages))))
+
+
+(define %sigint-prompt
+  ;; The prompt to jump to upon SIGINT.
+  (make-prompt-tag "interruptible"))
+
+(define (call-with-sigint-handler thunk handler)
+  "Call THUNK and return its value.  Upon SIGINT, call HANDLER with the signal
+number in the context of the continuation of the call to this function, and
+return its return value."
+  (call-with-prompt %sigint-prompt
+                    (lambda ()
+                      (sigaction SIGINT
+                        (lambda (signum)
+                          (sigaction SIGINT SIG_DFL)
+                          (abort-to-prompt %sigint-prompt signum)))
+                      (dynamic-wind
+                        (const #t)
+                        thunk
+                        (cut sigaction SIGINT SIG_DFL)))
+                    (lambda (k signum)
+                      (handler signum))))
+
+(define-syntax-rule (waiting exp fmt rest ...)
+  "Display the given message while EXP is being evaluated."
+  (let* ((message (format #f fmt rest ...))
+         (blank   (make-string (string-length message) #\space)))
+    (display message (current-error-port))
+    (force-output (current-error-port))
+    (call-with-sigint-handler
+     (lambda ()
+       (dynamic-wind
+         (const #f)
+         (lambda () exp)
+         (lambda ()
+           ;; Clear the line.
+           (display #\cr (current-error-port))
+           (display blank (current-error-port))
+           (display #\cr (current-error-port))
+           (force-output (current-error-port)))))
+     (lambda (signum)
+       (format (current-error-port) "  interrupted by signal ~a~%" SIGINT)
+       #f))))
+
+(define ftp-open*
+  ;; Memoizing version of `ftp-open'.  The goal is to avoid initiating a new
+  ;; FTP connection for each package, esp. since most of them are to the same
+  ;; server.  This has a noticeable impact when doing "guix upgrade -u".
+  (memoize ftp-open))
+
+(define (check-package-freshness package)
+  "Check whether PACKAGE has a newer version available upstream, and report
+it."
+  ;; TODO: Automatically inject the upstream version when desired.
+
+  (catch #t
+    (lambda ()
+      (when (false-if-exception (gnu-package? package))
+        (let ((name      (package-name package))
+              (full-name (package-full-name package)))
+          (match (waiting (latest-release name
+                                          #:ftp-open ftp-open*
+                                          #:ftp-close (const #f))
+                          (_ "looking for the latest release of GNU ~a...") name)
+            ((latest-version . _)
+             (when (version>? latest-version full-name)
+               (format (current-error-port)
+                       (_ "~a: note: using ~a \
+but ~a is available upstream~%")
+                       (location->string (package-location package))
+                       full-name latest-version)))
+            (_ #t)))))
+    (lambda (key . args)
+      ;; Silently ignore networking errors rather than preventing
+      ;; installation.
+      (case key
+        ((getaddrinfo-error ftp-error) #f)
+        (else (apply throw key args))))))
diff --git a/gnu/packages/bdw-gc.scm b/gnu/packages/bdw-gc.scm
index df7cd1b489..66158912d7 100644
--- a/gnu/packages/bdw-gc.scm
+++ b/gnu/packages/bdw-gc.scm
@@ -27,14 +27,14 @@
 (define-public libgc-7.2
   (package
    (name "libgc")
-   (version "7.2e")
+   (version "7.2f")
    (source (origin
             (method url-fetch)
             (uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
                                 version ".tar.gz"))
             (sha256
              (base32
-              "0jxgr71rhk58dzc1ihqs51vldh2qs1m154bn41qh6q1dm145nc89"))))
+              "119x7p1cqw40mpwj80xfq879l9m1dkc7vbc1f3bz3kvkf8bf6p16"))))
    (build-system gnu-build-system)
    (arguments
     ;; Make it so that we don't rely on /proc.  This is especially useful in
diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm
index 384ec6289e..3207c74b0b 100644
--- a/gnu/packages/gnupg.scm
+++ b/gnu/packages/gnupg.scm
@@ -96,7 +96,7 @@ generation.")
 
 (define-public libgcrypt-1.5
   (package (inherit libgcrypt)
-    (version "1.5.3")
+    (version "1.5.4")
     (source
      (origin
       (method url-fetch)
@@ -104,7 +104,7 @@ generation.")
                           version ".tar.bz2"))
       (sha256
        (base32
-        "1lar8y3lh61zl5flljpz540d78g99h4d5idfwrfw8lm3gm737xdw"))))))
+        "0czvqxkzd5y872ipy6s010ifwdwv29sqbnqc4pf56sd486gqvy6m"))))))
 
 (define-public libassuan
   (package
diff --git a/gnu/packages/video.scm b/gnu/packages/video.scm
index 23c63fabdb..2873c49e3b 100644
--- a/gnu/packages/video.scm
+++ b/gnu/packages/video.scm
@@ -58,14 +58,14 @@
 (define-public ffmpeg
   (package
     (name "ffmpeg")
-    (version "2.3.1")
+    (version "2.3.3")
     (source (origin
              (method url-fetch)
              (uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-"
                                  version ".tar.bz2"))
              (sha256
               (base32
-               "10w1sw5c9qjlaqlr77r3znzm7y0y9qpkni0mfr9rhij22562yspf"))))
+               "0ik4c06anh49r5b0d3rq9if4zl6ysjsa341655kzw22fl880sk5v"))))
     (build-system gnu-build-system)
     (inputs
      `(("fontconfig" ,fontconfig)
diff --git a/guix/download.scm b/guix/download.scm
index 22c3ba19ca..92d08fc2bd 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -185,7 +185,7 @@
        "http://ftp.debian.org/debian/"))))
 
 (define (gnutls-package)
-  "Return the GnuTLS package for SYSTEM."
+  "Return the default GnuTLS package."
   (let ((module (resolve-interface '(gnu packages gnutls))))
     (module-ref module 'gnutls)))
 
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 43d190db54..5691e8a870 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -17,8 +17,9 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix git-download)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
   #:use-module (guix records)
-  #:use-module (guix derivations)
   #:use-module (guix packages)
   #:autoload   (guix build-system gnu) (standard-inputs)
   #:use-module (ice-9 match)
@@ -46,9 +47,15 @@
   (recursive? git-reference-recursive?   ; whether to recurse into sub-modules
               (default #f)))
 
+(define (git-package)
+  "Return the default Git package."
+  (let ((distro (resolve-interface '(gnu packages version-control))))
+    (module-ref distro 'git)))
+
 (define* (git-fetch store ref hash-algo hash
                     #:optional name
-                    #:key (system (%current-system)) guile git)
+                    #:key (system (%current-system)) guile
+                    (git (git-package)))
   "Return a fixed-output derivation in STORE that fetches REF, a
 <git-reference> object.  The output is expected to have recursive hash HASH of
 type HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if
@@ -62,15 +69,6 @@ type HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if
               (guile  (module-ref distro 'guile-final)))
          (package-derivation store guile system)))))
 
-  (define git-for-build
-    (match git
-      ((? package?)
-       (package-derivation store git system))
-      (#f                                         ; the default
-       (let* ((distro (resolve-interface '(gnu packages version-control)))
-              (git    (module-ref distro 'git)))
-         (package-derivation store git system)))))
-
   (define inputs
     ;; When doing 'git clone --recursive', we need sed, grep, etc. to be
     ;; available so that 'git submodule' works.
@@ -78,36 +76,37 @@ type HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if
         (standard-inputs (%current-system))
         '()))
 
-  (let* ((command (string-append (derivation->output-path git-for-build)
-                                 "/bin/git"))
-         (builder `(begin
-                     (use-modules (guix build git)
-                                  (guix build utils)
-                                  (ice-9 match))
+  (define build
+    #~(begin
+        (use-modules (guix build git)
+                     (guix build utils)
+                     (ice-9 match))
+
+        ;; The 'git submodule' commands expects Coreutils, sed,
+        ;; grep, etc. to be in $PATH.
+        (set-path-environment-variable "PATH" '("bin")
+                                       (match '#$inputs
+                                         (((names dirs) ...)
+                                          dirs)))
 
-                     ;; The 'git submodule' commands expects Coreutils, sed,
-                     ;; grep, etc. to be in $PATH.
-                     (set-path-environment-variable "PATH" '("bin")
-                                                    (match %build-inputs
-                                                      (((names . dirs) ...)
-                                                       dirs)))
+        (git-fetch '#$(git-reference-url ref)
+                   '#$(git-reference-commit ref)
+                   #$output
+                   #:recursive? '#$(git-reference-recursive? ref)
+                   #:git-command (string-append #$git "/bin/git"))))
 
-                     (git-fetch ',(git-reference-url ref)
-                                ',(git-reference-commit ref)
-                                %output
-                                #:recursive? ',(git-reference-recursive? ref)
-                                #:git-command ',command))))
-    (build-expression->derivation store (or name "git-checkout") builder
-                                  #:system system
-                                  #:local-build? #t
-                                  #:inputs `(("git" ,git-for-build)
-                                             ,@inputs)
-                                  #:hash-algo hash-algo
-                                  #:hash hash
-                                  #:recursive? #t
-                                  #:modules '((guix build git)
-                                              (guix build utils))
-                                  #:guile-for-build guile-for-build
-                                  #:local-build? #t)))
+  (run-with-store store
+    (gexp->derivation (or name "git-checkout") build
+                      #:system system
+                      #:local-build? #t
+                      #:hash-algo hash-algo
+                      #:hash hash
+                      #:recursive? #t
+                      #:modules '((guix build git)
+                                  (guix build utils))
+                      #:guile-for-build guile-for-build
+                      #:local-build? #t)
+    #:guile-for-build guile-for-build
+    #:system system))
 
 ;;; git-download.scm ends here
diff --git a/guix/profiles.scm b/guix/profiles.scm
index e921566e5a..bf86624e43 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,14 +19,17 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix profiles)
+  #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix records)
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix gexp)
+  #:use-module (guix monads)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-19)
@@ -51,6 +55,13 @@
             manifest-installed?
             manifest-matching-entries
 
+            manifest-transaction
+            manifest-transaction?
+            manifest-transaction-install
+            manifest-transaction-remove
+            manifest-perform-transaction
+            manifest-show-transaction
+
             profile-manifest
             package->manifest-entry
             profile-derivation
@@ -244,39 +255,191 @@ Remove MANIFEST entries that have the same name and output as ENTRIES."
 
 
 ;;;
-;;; Profiles.
+;;; Manifest transactions.
 ;;;
 
-(define (profile-derivation manifest)
-  "Return a derivation that builds a profile (aka. 'user environment') with
-the given MANIFEST."
-  (define inputs
-    (append-map (match-lambda
-                 (($ <manifest-entry> name version
-                                      output (? package? package) deps)
-                  `((,package ,output) ,@deps))
-                 (($ <manifest-entry> name version output path deps)
-                  ;; Assume PATH and DEPS are already valid.
-                  `(,path ,@deps)))
-                (manifest-entries manifest)))
-
-  (define builder
-    #~(begin
-        (use-modules (ice-9 pretty-print)
-                     (guix build union))
-
-        (setvbuf (current-output-port) _IOLBF)
-        (setvbuf (current-error-port) _IOLBF)
+(define-record-type* <manifest-transaction> manifest-transaction
+  make-manifest-transaction
+  manifest-transaction?
+  (install manifest-transaction-install ; list of <manifest-entry>
+           (default '()))
+  (remove  manifest-transaction-remove  ; list of <manifest-pattern>
+           (default '())))
+
+(define (manifest-perform-transaction manifest transaction)
+  "Perform TRANSACTION on MANIFEST and return new manifest."
+  (let ((install (manifest-transaction-install transaction))
+        (remove  (manifest-transaction-remove transaction)))
+    (manifest-add (manifest-remove manifest remove)
+                  install)))
+
+(define* (manifest-show-transaction store manifest transaction
+                                    #:key dry-run?)
+  "Display what will/would be installed/removed from MANIFEST by TRANSACTION."
+  (define (package-strings name version output item)
+    (map (lambda (name version output item)
+           (format #f "   ~a-~a\t~a\t~a" name version output
+                   (if (package? item)
+                       (package-output store item output)
+                       item)))
+         name version output item))
+
+  (let* ((remove (manifest-matching-entries
+                  manifest (manifest-transaction-remove transaction)))
+         (install/upgrade (manifest-transaction-install transaction))
+         (install '())
+         (upgrade (append-map
+                   (lambda (entry)
+                     (let ((matching
+                            (manifest-matching-entries
+                             manifest
+                             (list (manifest-pattern
+                                    (name   (manifest-entry-name entry))
+                                    (output (manifest-entry-output entry)))))))
+                       (when (null? matching)
+                         (set! install (cons entry install)))
+                       matching))
+                   install/upgrade)))
+    (match remove
+      ((($ <manifest-entry> name version output item _) ..1)
+       (let ((len    (length name))
+             (remove (package-strings name version output item)))
+         (if dry-run?
+             (format (current-error-port)
+                     (N_ "The following package would be removed:~%~{~a~%~}~%"
+                         "The following packages would be removed:~%~{~a~%~}~%"
+                         len)
+                     remove)
+             (format (current-error-port)
+                     (N_ "The following package will be removed:~%~{~a~%~}~%"
+                         "The following packages will be removed:~%~{~a~%~}~%"
+                         len)
+                     remove))))
+      (_ #f))
+    (match upgrade
+      ((($ <manifest-entry> name version output item _) ..1)
+       (let ((len     (length name))
+             (upgrade (package-strings name version output item)))
+         (if dry-run?
+             (format (current-error-port)
+                     (N_ "The following package would be upgraded:~%~{~a~%~}~%"
+                         "The following packages would be upgraded:~%~{~a~%~}~%"
+                         len)
+                     upgrade)
+             (format (current-error-port)
+                     (N_ "The following package will be upgraded:~%~{~a~%~}~%"
+                         "The following packages will be upgraded:~%~{~a~%~}~%"
+                         len)
+                     upgrade))))
+      (_ #f))
+    (match install
+      ((($ <manifest-entry> name version output item _) ..1)
+       (let ((len     (length name))
+             (install (package-strings name version output item)))
+         (if dry-run?
+             (format (current-error-port)
+                     (N_ "The following package would be installed:~%~{~a~%~}~%"
+                         "The following packages would be installed:~%~{~a~%~}~%"
+                         len)
+                     install)
+             (format (current-error-port)
+                     (N_ "The following package will be installed:~%~{~a~%~}~%"
+                         "The following packages will be installed:~%~{~a~%~}~%"
+                         len)
+                     install))))
+      (_ #f))))
 
-        (union-build #$output '#$inputs
-                     #:log-port (%make-void-port "w"))
-        (call-with-output-file (string-append #$output "/manifest")
-          (lambda (p)
-            (pretty-print '#$(manifest->gexp manifest) p)))))
+
+;;;
+;;; Profiles.
+;;;
 
-  (gexp->derivation "profile" builder
-                    #:modules '((guix build union))
-                    #:local-build? #t))
+(define (manifest-inputs manifest)
+  "Return the list of inputs for MANIFEST.  Each input has one of the
+following forms:
+
+  (PACKAGE OUTPUT-NAME)
+
+or
+
+  STORE-PATH
+"
+  (append-map (match-lambda
+               (($ <manifest-entry> name version
+                                    output (? package? package) deps)
+                `((,package ,output) ,@deps))
+               (($ <manifest-entry> name version output path deps)
+                ;; Assume PATH and DEPS are already valid.
+                `(,path ,@deps)))
+              (manifest-entries manifest)))
+
+(define (info-dir-file manifest)
+  "Return a derivation that builds the 'dir' file for all the entries of
+MANIFEST."
+  (define texinfo
+    ;; Lazy reference.
+    (module-ref (resolve-interface '(gnu packages texinfo))
+                'texinfo))
+  (define build
+    #~(begin
+        (use-modules (guix build utils)
+                     (srfi srfi-1) (srfi srfi-26)
+                     (ice-9 ftw))
+
+        (define (info-file? file)
+          (or (string-suffix? ".info" file)
+              (string-suffix? ".info.gz" file)))
+
+        (define (info-files top)
+          (let ((infodir (string-append top "/share/info")))
+            (map (cut string-append infodir "/" <>)
+                 (scandir infodir info-file?))))
+
+        (define (install-info info)
+          (zero?
+           (system* (string-append #+texinfo "/bin/install-info")
+                    info (string-append #$output "/share/info/dir"))))
+
+        (mkdir-p (string-append #$output "/share/info"))
+        (every install-info
+               (append-map info-files
+                           '#$(manifest-inputs manifest)))))
+
+  ;; Don't depend on Texinfo when there's nothing to do.
+  (if (null? (manifest-entries manifest))
+      (gexp->derivation "info-dir" #~(mkdir #$output))
+      (gexp->derivation "info-dir" build
+                        #:modules '((guix build utils)))))
+
+(define* (profile-derivation manifest #:key (info-dir? #t))
+  "Return a derivation that builds a profile (aka. 'user environment') with
+the given MANIFEST.  The profile includes a top-level Info 'dir' file, unless
+INFO-DIR? is #f."
+  (mlet %store-monad ((info-dir (if info-dir?
+                                    (info-dir-file manifest)
+                                    (return #f))))
+    (define inputs
+      (if info-dir
+          (cons info-dir (manifest-inputs manifest))
+          (manifest-inputs manifest)))
+
+    (define builder
+      #~(begin
+          (use-modules (ice-9 pretty-print)
+                       (guix build union))
+
+          (setvbuf (current-output-port) _IOLBF)
+          (setvbuf (current-error-port) _IOLBF)
+
+          (union-build #$output '#$inputs
+                       #:log-port (%make-void-port "w"))
+          (call-with-output-file (string-append #$output "/manifest")
+            (lambda (p)
+              (pretty-print '#$(manifest->gexp manifest) p)))))
+
+    (gexp->derivation "profile" builder
+                      #:modules '((guix build union))
+                      #:local-build? #t)))
 
 (define (profile-regexp profile)
   "Return a regular expression that matches PROFILE's name and number."
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 3bfef4fc9a..fb285c5e67 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -29,7 +29,6 @@
   #:use-module (guix config)
   #:use-module (guix scripts build)
   #:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
-  #:use-module ((guix ftp-client) #:select (ftp-open))
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -42,7 +41,6 @@
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (guile-final))
   #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
-  #:use-module (guix gnu-maintenance)
   #:export (specification->package+output
             guix-package))
 
@@ -184,49 +182,6 @@ DURATION-RELATION with the current time."
          filter-by-duration)
         (else #f)))
 
-(define (show-what-to-remove/install remove install dry-run?)
-  "Given the manifest entries listed in REMOVE and INSTALL, display the
-packages that will/would be installed and removed."
-  ;; TODO: Report upgrades more clearly.
-  (match remove
-    ((($ <manifest-entry> name version output path _) ..1)
-     (let ((len    (length name))
-           (remove (map (cut format #f "   ~a-~a\t~a\t~a" <> <> <> <>)
-                        name version output path)))
-       (if dry-run?
-           (format (current-error-port)
-                   (N_ "The following package would be removed:~%~{~a~%~}~%"
-                       "The following packages would be removed:~%~{~a~%~}~%"
-                       len)
-                   remove)
-           (format (current-error-port)
-                   (N_ "The following package will be removed:~%~{~a~%~}~%"
-                       "The following packages will be removed:~%~{~a~%~}~%"
-                       len)
-                   remove))))
-    (_ #f))
-  (match install
-    ((($ <manifest-entry> name version output item _) ..1)
-     (let ((len     (length name))
-           (install (map (lambda (name version output item)
-                           (format #f "   ~a-~a\t~a\t~a" name version output
-                                   (if (package? item)
-                                       (package-output (%store) item output)
-                                       item)))
-                         name version output item)))
-       (if dry-run?
-           (format (current-error-port)
-                   (N_ "The following package would be installed:~%~{~a~%~}~%"
-                       "The following packages would be installed:~%~{~a~%~}~%"
-                       len)
-                   install)
-           (format (current-error-port)
-                   (N_ "The following package will be installed:~%~{~a~%~}~%"
-                       "The following packages will be installed:~%~{~a~%~}~%"
-                       len)
-                   install))))
-    (_ #f)))
-
 
 ;;;
 ;;; Package specifications.
@@ -258,48 +213,6 @@ RX."
                 (package-name p2))))
    same-location?))
 
-(define %sigint-prompt
-  ;; The prompt to jump to upon SIGINT.
-  (make-prompt-tag "interruptible"))
-
-(define (call-with-sigint-handler thunk handler)
-  "Call THUNK and return its value.  Upon SIGINT, call HANDLER with the signal
-number in the context of the continuation of the call to this function, and
-return its return value."
-  (call-with-prompt %sigint-prompt
-                    (lambda ()
-                      (sigaction SIGINT
-                        (lambda (signum)
-                          (sigaction SIGINT SIG_DFL)
-                          (abort-to-prompt %sigint-prompt signum)))
-                      (dynamic-wind
-                        (const #t)
-                        thunk
-                        (cut sigaction SIGINT SIG_DFL)))
-                    (lambda (k signum)
-                      (handler signum))))
-
-(define-syntax-rule (waiting exp fmt rest ...)
-  "Display the given message while EXP is being evaluated."
-  (let* ((message (format #f fmt rest ...))
-         (blank   (make-string (string-length message) #\space)))
-    (display message (current-error-port))
-    (force-output (current-error-port))
-    (call-with-sigint-handler
-     (lambda ()
-       (dynamic-wind
-         (const #f)
-         (lambda () exp)
-         (lambda ()
-           ;; Clear the line.
-           (display #\cr (current-error-port))
-           (display blank (current-error-port))
-           (display #\cr (current-error-port))
-           (force-output (current-error-port)))))
-     (lambda (signum)
-       (format (current-error-port) "  interrupted by signal ~a~%" SIGINT)
-       #f))))
-
 (define-syntax-rule (leave-on-EPIPE exp ...)
   "Run EXP... in a context when EPIPE errors are caught and lead to 'exit'
 with successful exit code.  This is useful when writing to the standard output
@@ -363,41 +276,6 @@ an output path different than CURRENT-PATH."
               (not (string=? current-path candidate-path))))))
     (#f #f)))
 
-(define ftp-open*
-  ;; Memoizing version of `ftp-open'.  The goal is to avoid initiating a new
-  ;; FTP connection for each package, esp. since most of them are to the same
-  ;; server.  This has a noticeable impact when doing "guix upgrade -u".
-  (memoize ftp-open))
-
-(define (check-package-freshness package)
-  "Check whether PACKAGE has a newer version available upstream, and report
-it."
-  ;; TODO: Automatically inject the upstream version when desired.
-
-  (catch #t
-    (lambda ()
-      (when (false-if-exception (gnu-package? package))
-        (let ((name      (package-name package))
-              (full-name (package-full-name package)))
-          (match (waiting (latest-release name
-                                          #:ftp-open ftp-open*
-                                          #:ftp-close (const #f))
-                          (_ "looking for the latest release of GNU ~a...") name)
-            ((latest-version . _)
-             (when (version>? latest-version full-name)
-               (format (current-error-port)
-                       (_ "~a: note: using ~a \
-but ~a is available upstream~%")
-                       (location->string (package-location package))
-                       full-name latest-version)))
-            (_ #t)))))
-    (lambda (key . args)
-      ;; Silently ignore networking errors rather than preventing
-      ;; installation.
-      (case key
-        ((getaddrinfo-error ftp-error) #f)
-        (else (apply throw key args))))))
-
 
 ;;;
 ;;; Search paths.
@@ -863,21 +741,26 @@ more information.~%"))
              (_ #f))
             opts))
           (else
-           (let* ((manifest (profile-manifest profile))
-                  (install  (options->installable opts manifest))
-                  (remove   (options->removable opts manifest))
-                  (new      (manifest-add (manifest-remove manifest remove)
-                                          install)))
+           (let* ((manifest    (profile-manifest profile))
+                  (install     (options->installable opts manifest))
+                  (remove      (options->removable opts manifest))
+                  (bootstrap?  (assoc-ref opts 'bootstrap?))
+                  (transaction (manifest-transaction (install install)
+                                                     (remove remove)))
+                  (new         (manifest-perform-transaction
+                                manifest transaction)))
 
              (when (equal? profile %current-profile)
                (ensure-default-profile))
 
              (unless (and (null? install) (null? remove))
                (let* ((prof-drv (run-with-store (%store)
-                                  (profile-derivation new)))
-                      (prof     (derivation->output-path prof-drv))
-                      (remove   (manifest-matching-entries manifest remove)))
-                 (show-what-to-remove/install remove install dry-run?)
+                                  (profile-derivation
+                                   new
+                                   #:info-dir? (not bootstrap?))))
+                      (prof     (derivation->output-path prof-drv)))
+                 (manifest-show-transaction (%store) manifest transaction
+                                            #:dry-run? dry-run?)
                  (show-what-to-build (%store) (list prof-drv)
                                      #:use-substitutes?
                                      (assoc-ref opts 'substitutes?)
diff --git a/guix/svn-download.scm b/guix/svn-download.scm
index 9b2b24d92d..cb4d9dcc11 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -19,7 +19,8 @@
 
 (define-module (guix svn-download)
   #:use-module (guix records)
-  #:use-module (guix derivations)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (ice-9 match)
   #:export (svn-reference
@@ -42,9 +43,15 @@
   (url      svn-reference-url)                    ; string
   (revision svn-reference-revision))              ; number
 
+(define (subversion-package)
+  "Return the default Subversion package."
+  (let ((distro (resolve-interface '(gnu packages version-control))))
+    (module-ref distro 'subversion)))
+
 (define* (svn-fetch store ref hash-algo hash
                     #:optional name
-                    #:key (system (%current-system)) guile svn)
+                    #:key (system (%current-system)) guile
+                    (svn (subversion-package)))
   "Return a fixed-output derivation in STORE that fetches REF, a
 <svn-reference> object.  The output is expected to have recursive hash HASH of
 type HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if
@@ -58,33 +65,26 @@ type HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if
               (guile  (module-ref distro 'guile-final)))
          (package-derivation store guile system)))))
 
-  (define svn-for-build
-    (match svn
-      ((? package?)
-       (package-derivation store svn system))
-      (#f                                         ; the default
-       (let* ((distro (resolve-interface '(gnu packages version-control)))
-              (svn    (module-ref distro 'subversion)))
-         (package-derivation store svn system)))))
+  (define build
+    #~(begin
+        (use-modules (guix build svn))
+        (svn-fetch '#$(svn-reference-url ref)
+                   '#$(svn-reference-revision ref)
+                   #$output
+                   #:svn-command (string-append #$svn "/bin/svn"))))
 
-  (let* ((command (string-append (derivation->output-path svn-for-build)
-                                 "/bin/svn"))
-         (builder `(begin
-                     (use-modules (guix build svn))
-                     (svn-fetch ',(svn-reference-url ref)
-                                ',(svn-reference-revision ref)
-                                %output
-                                #:svn-command ',command))))
-    (build-expression->derivation store (or name "svn-checkout") builder
-                                  #:system system
-                                  #:local-build? #t
-                                  #:inputs `(("svn" ,svn-for-build))
-                                  #:hash-algo hash-algo
-                                  #:hash hash
-                                  #:recursive? #t
-                                  #:modules '((guix build svn)
-                                              (guix build utils))
-                                  #:guile-for-build guile-for-build
-                                  #:local-build? #t)))
+  (run-with-store store
+    (gexp->derivation (or name "svn-checkout") build
+                      #:system system
+                      #:local-build? #t
+                      #:hash-algo hash-algo
+                      #:hash hash
+                      #:recursive? #t
+                      #:modules '((guix build svn)
+                                  (guix build utils))
+                      #:guile-for-build guile-for-build
+                      #:local-build? #t)
+    #:guile-for-build guile-for-build
+    #:system system))
 
 ;;; svn-download.scm ends here
diff --git a/guix/tests.scm b/guix/tests.scm
new file mode 100644
index 0000000000..4f7b0c8171
--- /dev/null
+++ b/guix/tests.scm
@@ -0,0 +1,70 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix tests)
+  #:use-module (guix store)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (gnu packages bootstrap)
+  #:use-module (srfi srfi-34)
+  #:use-module (rnrs bytevectors)
+  #:export (open-connection-for-tests
+            random-text
+            random-bytevector))
+
+;;; Commentary:
+;;;
+;;; This module provide shared infrastructure for the test suite.  For
+;;; internal use only.
+;;;
+;;; Code:
+
+(define (open-connection-for-tests)
+  "Open a connection to the build daemon for tests purposes and return it."
+  (guard (c ((nix-error? c)
+             (format (current-error-port)
+                     "warning: build daemon error: ~s~%" c)
+             #f))
+    (let ((store (open-connection)))
+      ;; Make sure we build everything by ourselves.
+      (set-build-options store #:use-substitutes? #f)
+
+      ;; Use the bootstrap Guile when running tests, so we don't end up
+      ;; building everything in the temporary test store.
+      (%guile-for-build (package-derivation store %bootstrap-guile))
+
+      store)))
+
+(define %seed
+  (seed->random-state (logxor (getpid) (car (gettimeofday)))))
+
+(define (random-text)
+  "Return the hexadecimal representation of a random number."
+  (number->string (random (expt 2 256) %seed) 16))
+
+(define (random-bytevector n)
+  "Return a random bytevector of N bytes."
+  (let ((bv (make-bytevector n)))
+    (let loop ((i 0))
+      (if (< i n)
+          (begin
+            (bytevector-u8-set! bv i (random 256 %seed))
+            (loop (1+ i)))
+          bv))))
+
+;;; tests.scm ends here
diff --git a/tests/builders.scm b/tests/builders.scm
index 0ed5d74a22..54cdeb6d7b 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +25,7 @@
   #:use-module (guix utils)
   #:use-module (guix base32)
   #:use-module (guix derivations)
+  #:use-module (guix tests)
   #:use-module ((guix packages)
                 #:select (package-derivation package-native-search-paths))
   #:use-module (gnu packages bootstrap)
@@ -35,11 +36,7 @@
 ;; Test the higher-level builders.
 
 (define %store
-  (false-if-exception (open-connection)))
-
-(when %store
-  ;; Make sure we build everything by ourselves.
-  (set-build-options %store #:use-substitutes? #f))
+  (open-connection-for-tests))
 
 (define %bootstrap-inputs
   ;; Use the bootstrap inputs so it doesn't take ages to run these tests.
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 87609108d6..19bcebcb21 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -16,13 +16,13 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-
 (define-module (test-derivations)
   #:use-module (guix derivations)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix hash)
   #:use-module (guix base32)
+  #:use-module (guix tests)
   #:use-module ((guix packages) #:select (package-derivation base32))
   #:use-module ((guix build utils) #:select (executable-file?))
   #:use-module ((gnu packages) #:select (search-bootstrap-binary))
@@ -42,15 +42,7 @@
   #:use-module (ice-9 match))
 
 (define %store
-  (false-if-exception (open-connection)))
-
-(when %store
-  ;; Make sure we build everything by ourselves.
-  (set-build-options %store #:use-substitutes? #f)
-
-  ;; By default, use %BOOTSTRAP-GUILE for the current system.
-  (let ((drv (package-derivation %store %bootstrap-guile)))
-    (%guile-for-build drv)))
+  (open-connection-for-tests))
 
 (define (bootstrap-binary name)
   (let ((bin (search-bootstrap-binary name (%current-system))))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 694bd409bc..bf52401c66 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -22,6 +22,7 @@
   #:use-module (guix gexp)
   #:use-module (guix derivations)
   #:use-module (guix packages)
+  #:use-module (guix tests)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootstrap)
@@ -35,28 +36,22 @@
 ;; Test the (guix gexp) module.
 
 (define %store
-  (open-connection))
+  (open-connection-for-tests))
 
 ;; For white-box testing.
 (define gexp-inputs (@@ (guix gexp) gexp-inputs))
 (define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs))
 (define gexp->sexp  (@@ (guix gexp) gexp->sexp))
 
-(define guile-for-build
-  (package-derivation %store %bootstrap-guile))
-
-;; Make it the default.
-(%guile-for-build guile-for-build)
-
 (define* (gexp->sexp* exp #:optional target)
   (run-with-store %store (gexp->sexp exp
                                      #:target target)
-                  #:guile-for-build guile-for-build))
+                  #:guile-for-build (%guile-for-build)))
 
 (define-syntax-rule (test-assertm name exp)
   (test-assert name
     (run-with-store %store exp
-                    #:guile-for-build guile-for-build)))
+                    #:guile-for-build (%guile-for-build))))
 
 
 (test-begin "gexp")
@@ -330,7 +325,7 @@
                       (derivation-file-name xdrv)))))
 
 (define shebang
-  (string-append "#!" (derivation->output-path guile-for-build)
+  (string-append "#!" (derivation->output-path (%guile-for-build))
                  "/bin/guile --no-auto-compile"))
 
 ;; If we're going to hit the silly shebang limit (128 chars on Linux-based
diff --git a/tests/monads.scm b/tests/monads.scm
index b814b0f7c5..b31cabdb54 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -17,6 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-monads)
+  #:use-module (guix tests)
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix derivations)
@@ -34,10 +35,7 @@
 ;; Test the (guix store) module.
 
 (define %store
-  (open-connection))
-
-;; Make sure we build everything by ourselves.
-(set-build-options %store #:use-substitutes? #f)
+  (open-connection-for-tests))
 
 (define %monads
   (list %identity-monad %store-monad))
diff --git a/tests/nar.scm b/tests/nar.scm
index 16a7845342..3188599bf1 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -17,6 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-nar)
+  #:use-module (guix tests)
   #:use-module (guix nar)
   #:use-module (guix store)
   #:use-module ((guix hash)
@@ -134,19 +135,10 @@
                     input
                     lstat))
 
-(define (make-random-bytevector n)
-  (let ((bv (make-bytevector n)))
-    (let loop ((i 0))
-      (if (< i n)
-          (begin
-            (bytevector-u8-set! bv i (random 256))
-            (loop (1+ i)))
-          bv))))
-
 (define (populate-file file size)
   (call-with-output-file file
     (lambda (p)
-      (put-bytevector p (make-random-bytevector size)))))
+      (put-bytevector p (random-bytevector size)))))
 
 (define (rm-rf dir)
   (file-system-fold (const #t)                    ; enter?
@@ -166,13 +158,6 @@
   (string-append (dirname (search-path %load-path "pre-inst-env"))
                  "/test-nar-" (number->string (getpid))))
 
-;; XXX: Factorize.
-(define %seed
-  (seed->random-state (logxor (getpid) (car (gettimeofday)))))
-
-(define (random-text)
-  (number->string (random (expt 2 256) %seed) 16))
-
 (define-syntax-rule (let/ec k exp...)
   ;; This one appeared in Guile 2.0.9, so provide a copy here.
   (let ((tag (make-prompt-tag)))
diff --git a/tests/packages.scm b/tests/packages.scm
index 6ac215be4c..2a67f108ad 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -16,8 +16,8 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-
 (define-module (test-packages)
+  #:use-module (guix tests)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix hash)
@@ -39,11 +39,8 @@
 ;; Test the high-level packaging layer.
 
 (define %store
-  (false-if-exception (open-connection)))
+  (open-connection-for-tests))
 
-(when %store
-  ;; Make sure we build everything by ourselves.
-  (set-build-options %store #:use-substitutes? #f))
 
 
 (test-begin "packages")
diff --git a/tests/profiles.scm b/tests/profiles.scm
index b2919d7315..047c5ba49b 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,6 +18,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-profiles)
+  #:use-module (guix tests)
   #:use-module (guix profiles)
   #:use-module (guix store)
   #:use-module (guix monads)
@@ -26,17 +28,10 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-64))
 
-;; Test the (guix profile) module.
+;; Test the (guix profiles) module.
 
 (define %store
-  (open-connection))
-
-(define guile-for-build
-  (package-derivation %store %bootstrap-guile))
-
-;; Make it the default.
-(%guile-for-build guile-for-build)
-
+  (open-connection-for-tests))
 
 ;; Example manifest entries.
 
@@ -122,12 +117,32 @@
            (_ #f))
          (equal? m3 m4))))
 
+(test-assert "manifest-perform-transaction"
+  (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
+         (t1 (manifest-transaction
+              (install (list guile-1.8.8))
+              (remove (list (manifest-pattern (name "guile")
+                                              (output "debug"))))))
+         (t2 (manifest-transaction
+              (remove (list (manifest-pattern (name "guile")
+                                              (version "2.0.9")
+                                              (output #f))))))
+         (m1 (manifest-perform-transaction m0 t1))
+         (m2 (manifest-perform-transaction m1 t2))
+         (m3 (manifest-perform-transaction m0 t2)))
+    (and (match (manifest-entries m1)
+           ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
+           (_ #f))
+         (equal? m1 m2)
+         (null? (manifest-entries m3)))))
+
 (test-assert "profile-derivation"
   (run-with-store %store
     (mlet* %store-monad
         ((entry ->   (package->manifest-entry %bootstrap-guile))
          (guile      (package->derivation %bootstrap-guile))
-         (drv        (profile-derivation (manifest (list entry))))
+         (drv        (profile-derivation (manifest (list entry))
+                                         #:info-dir? #f))
          (profile -> (derivation->output-path drv))
          (bindir ->  (string-append profile "/bin"))
          (_          (built-derivations (list drv))))
diff --git a/tests/store.scm b/tests/store.scm
index b0f609f818..ba15524be4 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -16,8 +16,8 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-
 (define-module (test-store)
+  #:use-module (guix tests)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix hash)
@@ -40,17 +40,7 @@
 ;; Test the (guix store) module.
 
 (define %store
-  (false-if-exception (open-connection)))
-
-(when %store
-  ;; Make sure we build everything by ourselves.
-  (set-build-options %store #:use-substitutes? #f))
-
-(define %seed
-  (seed->random-state (logxor (getpid) (car (gettimeofday)))))
-
-(define (random-text)
-  (number->string (random (expt 2 256) %seed) 16))
+  (open-connection-for-tests))
 
 
 (test-begin "store")
diff --git a/tests/union.scm b/tests/union.scm
index 74c51cbed9..7e55670b86 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -16,8 +16,8 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-
 (define-module (test-union)
+  #:use-module (guix tests)
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix derivations)
@@ -34,12 +34,7 @@
 ;; Exercise the (guix build union) module.
 
 (define %store
-  (false-if-exception (open-connection)))
-
-(when %store
-  ;; By default, use %BOOTSTRAP-GUILE for the current system.
-  (let ((drv (package-derivation %store %bootstrap-guile)))
-    (%guile-for-build drv)))
+  (open-connection-for-tests))
 
 
 (test-begin "union")