diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-10-27 18:09:00 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-11-02 21:22:12 +0100 |
commit | 05962f2958eb98bad384702455236ff9d2acfb39 (patch) | |
tree | 519d31fb05176a3ec0e9918fc746ede76a071c7f /tests/packages.scm | |
parent | 50373bab7a084dc28a48df2ca7e16036d8978182 (diff) | |
download | patches-05962f2958eb98bad384702455236ff9d2acfb39.tar patches-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.scm | 105 |
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)) |