me
/
guix
Archived
1
0
Fork 0
Code

Merge branch 'master' into core-updates

master
Mark H Weaver 2014-08-23 20:43:51 -04:00
parent fa5731baab f0dafadcfc
commit ce3e35ed6a
21 changed files with 482 additions and 319 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Makefile.am
View File

@ -99,6 +99,9 @@ MODULES += \
endif BUILD_DAEMON_OFFLOAD 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 # Because of the autoload hack in (guix build download), we must build it
# first to avoid errors on systems where (gnutls) is unavailable. # first to avoid errors on systems where (gnutls) is unavailable.
guix/scripts/download.go: guix/build/download.go guix/scripts/download.go: guix/build/download.go
@ -113,7 +116,7 @@ KCONFIGS = \
EXAMPLES = \ EXAMPLES = \
gnu/system/os-config.tmpl 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_dist_guilemodule_DATA = $(MODULES) $(KCONFIGS) $(EXAMPLES)
nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm

1
THANKS
View File

@ -16,6 +16,7 @@ infrastructure help:
John Darrington <jmd@gnu.org> John Darrington <jmd@gnu.org>
Rafael Ferreira <rafael.f.f1@gmail.com> Rafael Ferreira <rafael.f.f1@gmail.com>
Christian Grothoff <christian@grothoff.org> Christian Grothoff <christian@grothoff.org>
Brandon Invergo <brandon@gnu.org>
Jeffrin Jose <ahiliation@yahoo.co.in> Jeffrin Jose <ahiliation@yahoo.co.in>
Kete <kete@ninthfloor.org> Kete <kete@ninthfloor.org>
Alex Kost <alezost@gmail.com> Alex Kost <alezost@gmail.com>

88
gnu/packages.scm
View File

@ -22,6 +22,8 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #: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 ftw)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -41,7 +43,9 @@
package-direct-dependents package-direct-dependents
package-transitive-dependents package-transitive-dependents
package-covering-dependents)) package-covering-dependents
check-package-freshness))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -50,8 +54,6 @@
;;; ;;;
;;; Code: ;;; Code:
(define _ (cut gettext <> "guix"))
;; By default, we store patches and bootstrap binaries alongside Guile ;; By default, we store patches and bootstrap binaries alongside Guile
;; modules. This is so that these extra files can be found without ;; modules. This is so that these extra files can be found without
;; requiring a special setup, such as a specific installation directory ;; requiring a special setup, such as a specific installation directory
@ -60,7 +62,7 @@
(define %patch-path (define %patch-path
(make-parameter (make-parameter
(map (cut string-append <> "/gnu/packages/patches") (map (cut string-append <> "/gnu/packages/patches")
%load-path))) %load-path)))
(define %bootstrap-binaries-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)) (lambda (node) (vhash-refq dependency-dag node))
;; Start with the dependents to avoid including PACKAGES in the result. ;; Start with the dependents to avoid including PACKAGES in the result.
(package-direct-dependents packages)))) (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))))))

4
gnu/packages/bdw-gc.scm
View File

