summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2019-03-13 10:11:54 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-17 22:55:01 +0100
commit14328b81a224b726f39dd030886ba8d332027427 (patch)
treea530e4445d30b7babd0b1131f6bcb8204a73c1e3
parent0c0ff42a243b2da4f1deb52fe3961801008341da (diff)
guix build: Transformation options match packages by spec.
This allows us to combine several transformations on a given package, in particular '--with-git-url' and '--with-branch'. Previously transformations would ignore each other since they would all take (specification->package SOURCE) as their replacement source, compare it by identity, which doesn't work if a previous transformation has already changed SOURCE. * guix/scripts/build.scm (evaluate-replacement-specs): Adjust to produce an alist as expected by 'package-input-rewriting/spec', with a package spec as the first element of each pair. (evaluate-git-replacement-specs): Likewise. (transform-package-inputs): Adjust accordingly and use 'package-input-rewriting/spec'. (transform-package-inputs/graft): Likewise. (transform-package-source-branch, transform-package-source-commit): Use 'package-input-rewriting/spec'. (transform-package-source-git-url): Likewise, and adjust the REPLACEMENTS alist accordingly. (options->transformation): Iterate over OPTS instead of over %TRANSFORMATIONS. Invoke transformations one by one. * tests/scripts-build.scm ("options->transformation, with-input"): Adjust test to compare packages by name rather than by identity. ("options->transformation, with-git-url + with-branch"): New test.
-rw-r--r--doc/guix.texi24
-rw-r--r--guix/scripts/build.scm90
-rw-r--r--tests/scripts-build.scm36
3 files changed, 97 insertions, 53 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 6124c9c24c..a3dd344a70 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7807,16 +7807,20 @@ care!
@cindex Git, using the latest commit
@cindex latest commit, building
Build @var{package} from the latest commit of the @code{master} branch of the
-Git repository at @var{url}.
+Git repository at @var{url}. Git sub-modules of the repository are fetched,
+recursively.
-For example, the following commands builds the GNU C Library (glibc) straight
-from its Git repository instead of building the currently-packaged release:
+For example, the following command builds the NumPy Python library against the
+latest commit of the master branch of Python itself:
@example
-guix build glibc \
- --with-git-url=glibc=git://sourceware.org/git/glibc.git
+guix build python-numpy \
+ --with-git-url=python=https://github.com/python/cpython
@end example
+This option can also be combined with @code{--with-branch} or
+@code{--with-commit} (see below).
+
@cindex continuous integration
Obviously, since it uses the latest commit of the given branch, the result of
such a command varies over time. Nevertheless it is a convenient way to
@@ -7829,11 +7833,11 @@ consecutive accesses to the same repository. You may want to clean it up once
in a while to save disk space.
@item --with-branch=@var{package}=@var{branch}
-Build @var{package} from the latest commit of @var{branch}. The @code{source}
-field of @var{package} must be an origin with the @code{git-fetch} method
-(@pxref{origin Reference}) or a @code{git-checkout} object; the repository URL
-is taken from that @code{source}. Git sub-modules of the repository are
-fetched, recursively.
+Build @var{package} from the latest commit of @var{branch}. If the
+@code{source} field of @var{package} is an origin with the @code{git-fetch}
+method (@pxref{origin Reference}) or a @code{git-checkout} object, the
+repository URL is taken from that @code{source}. Otherwise you have to use
+@code{--with-git-url} to specify the URL of the Git repository.
For instance, the following command builds @code{guile-sqlite3} from the
latest commit of its @code{master} branch, and then builds @code{guix} (which
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 7b24cc8eb1..8ebcf79243 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -226,18 +226,21 @@ matching URIs given in SOURCES."
obj)))))
(define (evaluate-replacement-specs specs proc)
- "Parse SPECS, a list of strings like \"guile=guile@2.1\", and invoke PROC on
-each package pair specified by SPECS. Return the resulting list. Raise an
-error if an element of SPECS uses invalid syntax, or if a package it refers to
-could not be found."
+ "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list
+of package spec/procedure pairs as expected by 'package-input-rewriting/spec'.
+PROC is called with the package to be replaced and its replacement according
+to SPECS. Raise an error if an element of SPECS uses invalid syntax, or if a
+package it refers to could not be found."
(define not-equal
(char-set-complement (char-set #\=)))
(map (lambda (spec)
(match (string-tokenize spec not-equal)
- ((old new)
- (proc (specification->package old)
- (specification->package new)))
+ ((spec new)
+ (cons spec
+ (let ((new (specification->package new)))
+ (lambda (old)
+ (proc old new)))))
(x
(leave (G_ "invalid replacement specification: ~s~%") spec))))
specs))
@@ -248,8 +251,10 @@ dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"guile=guile@2.1\" meaning that, any dependency on a package
called \"guile\" must be replaced with a dependency on a version 2.1 of
\"guile\"."
- (let* ((replacements (evaluate-replacement-specs replacement-specs cons))
- (rewrite (package-input-rewriting replacements)))
+ (let* ((replacements (evaluate-replacement-specs replacement-specs
+ (lambda (old new)
+ new)))
+ (rewrite (package-input-rewriting/spec replacements)))
(lambda (store obj)
(if (package? obj)
(rewrite obj)
@@ -260,13 +265,12 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the
current 'gnutls' package, after which version 3.5.4 is grafted onto them."
- (define (replacement-pair old new)
- (cons old
- (package (inherit old) (replacement new))))
+ (define (set-replacement old new)
+ (package (inherit old) (replacement new)))
(let* ((replacements (evaluate-replacement-specs replacement-specs
- replacement-pair))
- (rewrite (package-input-rewriting replacements)))
+ set-replacement))
+ (rewrite (package-input-rewriting/spec replacements)))
(lambda (store obj)
(if (package? obj)
(rewrite obj)
@@ -295,11 +299,13 @@ replacement package. Raise an error if an element of SPECS uses invalid
syntax, or if a package it refers to could not be found."
(map (lambda (spec)
(match (string-tokenize spec %not-equal)
- ((name branch-or-commit)
- (let* ((old (specification->package name))
- (source (package-source old))
- (url (package-git-url old)))
- (cons old (proc old url branch-or-commit))))
+ ((spec branch-or-commit)
+ (define (replace old)
+ (let* ((source (package-source old))
+ (url (package-git-url old)))
+ (proc old url branch-or-commit)))
+
+ (cons spec replace))
(x
(leave (G_ "invalid replacement specification: ~s~%") spec))))
specs))
@@ -318,7 +324,7 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
(let* ((replacements (evaluate-git-replacement-specs replacement-specs
replace))
- (rewrite (package-input-rewriting replacements)))
+ (rewrite (package-input-rewriting/spec replacements)))
(lambda (store obj)
(if (package? obj)
(rewrite obj)
@@ -340,7 +346,7 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
(let* ((replacements (evaluate-git-replacement-specs replacement-specs
replace))
- (rewrite (package-input-rewriting replacements)))
+ (rewrite (package-input-rewriting/spec replacements)))
(lambda (store obj)
(if (package? obj)
(rewrite obj)
@@ -351,22 +357,20 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of strings like
\"guile-json=https://gitthing.com/…\" meaning that packages are built using
a checkout of the Git repository at the given URL."
- ;; FIXME: Currently this cannot be combined with '--with-branch' or
- ;; '--with-commit' because they all transform "from scratch".
(define replacements
(map (lambda (spec)
(match (string-tokenize spec %not-equal)
- ((name url)
- (let* ((old (specification->package name))
- (new (package
- (inherit old)
- (source (git-checkout (url url)
- (recursive? #t))))))
- (cons old new)))))
+ ((spec url)
+ (cons spec
+ (lambda (old)
+ (package
+ (inherit old)
+ (source (git-checkout (url url)
+ (recursive? #t)))))))))
replacement-specs))
(define rewrite
- (package-input-rewriting replacements))
+ (package-input-rewriting/spec replacements))
(lambda (store obj)
(if (package? obj)
@@ -430,16 +434,22 @@ a checkout of the Git repository at the given URL."
"Return a procedure that, when passed an object to build (package,
derivation, etc.), applies the transformations specified by OPTS."
(define applicable
- ;; List of applicable transformations as symbol/procedure pairs.
+ ;; List of applicable transformations as symbol/procedure pairs in the
+ ;; order in which they appear on the command line.
(filter-map (match-lambda
- ((key . transform)
- (match (filter-map (match-lambda
- ((k . arg)
- (and (eq? k key) arg)))
- opts)
- (() #f)
- (args (cons key (transform args))))))
- %transformations))
+ ((key . value)
+ (match (any (match-lambda
+ ((k . proc)
+ (and (eq? k key) proc)))
+ %transformations)
+ (#f
+ #f)
+ (transform
+ ;; XXX: We used to pass TRANSFORM a list of several
+ ;; arguments, but we now pass only one, assuming that
+ ;; transform composes well.
+ (cons key (transform (list value)))))))
+ (reverse opts)))
(lambda (store obj)
(fold (match-lambda*
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index 54681274b9..4bf1e1a719 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -139,12 +139,15 @@
(and (not (eq? new p))
(match (package-inputs new)
((("foo" dep1) ("bar" dep2) ("baz" dep3))
- (and (eq? dep1 busybox)
- (eq? dep2 findutils)
+ (and (string=? (package-full-name dep1)
+ (package-full-name busybox))
+ (string=? (package-full-name dep2)
+ (package-full-name findutils))
(string=? (package-name dep3) "chbouib")
(match (package-native-inputs dep3)
((("x" dep))
- (eq? dep findutils)))))))))))
+ (string=? (package-full-name dep)
+ (package-full-name findutils))))))))))))
(test-assert "options->transformation, with-graft"
(let* ((p (dummy-package "guix.scm"
@@ -186,4 +189,31 @@
((("x" dep3))
(map package-source (list dep1 dep3))))))))))))
+(test-equal "options->transformation, with-git-url + with-branch"
+ ;; Combine the two options and make sure the 'with-branch' transformation
+ ;; comes after the 'with-git-url' transformation.
+ (let ((source (git-checkout (url "https://example.org")
+ (branch "BRANCH")
+ (recursive? #t))))
+ (list source source))
+ (let* ((p (dummy-package "guix.scm"
+ (inputs `(("foo" ,grep)
+ ("bar" ,(dummy-package "chbouib"
+ (native-inputs `(("x" ,grep)))))))))
+ (t (options->transformation
+ (reverse '((with-git-url
+ . "grep=https://example.org")
+ (with-branch . "grep=BRANCH"))))))
+ (with-store store
+ (let ((new (t store p)))
+ (and (not (eq? new p))
+ (match (package-inputs new)
+ ((("foo" dep1) ("bar" dep2))
+ (and (string=? (package-name dep1) "grep")
+ (string=? (package-name dep2) "chbouib")
+ (match (package-native-inputs dep2)
+ ((("x" dep3))
+ (map package-source (list dep1 dep3))))))))))))
+
+
(test-end)