From 47c0f92c37dc7d50d9d4598ce5b91c4cdfec6ed1 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 31 Jan 2016 23:22:18 +0100 Subject: [PATCH] guix build: Add '--with-input'. * guix/scripts/build.scm (transform-package-inputs): New procedure. (%transformations): Add it. (%transformation-options, show-transformation-options-help): Add --with-input. * tests/scripts-build.scm ("options->transformation, with-input"): ("options->transformation, with-input, no matches"): New tests. * tests/guix-build.sh: Add tests. * doc/guix.texi (Package Transformation Options): Document it. --- doc/guix.texi | 19 ++++++++++++++ guix/scripts/build.scm | 55 +++++++++++++++++++++++++++++++++++++++-- tests/guix-build.sh | 14 ++++++++++- tests/scripts-build.scm | 23 +++++++++++++++++ 4 files changed, 108 insertions(+), 3 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index dcced797f7..11664f46f2 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3995,6 +3995,25 @@ $ git clone git://git.sv.gnu.org/guix.git $ guix build guix --with-source=./guix @end example +@item --with-input=@var{package}=@var{replacement} +Replace dependency on @var{package} by a dependency on +@var{replacement}. @var{package} must be a package name, and +@var{replacement} must be a package specification such as @code{guile} +or @code{guile@@1.8}. + +For instance, the following command builds Guix but replaces its +dependency on the current stable version of Guile with a dependency on +the development version of Guile, @code{guile-next}: + +@example +guix build --with-input=guile=guile-next guix +@end example + +This is a recursive, deep replacement. So in this example, both +@code{guix} and its dependency @code{guile-json} (which also depends on +@code{guile}) get rebuilt against @code{guile-next}. + +However, implicit inputs are left unchanged. @end table @node Additional Build Options diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index b37d923b3a..aa9c105f58 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -169,12 +169,55 @@ matching URIs given in SOURCES." (_ obj))))) +(define (transform-package-inputs replacement-specs) + "Return a procedure that, when passed a package, replaces its direct +dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of +strings like \"guile=guile@2.1\" meaning that, any direct dependency on a +package called \"guile\" must be replaced with a dependency on a version 2.1 +of \"guile\"." + (define not-equal + (char-set-complement (char-set #\=))) + + (define replacements + ;; List of name/package pairs. + (map (lambda (spec) + (match (string-tokenize spec not-equal) + ((old new) + (cons old (specification->package new))) + (_ + (leave (_ "invalid replacement specification: ~s~%") spec)))) + replacement-specs)) + + (define (rewrite input) + (match input + ((label (? package? package) outputs ...) + (match (assoc-ref replacements (package-name package)) + (#f (cons* label (replace package) outputs)) + (new (cons* label new outputs)))) + (_ + input))) + + (define replace + (memoize ;XXX: use eq? + (lambda (p) + (package + (inherit p) + (inputs (map rewrite (package-inputs p))) + (native-inputs (map rewrite (package-native-inputs p))) + (propagated-inputs (map rewrite (package-propagated-inputs p))))))) + + (lambda (store obj) + (if (package? obj) + (replace obj) + obj))) + (define %transformations ;; Transformations that can be applied to things to build. The car is the ;; key used in the option alist, and the cdr is the transformation ;; procedure; it is called with two arguments: the store, and a list of ;; things to build. - `((with-source . ,transform-package-source))) + `((with-source . ,transform-package-source) + (with-input . ,transform-package-inputs))) (define %transformation-options ;; The command-line interface to the above transformations. @@ -182,12 +225,20 @@ matching URIs given in SOURCES." (lambda (opt name arg result . rest) (apply values (cons (alist-cons 'with-source arg result) + rest)))) + (option '("with-input") #t #f + (lambda (opt name arg result . rest) + (apply values + (cons (alist-cons 'with-input arg result) rest)))))) (define (show-transformation-options-help) (display (_ " --with-source=SOURCE - use SOURCE when building the corresponding package"))) + use SOURCE when building the corresponding package")) + (display (_ " + --with-input=PACKAGE=REPLACEMENT + replace dependency PACKAGE by REPLACEMENT"))) (define (options->transformation opts) diff --git a/tests/guix-build.sh b/tests/guix-build.sh index f7fb3c5b64..347cdfa4e4 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014 Ludovic Courtès +# Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès # # This file is part of GNU Guix. # @@ -147,6 +147,18 @@ rm -f "$result" # Cross building. guix build coreutils --target=mips64el-linux-gnu --dry-run --no-substitutes +# Replacements. +drv1=`guix build guix --with-input=guile=guile-next -d` +drv2=`guix build guix -d` +test "$drv1" != "$drv2" + +drv1=`guix build guile -d` +drv2=`guix build guile --with-input=gimp=ruby -d` +test "$drv1" = "$drv2" + +if guix build guile --with-input=libunistring=something-really-silly +then false; else true; fi + # Parsing package names and versions. guix build -n time # PASS guix build -n time-1.7 # PASS, version found diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index 75dc119e88..94ddaf447b 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -22,6 +22,9 @@ #:use-module (guix packages) #:use-module (guix scripts build) #:use-module (guix ui) + #:use-module (gnu packages base) + #:use-module (gnu packages busybox) + #:use-module (ice-9 match) #:use-module (srfi srfi-64)) @@ -59,6 +62,26 @@ (string-contains (get-output-string port) "had no effect")))))) +(test-assert "options->transformation, with-input" + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,coreutils) + ("bar" ,grep) + ("baz" ,(dummy-package "chbouib" + (native-inputs `(("x" ,grep))))))))) + (t (options->transformation '((with-input . "coreutils=busybox") + (with-input . "grep=findutils"))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2) ("baz" dep3)) + (and (eq? dep1 busybox) + (eq? dep2 findutils) + (string=? (package-name dep3) "chbouib") + (match (package-native-inputs dep3) + ((("x" dep)) + (eq? dep findutils))))))))))) + (test-end) -- 2.20.1