@ -27,14 +27,14 @@
(define-public libgc-7.2 (define-public libgc-7.2
(package (package
(name "libgc") (name "libgc")
(version "7.2e") (version "7.2f")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://www.hboehm.info/gc/gc_source/gc-" (uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0jxgr71rhk58dzc1ihqs51vldh2qs1m154bn41qh6q1dm145nc89")))) "119x7p1cqw40mpwj80xfq879l9m1dkc7vbc1f3bz3kvkf8bf6p16"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
;; Make it so that we don't rely on /proc. This is especially useful in ;; Make it so that we don't rely on /proc. This is especially useful in

4
gnu/packages/gnupg.scm
View File

@ -96,7 +96,7 @@ generation.")
(define-public libgcrypt-1.5 (define-public libgcrypt-1.5
(package (inherit libgcrypt) (package (inherit libgcrypt)
(version "1.5.3") (version "1.5.4")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -104,7 +104,7 @@ generation.")
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"1lar8y3lh61zl5flljpz540d78g99h4d5idfwrfw8lm3gm737xdw")))))) "0czvqxkzd5y872ipy6s010ifwdwv29sqbnqc4pf56sd486gqvy6m"))))))
(define-public libassuan (define-public libassuan
(package (package

4
gnu/packages/video.scm
View File

@ -58,14 +58,14 @@
(define-public ffmpeg (define-public ffmpeg
(package (package
(name "ffmpeg") (name "ffmpeg")
(version "2.3.1") (version "2.3.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-" (uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-"
version ".tar.bz2")) version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"10w1sw5c9qjlaqlr77r3znzm7y0y9qpkni0mfr9rhij22562yspf")))) "0ik4c06anh49r5b0d3rq9if4zl6ysjsa341655kzw22fl880sk5v"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs (inputs
`(("fontconfig" ,fontconfig) `(("fontconfig" ,fontconfig)

2
guix/download.scm
View File

@ -185,7 +185,7 @@
"http://ftp.debian.org/debian/")))) "http://ftp.debian.org/debian/"))))
(define (gnutls-package) (define (gnutls-package)
"Return the GnuTLS package for SYSTEM." "Return the default GnuTLS package."
(let ((module (resolve-interface '(gnu packages gnutls)))) (let ((module (resolve-interface '(gnu packages gnutls))))
(module-ref module 'gnutls))) (module-ref module 'gnutls)))

79
guix/git-download.scm
View File

@ -17,8 +17,9 @@
;;; 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 git-download) (define-module (guix git-download)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:autoload (guix build-system gnu) (standard-inputs) #:autoload (guix build-system gnu) (standard-inputs)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -46,9 +47,15 @@
(recursive? git-reference-recursive? ; whether to recurse into sub-modules (recursive? git-reference-recursive? ; whether to recurse into sub-modules
(default #f))) (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 (define* (git-fetch store ref hash-algo hash
#:optional name #: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 "Return a fixed-output derivation in STORE that fetches REF, a
<git-reference> object. The output is expected to have recursive hash HASH of <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 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))) (guile (module-ref distro 'guile-final)))
(package-derivation store guile system))))) (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 (define inputs
;; When doing 'git clone --recursive', we need sed, grep, etc. to be ;; When doing 'git clone --recursive', we need sed, grep, etc. to be
;; available so that 'git submodule' works. ;; 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)) (standard-inputs (%current-system))
'())) '()))
(let* ((command (string-append (derivation->output-path git-for-build) (define build
"/bin/git")) #~(begin
(builder `(begin (use-modules (guix build git)
(use-modules (guix build git) (guix build utils)
(guix build utils) (ice-9 match))
(ice-9 match))
;; The 'git submodule' commands expects Coreutils, sed, ;; The 'git submodule' commands expects Coreutils, sed,
;; grep, etc. to be in $PATH. ;; grep, etc. to be in $PATH.
(set-path-environment-variable "PATH" '("bin") (set-path-environment-variable "PATH" '("bin")
(match %build-inputs (match '#$inputs
(((names . dirs) ...) (((names dirs) ...)
dirs))) dirs)))
(git-fetch ',(git-reference-url ref) (git-fetch '#$(git-reference-url ref)
',(git-reference-commit ref) '#$(git-reference-commit ref)
%output #$output
#:recursive? ',(git-reference-recursive? ref) #:recursive? '#$(git-reference-recursive? ref)
#:git-command ',command)))) #:git-command (string-append #$git "/bin/git"))))
(build-expression->derivation store (or name "git-checkout") builder
#:system system (run-with-store store
#:local-build? #t (gexp->derivation (or name "git-checkout") build
#:inputs `(("git" ,git-for-build) #:system system
,@inputs) #:local-build? #t
#:hash-algo hash-algo #:hash-algo hash-algo
#:hash hash #:hash hash
#:recursive? #t #:recursive? #t
#:modules '((guix build git) #:modules '((guix build git)
(guix build utils)) (guix build utils))
#:guile-for-build guile-for-build #:guile-for-build guile-for-build
#:local-build? #t))) #:local-build? #t)
#:guile-for-build guile-for-build
#:system system))
;;; git-download.scm ends here ;;; git-download.scm ends here

213
guix/profiles.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -18,14 +19,17 @@
;;; 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 profiles) (define-module (guix profiles)
#:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
@ -51,6 +55,13 @@
manifest-installed? manifest-installed?
manifest-matching-entries manifest-matching-entries
manifest-transaction
manifest-transaction?
manifest-transaction-install
manifest-transaction-remove
manifest-perform-transaction
manifest-show-transaction
profile-manifest profile-manifest
package->manifest-entry package->manifest-entry
profile-derivation profile-derivation
@ -242,41 +253,193 @@ Remove MANIFEST entries that have the same name and output as ENTRIES."
(filter matches? (manifest-entries manifest))) (filter matches? (manifest-entries manifest)))
;;;
;;; Manifest transactions.
;;;
(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))))
;;; ;;;
;;; Profiles. ;;; Profiles.
;;; ;;;
(define (profile-derivation manifest) (define (manifest-inputs manifest)
"Return a derivation that builds a profile (aka. 'user environment') with "Return the list of inputs for MANIFEST. Each input has one of the
the given MANIFEST." following forms:
(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 (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 #~(begin
(use-modules (ice-9 pretty-print) (use-modules (guix build utils)
(guix build union)) (srfi srfi-1) (srfi srfi-26)
(ice-9 ftw))
(setvbuf (current-output-port) _IOLBF) (define (info-file? file)
(setvbuf (current-error-port) _IOLBF) (or (string-suffix? ".info" file)
(string-suffix? ".info.gz" file)))
(union-build #$output '#$inputs (define (info-files top)
#:log-port (%make-void-port "w")) (let ((infodir (string-append top "/share/info")))
(call-with-output-file (string-append #$output "/manifest") (map (cut string-append infodir "/" <>)
(lambda (p) (scandir infodir info-file?))))
(pretty-print '#$(manifest->gexp manifest) p)))))
(gexp->derivation "profile" builder (define (install-info info)
#:modules '((guix build union)) (zero?
#:local-build? #t)) (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) (define (profile-regexp profile)
"Return a regular expression that matches PROFILE's name and number." "Return a regular expression that matches PROFILE's name and number."

145
guix/scripts/package.scm
View File

@ -29,7 +29,6 @@
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) #: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 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
@ -42,7 +41,6 @@
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module ((gnu packages base) #:select (guile-final)) #:use-module ((gnu packages base) #:select (guile-final))
#:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
#:use-module (guix gnu-maintenance)
#:export (specification->package+output #:export (specification->package+output
guix-package)) guix-package))
@ -184,49 +182,6 @@ DURATION-RELATION with the current time."
filter-by-duration) filter-by-duration)
(else #f))) (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. ;;; Package specifications.
@ -258,48 +213,6 @@ RX."
(package-name p2)))) (package-name p2))))
same-location?)) 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 ...) (define-syntax-rule (leave-on-EPIPE exp ...)
"Run EXP... in a context when EPIPE errors are caught and lead to 'exit' "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 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)))))) (not (string=? current-path candidate-path))))))
(#f #f))) (#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. ;;; Search paths.
@ -863,21 +741,26 @@ more information.~%"))
(_ #f)) (_ #f))
opts)) opts))
(else (else
(let* ((manifest (profile-manifest profile)) (let* ((manifest (profile-manifest profile))
(install (options->installable opts manifest)) (install (options->installable opts manifest))
(remove (options->removable opts manifest)) (remove (options->removable opts manifest))
(new (manifest-add (manifest-remove manifest remove) (bootstrap? (assoc-ref opts 'bootstrap?))
install))) (transaction (manifest-transaction (install install)
(remove remove)))
(new (manifest-perform-transaction
manifest transaction)))
(when (equal? profile %current-profile) (when (equal? profile %current-profile)
(ensure-default-profile)) (ensure-default-profile))
(unless (and (null? install) (null? remove)) (unless (and (null? install) (null? remove))
(let* ((prof-drv (run-with-store (%store) (let* ((prof-drv (run-with-store (%store)
(profile-derivation new))) (profile-derivation
(prof (derivation->output-path prof-drv)) new
(remove (manifest-matching-entries manifest remove))) #:info-dir? (not bootstrap?))))
(show-what-to-remove/install remove install dry-run?) (prof (derivation->output-path prof-drv)))
(manifest-show-transaction (%store) manifest transaction
#:dry-run? dry-run?)
(show-what-to-build (%store) (list prof-drv) (show-what-to-build (%store) (list prof-drv)
#:use-substitutes? #:use-substitutes?
(assoc-ref opts 'substitutes?) (assoc-ref opts 'substitutes?)

58
guix/svn-download.scm
View File

@ -19,7 +19,8 @@
(define-module (guix svn-download) (define-module (guix svn-download)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix derivations) #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (svn-reference #:export (svn-reference
@ -42,9 +43,15 @@
(url svn-reference-url) ; string (url svn-reference-url) ; string
(revision svn-reference-revision)) ; number (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 (define* (svn-fetch store ref hash-algo hash
#:optional name #: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 "Return a fixed-output derivation in STORE that fetches REF, a
<svn-reference> object. The output is expected to have recursive hash HASH of <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 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))) (guile (module-ref distro 'guile-final)))
(package-derivation store guile system))))) (package-derivation store guile system)))))
(define svn-for-build (define build
(match svn #~(begin
((? package?) (use-modules (guix build svn))
(package-derivation store svn system)) (svn-fetch '#$(svn-reference-url ref)
(#f ; the default '#$(svn-reference-revision ref)
(let* ((distro (resolve-interface '(gnu packages version-control))) #$output
(svn (module-ref distro 'subversion))) #:svn-command (string-append #$svn "/bin/svn"))))
(package-derivation store svn system)))))
(let* ((command (string-append (derivation->output-path svn-for-build) (run-with-store store
"/bin/svn")) (gexp->derivation (or name "svn-checkout") build
(builder `(begin #:system system
(use-modules (guix build svn)) #:local-build? #t
(svn-fetch ',(svn-reference-url ref) #:hash-algo hash-algo
',(svn-reference-revision ref) #:hash hash
%output #:recursive? #t
#:svn-command ',command)))) #:modules '((guix build svn)
(build-expression->derivation store (or name "svn-checkout") builder (guix build utils))
#:system system #:guile-for-build guile-for-build
#:local-build? #t #:local-build? #t)
#:inputs `(("svn" ,svn-for-build)) #:guile-for-build guile-for-build
#:hash-algo hash-algo #:system system))
#:hash hash
#:recursive? #t
#:modules '((guix build svn)
(guix build utils))
#:guile-for-build guile-for-build
#:local-build? #t)))
;;; svn-download.scm ends here ;;; svn-download.scm ends here

70
guix/tests.scm 100644
View File

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

9
tests/builders.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -25,6 +25,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix tests)
#:use-module ((guix packages) #:use-module ((guix packages)
#:select (package-derivation package-native-search-paths)) #:select (package-derivation package-native-search-paths))
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
@ -35,11 +36,7 @@
;; Test the higher-level builders. ;; Test the higher-level builders.
(define %store (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))
(define %bootstrap-inputs (define %bootstrap-inputs
;; Use the bootstrap inputs so it doesn't take ages to run these tests. ;; Use the bootstrap inputs so it doesn't take ages to run these tests.

12
tests/derivations.scm
View File

@ -16,13 +16,13 @@
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; 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 (test-derivations) (define-module (test-derivations)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix tests)
#:use-module ((guix packages) #:select (package-derivation base32)) #:use-module ((guix packages) #:select (package-derivation base32))
#:use-module ((guix build utils) #:select (executable-file?)) #:use-module ((guix build utils) #:select (executable-file?))
#:use-module ((gnu packages) #:select (search-bootstrap-binary)) #:use-module ((gnu packages) #:select (search-bootstrap-binary))
@ -42,15 +42,7 @@
#:use-module (ice-9 match)) #:use-module (ice-9 match))
(define %store (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)
;; By default, use %BOOTSTRAP-GUILE for the current system.
(let ((drv (package-derivation %store %bootstrap-guile)))
(%guile-for-build drv)))
(define (bootstrap-binary name) (define (bootstrap-binary name)
(let ((bin (search-bootstrap-binary name (%current-system)))) (let ((bin (search-bootstrap-binary name (%current-system))))

15
tests/gexp.scm
View File

@ -22,6 +22,7 @@
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix tests)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
@ -35,28 +36,22 @@
;; Test the (guix gexp) module. ;; Test the (guix gexp) module.
(define %store (define %store
(open-connection)) (open-connection-for-tests))
;; For white-box testing. ;; For white-box testing.
(define gexp-inputs (@@ (guix gexp) gexp-inputs)) (define gexp-inputs (@@ (guix gexp) gexp-inputs))
(define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs)) (define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs))
(define gexp->sexp (@@ (guix gexp) gexp->sexp)) (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) (define* (gexp->sexp* exp #:optional target)
(run-with-store %store (gexp->sexp exp (run-with-store %store (gexp->sexp exp
#:target target) #:target target)
#:guile-for-build guile-for-build)) #:guile-for-build (%guile-for-build)))
(define-syntax-rule (test-assertm name exp) (define-syntax-rule (test-assertm name 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))))
(test-begin "gexp") (test-begin "gexp")
@ -330,7 +325,7 @@
(derivation-file-name xdrv))))) (derivation-file-name xdrv)))))
(define shebang (define shebang
(string-append "#!" (derivation->output-path guile-for-build) (string-append "#!" (derivation->output-path (%guile-for-build))
"/bin/guile --no-auto-compile")) "/bin/guile --no-auto-compile"))
;; If we're going to hit the silly shebang limit (128 chars on Linux-based ;; If we're going to hit the silly shebang limit (128 chars on Linux-based

6
tests/monads.scm
View File

@ -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 (test-monads) (define-module (test-monads)
#:use-module (guix tests)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix derivations) #:use-module (guix derivations)
@ -34,10 +35,7 @@
;; Test the (guix store) module. ;; Test the (guix store) module.
(define %store (define %store
(open-connection)) (open-connection-for-tests))
;; Make sure we build everything by ourselves.
(set-build-options %store #:use-substitutes? #f)
(define %monads (define %monads
(list %identity-monad %store-monad)) (list %identity-monad %store-monad))

19
tests/nar.scm
View File

@ -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 (test-nar) (define-module (test-nar)
#:use-module (guix tests)
#:use-module (guix nar) #:use-module (guix nar)
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix hash) #:use-module ((guix hash)
@ -134,19 +135,10 @@
input input
lstat)) 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) (define (populate-file file size)
(call-with-output-file file (call-with-output-file file
(lambda (p) (lambda (p)
(put-bytevector p (make-random-bytevector size))))) (put-bytevector p (random-bytevector size)))))
(define (rm-rf dir) (define (rm-rf dir)
(file-system-fold (const #t) ; enter? (file-system-fold (const #t) ; enter?
@ -166,13 +158,6 @@
(string-append (dirname (search-path %load-path "pre-inst-env")) (string-append (dirname (search-path %load-path "pre-inst-env"))
"/test-nar-" (number->string (getpid)))) "/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...) (define-syntax-rule (let/ec k exp...)
;; This one appeared in Guile 2.0.9, so provide a copy here. ;; This one appeared in Guile 2.0.9, so provide a copy here.
(let ((tag (make-prompt-tag))) (let ((tag (make-prompt-tag)))

9
tests/packages.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -16,8 +16,8 @@
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; 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 (test-packages) (define-module (test-packages)
#:use-module (guix tests)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix hash) #:use-module (guix hash)
@ -39,11 +39,8 @@
;; Test the high-level packaging layer. ;; Test the high-level packaging layer.
(define %store (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") (test-begin "packages")

35
tests/profiles.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -17,6 +18,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 (test-profiles) (define-module (test-profiles)
#:use-module (guix tests)
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
@ -26,17 +28,10 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-64)) #:use-module (srfi srfi-64))
;; Test the (guix profile) module. ;; Test the (guix profiles) module.
(define %store (define %store
(open-connection)) (open-connection-for-tests))
(define guile-for-build
(package-derivation %store %bootstrap-guile))
;; Make it the default.
(%guile-for-build guile-for-build)
;; Example manifest entries. ;; Example manifest entries.
@ -122,12 +117,32 @@
(_ #f)) (_ #f))
(equal? m3 m4)))) (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" (test-assert "profile-derivation"
(run-with-store %store (run-with-store %store
(mlet* %store-monad (mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile)) ((entry -> (package->manifest-entry %bootstrap-guile))
(guile (package->derivation %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)) (profile -> (derivation->output-path drv))
(bindir -> (string-append profile "/bin")) (bindir -> (string-append profile "/bin"))
(_ (built-derivations (list drv)))) (_ (built-derivations (list drv))))

14
tests/store.scm
View File

@ -16,8 +16,8 @@
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; 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 (test-store) (define-module (test-store)
#:use-module (guix tests)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix hash) #:use-module (guix hash)
@ -40,17 +40,7 @@
;; Test the (guix store) module. ;; Test the (guix store) module.
(define %store (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))
(define %seed
(seed->random-state (logxor (getpid) (car (gettimeofday)))))
(define (random-text)
(number->string (random (expt 2 256) %seed) 16))
(test-begin "store") (test-begin "store")

9
tests/union.scm
View File

@ -16,8 +16,8 @@
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; 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 (test-union) (define-module (test-union)
#:use-module (guix tests)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix derivations) #:use-module (guix derivations)
@ -34,12 +34,7 @@
;; Exercise the (guix build union) module. ;; Exercise the (guix build union) module.
(define %store (define %store
(false-if-exception (open-connection))) (open-connection-for-tests))
(when %store
;; By default, use %BOOTSTRAP-GUILE for the current system.
(let ((drv (package-derivation %store %bootstrap-guile)))
(%guile-for-build drv)))
(test-begin "union") (test-begin "union")