aboutsummaryrefslogtreecommitdiff
path: root/tests/packages.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-10-27 18:09:00 +0100
committerLudovic Courtès <ludo@gnu.org>2014-11-02 21:22:12 +0100
commit05962f2958eb98bad384702455236ff9d2acfb39 (patch)
tree519d31fb05176a3ec0e9918fc746ede76a071c7f /tests/packages.scm
parent50373bab7a084dc28a48df2ca7e16036d8978182 (diff)
downloadguix-05962f2958eb98bad384702455236ff9d2acfb39.tar
guix-05962f2958eb98bad384702455236ff9d2acfb39.tar.gz
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions and suggestions. * guix/packages.scm (<package>)[graft]: New field. (patch-and-repack): Invoke 'package-derivation' with #:graft? #f. (package-source-derivation): Likewise. Do not use (%guile-for-build) in call to 'patch-and-repack', and we could end up using a grafted Guile. (expand-input): Likewise, also for 'package-cross-derivation' call. (package->bag): Add #:graft? parameter. Honor it. Use 'strip-append' instead of 'package-full-name'. (input-graft, input-cross-graft, bag-grafts, package-grafts): New procedures. (package-derivation, package-cross-derivation): Add #:graft? parameter and honor it. * gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add recursive call on 'graft'. * guix/build-system/gnu.scm (package-with-explicit-inputs, package-with-extra-configure-variable, static-package): Likewise. (gnu-build): Use the ungrafted Guile to avoid full rebuilds. (gnu-cross-build): Likewise. * guix/build-system/cmake.scm (cmake-build): Likewise. * guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise. * guix/build-system/perl.scm (perl-build): Likewise. * guix/build-system/python.scm (python-build): Likewise. * guix/build-system/ruby.scm (ruby-build): Likewise. * guix/build-system/trivial.scm (guile-for-build): Likewise. * tests/packages.scm ("package-derivation, direct graft", "package-cross-derivation, direct graft", "package-grafts, indirect grafts", "package-grafts, indirect grafts, cross", "package-grafts, indirect grafts, propagated inputs", "package-derivation, indirect grafts"): New tests. ("bag->derivation", "bag->derivation, cross-compilation"): Wrap in 'parameterize'. * doc/guix.texi (Security Updates): New node. (Invoking guix build): Document --no-graft.
Diffstat (limited to 'tests/packages.scm')
-rw-r--r--tests/packages.scm105
1 files changed, 91 insertions, 14 deletions
diff --git a/tests/packages.scm b/tests/packages.scm
index 44cdb35c4b..4f700b712f 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -33,8 +33,9 @@
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages base)
+ #:use-module (gnu packages guile)
#:use-module (gnu packages bootstrap)
- #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
@@ -47,10 +48,6 @@
(define %store
(open-connection-for-tests))
-
-
-(test-begin "packages")
-
(define-syntax-rule (dummy-package name* extra-fields ...)
(package (name name*) (version "0") (source #f)
(build-system gnu-build-system)
@@ -58,6 +55,9 @@
(home-page #f) (license #f)
extra-fields ...))
+
+(test-begin "packages")
+
(test-assert "printer with location"
(string-match "^#<package foo-0 foo.scm:42 [[:xdigit:]]+>$"
(with-output-to-string
@@ -375,6 +375,80 @@
(package-cross-derivation %store p "mips64el-linux-gnu")
#f)))
+(test-equal "package-derivation, direct graft"
+ (package-derivation %store gnu-make)
+ (let ((p (package (inherit coreutils)
+ (replacement gnu-make))))
+ (package-derivation %store p)))
+
+(test-equal "package-cross-derivation, direct graft"
+ (package-cross-derivation %store gnu-make "mips64el-linux-gnu")
+ (let ((p (package (inherit coreutils)
+ (replacement gnu-make))))
+ (package-cross-derivation %store p "mips64el-linux-gnu")))
+
+(test-assert "package-grafts, indirect grafts"
+ (let* ((new (dummy-package "dep"
+ (arguments '(#:implicit-inputs? #f))))
+ (dep (package (inherit new) (version "0.0")))
+ (dep* (package (inherit dep) (replacement new)))
+ (dummy (dummy-package "dummy"
+ (arguments '(#:implicit-inputs? #f))
+ (inputs `(("dep" ,dep*))))))
+ (equal? (package-grafts %store dummy)
+ (list (graft
+ (origin (package-derivation %store dep))
+ (replacement (package-derivation %store new)))))))
+
+(test-assert "package-grafts, indirect grafts, cross"
+ (let* ((new (dummy-package "dep"
+ (arguments '(#:implicit-inputs? #f))))
+ (dep (package (inherit new) (version "0.0")))
+ (dep* (package (inherit dep) (replacement new)))
+ (dummy (dummy-package "dummy"
+ (arguments '(#:implicit-inputs? #f))
+ (inputs `(("dep" ,dep*)))))
+ (target "mips64el-linux-gnu"))
+ (equal? (package-grafts %store dummy #:target target)
+ (list (graft
+ (origin (package-cross-derivation %store dep target))
+ (replacement
+ (package-cross-derivation %store new target)))))))
+
+(test-assert "package-grafts, indirect grafts, propagated inputs"
+ (let* ((new (dummy-package "dep"
+ (arguments '(#:implicit-inputs? #f))))
+ (dep (package (inherit new) (version "0.0")))
+ (dep* (package (inherit dep) (replacement new)))
+ (prop (dummy-package "propagated"
+ (propagated-inputs `(("dep" ,dep*)))
+ (arguments '(#:implicit-inputs? #f))))
+ (dummy (dummy-package "dummy"
+ (arguments '(#:implicit-inputs? #f))
+ (inputs `(("prop" ,prop))))))
+ (equal? (package-grafts %store dummy)
+ (list (graft
+ (origin (package-derivation %store dep))
+ (replacement (package-derivation %store new)))))))
+
+(test-assert "package-derivation, indirect grafts"
+ (let* ((new (dummy-package "dep"
+ (arguments '(#:implicit-inputs? #f))))
+ (dep (package (inherit new) (version "0.0")))
+ (dep* (package (inherit dep) (replacement new)))
+ (dummy (dummy-package "dummy"
+ (arguments '(#:implicit-inputs? #f))
+ (inputs `(("dep" ,dep*)))))
+ (guile (package-derivation %store (canonical-package guile-2.0)
+ #:graft? #f)))
+ (equal? (package-derivation %store dummy)
+ (graft-derivation %store "dummy-0"
+ (package-derivation %store dummy #:graft? #f)
+ (package-grafts %store dummy)
+
+ ;; Use the same Guile as 'package-derivation'.
+ #:guile guile))))
+
(test-equal "package->bag"
`("foo86-hurd" #f (,(package-source gnu-make))
(,(canonical-package glibc)) (,(canonical-package coreutils)))
@@ -406,17 +480,20 @@
(eq? package dep)))))
(test-assert "bag->derivation"
- (let ((bag (package->bag gnu-make))
- (drv (package-derivation %store gnu-make)))
- (parameterize ((%current-system "foox86-hurd")) ;should have no effect
- (equal? drv (bag->derivation %store bag)))))
+ (parameterize ((%graft? #f))
+ (let ((bag (package->bag gnu-make))
+ (drv (package-derivation %store gnu-make)))
+ (parameterize ((%current-system "foox86-hurd")) ;should have no effect
+ (equal? drv (bag->derivation %store bag))))))
(test-assert "bag->derivation, cross-compilation"
- (let ((bag (package->bag gnu-make (%current-system) "mips64el-linux-gnu"))
- (drv (package-cross-derivation %store gnu-make "mips64el-linux-gnu")))
- (parameterize ((%current-system "foox86-hurd") ;should have no effect
- (%current-target-system "foo64-linux-gnu"))
- (equal? drv (bag->derivation %store bag)))))
+ (parameterize ((%graft? #f))
+ (let* ((target "mips64el-linux-gnu")
+ (bag (package->bag gnu-make (%current-system) target))
+ (drv (package-cross-derivation %store gnu-make target)))
+ (parameterize ((%current-system "foox86-hurd") ;should have no effect
+ (%current-target-system "foo64-linux-gnu"))
+ (equal? drv (bag->derivation %store bag))))))
(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))
(test-skip 1))