GNU bug report logs - #34838
[PATCH 0/6] Add '--with-git-url' and make sure it composes well

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 34838 in the body.
You can then email your comments to 34838 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 0/6] Add '--with-git-url' and make sure it composes well
Date: Wed, 13 Mar 2019 10:57:55 +0100

Hello Guix!

This patch series allows for things like this:

  guix build python-numpy \
    --with-git-url=python=https://github.com/python/cpython \
    --with-commit=python=86900a49000c4a96ad1dc34e49d8af4245b08843

Initially I just wanted to add a ‘--with-git-url’ transformation option,
but then allowing it to be combined with ‘--with-branch’, for example,
turned out to be more involved.

To achieve that, this patch series changes transformation options so
they match packages by spec (“guile”, “guile <at> 2”, etc.) instead of
matching them by identity as was the case before (specifically, we’d
get the identity of the package to be replaced with ‘specification->package’.)

That leads to a slight semantic change: transformations now apply
to any package that matches the given spec, whereas before they would
only apply to the public package that matches the spec.  In practice,
it probably doesn’t make any difference since there are rarely (if ever)
several distinct packages with the same name.

Feedback welcome!

Ludo’.

Ludovic Courtès (6):
  guix build: Add '--with-git-url'.
  packages: Add 'package-input-rewriting/spec'.
  guix build: Factorize 'package-git-url'.
  guix build: Transformation options match packages by spec.
  guix build: '--with-commit' makes recursive checkouts.
  guix build: '--with-branch' strips slashes from the version string.

 doc/guix.texi           |  61 ++++++++++++++---
 guix/packages.scm       |  38 +++++++++++
 guix/scripts/build.scm  | 146 +++++++++++++++++++++++++++-------------
 tests/packages.scm      |  51 ++++++++++++++
 tests/scripts-build.scm | 109 ++++++++++++++++++++++++++++--
 5 files changed, 343 insertions(+), 62 deletions(-)

-- 
2.21.0

Message #8 received at 34838 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 34838 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 3/6] guix build: Factorize 'package-git-url'.
Date: Wed, 13 Mar 2019 11:47:48 +0100

* guix/scripts/build.scm (package-git-url): New procedure.
(evaluate-git-replacement-specs): Use it.
---
 guix/scripts/build.scm | 23 ++++++++++++++---------
 1 file changed, 14 insertions(+), 9 deletions(-)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 5883dbfb44..7b24cc8eb1 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -275,6 +275,19 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
 (define %not-equal
   (char-set-complement (char-set #\=)))
 
+(define (package-git-url package)
+  "Return the URL of the Git repository for package, or raise an error if
+the source of PACKAGE is not fetched from a Git repository."
+  (let ((source (package-source package)))
+    (cond ((and (origin? source)
+                (git-reference? (origin-uri source)))
+           (git-reference-url (origin-uri source)))
+          ((git-checkout? source)
+           (git-checkout-url source))
+          (else
+           (leave (G_ "the source of ~a is not a Git reference~%")
+                  (package-full-name package))))))
+
 (define (evaluate-git-replacement-specs specs proc)
   "Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list
 of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the
@@ -285,15 +298,7 @@ syntax, or if a package it refers to could not be found."
            ((name branch-or-commit)
             (let* ((old    (specification->package name))
                    (source (package-source old))
-                   (url    (cond ((and (origin? source)
-                                       (git-reference? (origin-uri source)))
-                                  (git-reference-url (origin-uri source)))
-                                 ((git-checkout? source)
-                                  (git-checkout-url source))
-                                 (else
-                                  (leave (G_ "the source of ~a is not a Git \
-reference~%")
-                                         (package-full-name old))))))
+                   (url    (package-git-url old)))
               (cons old (proc old url branch-or-commit))))
            (x
             (leave (G_ "invalid replacement specification: ~s~%") spec))))
-- 
2.21.0

Message #11 received at 34838 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 34838 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 2/6] packages: Add 'package-input-rewriting/spec'.
Date: Wed, 13 Mar 2019 11:47:47 +0100

* guix/packages.scm (package-input-rewriting/spec): New procedure.
* tests/packages.scm ("package-input-rewriting/spec")
("package-input-rewriting/spec, partial match"): New tests.
* doc/guix.texi (Defining Packages): Document it.
---
 doc/guix.texi      | 23 +++++++++++++++++++++
 guix/packages.scm  | 38 ++++++++++++++++++++++++++++++++++
 tests/packages.scm | 51 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 112 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 42885577be..b0b7ee5dd0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5155,6 +5155,29 @@ with @var{libressl}.  Then we use it to define a @dfn{variant} of the
 This is exactly what the @option{--with-input} command-line option does
 (@pxref{Package Transformation Options, @option{--with-input}}).
 
+The following variant of @code{package-input-rewriting} can match packages to
+be replaced by name rather than by identity.
+
+@deffn {Scheme Procedure} package-input-rewriting/spec @var{replacements}
+Return a procedure that, given a package, applies the given @var{replacements} to
+all the package graph (excluding implicit inputs).  @var{replacements} is a list of
+spec/procedures pair; each spec is a package specification such as @code{"gcc"} or
+@code{"guile@@2"}, and each procedure takes a matching package and returns a
+replacement for that package.
+@end deffn
+
+The example above could be rewritten this way:
+
+@example
+(define libressl-instead-of-openssl
+  ;; Replace all the packages called "openssl" with LibreSSL.
+  (package-input-rewriting/spec `(("openssl" . ,(const libressl)))))
+@end example
+
+The key difference here is that, this time, packages are matched by spec and
+not by identity.  In other words, any package in the graph that is called
+@code{openssl} will be replaced.
+
 A more generic procedure to rewrite a package dependency graph is
 @code{package-mapping}: it supports arbitrary changes to nodes in the
 graph.
diff --git a/guix/packages.scm b/guix/packages.scm
index f191327718..d20a2562c3 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -102,6 +102,7 @@
             package-transitive-supported-systems
             package-mapping
             package-input-rewriting
+            package-input-rewriting/spec
             package-source-derivation
             package-derivation
             package-cross-derivation
@@ -869,6 +870,43 @@ package and returns its new name after rewrite."
 
   (package-mapping rewrite (cut assq <> replacements)))
 
+(define (package-input-rewriting/spec replacements)
+  "Return a procedure that, given a package, applies the given REPLACEMENTS to
+all the package graph (excluding implicit inputs).  REPLACEMENTS is a list of
+spec/procedures pair; each spec is a package specification such as \"gcc\" or
+\"guile <at> 2\", and each procedure takes a matching package and returns a
+replacement for that package."
+  (define table
+    (fold (lambda (replacement table)
+            (match replacement
+              ((spec . proc)
+               (let-values (((name version)
+                             (package-name->name+version spec)))
+                 (vhash-cons name (list version proc) table)))))
+          vlist-null
+          replacements))
+
+  (define (find-replacement package)
+    (vhash-fold* (lambda (item proc)
+                   (or proc
+                       (match item
+                         ((#f proc)
+                          proc)
+                         ((version proc)
+                          (and (version-prefix? version
+                                                (package-version package))
+                               proc)))))
+                 #f
+                 (package-name package)
+                 table))
+
+  (define (rewrite package)
+    (match (find-replacement package)
+      (#f package)
+      (proc (proc package))))
+
+  (package-mapping rewrite find-replacement))
+
 (define-syntax-rule (package/inherit p overrides ...)
   "Like (package (inherit P) OVERRIDES ...), except that the same
 transformation is done to the package replacement, if any.  P must be a bare
diff --git a/tests/packages.scm b/tests/packages.scm
index 4e4bffc48c..613b2f1221 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -981,6 +981,57 @@
                    ((("x" dep))
                     (eq? dep findutils)))))))))
 
+(test-assert "package-input-rewriting/spec"
+  (let* ((dep     (dummy-package "chbouib"
+                    (native-inputs `(("x" ,grep)))))
+         (p0      (dummy-package "example"
+                    (inputs `(("foo" ,coreutils)
+                              ("bar" ,grep)
+                              ("baz" ,dep)))))
+         (rewrite (package-input-rewriting/spec
+                   `(("coreutils" . ,(const sed))
+                     ("grep" . ,(const findutils)))))
+         (p1      (rewrite p0))
+         (p2      (rewrite p0)))
+    (and (not (eq? p1 p0))
+         (eq? p1 p2)                              ;memoization
+         (string=? "example" (package-name p1))
+         (match (package-inputs p1)
+           ((("foo" dep1) ("bar" dep2) ("baz" dep3))
+            (and (string=? (package-full-name dep1)
+                           (package-full-name sed))
+                 (string=? (package-full-name dep2)
+                           (package-full-name findutils))
+                 (string=? (package-name dep3) "chbouib")
+                 (eq? dep3 (rewrite dep))         ;memoization
+                 (match (package-native-inputs dep3)
+                   ((("x" dep))
+                    (string=? (package-full-name dep)
+                              (package-full-name findutils))))))))))
+
+(test-assert "package-input-rewriting/spec, partial match"
+  (let* ((dep     (dummy-package "chbouib"
+                    (version "1")
+                    (native-inputs `(("x" ,grep)))))
+         (p0      (dummy-package "example"
+                    (inputs `(("foo" ,coreutils)
+                              ("bar" ,dep)))))
+         (rewrite (package-input-rewriting/spec
+                   `(("chbouib <at> 123" . ,(const sed)) ;not matched
+                     ("grep" . ,(const findutils)))))
+         (p1      (rewrite p0)))
+    (and (not (eq? p1 p0))
+         (string=? "example" (package-name p1))
+         (match (package-inputs p1)
+           ((("foo" dep1) ("bar" dep2))
+            (and (string=? (package-full-name dep1)
+                           (package-full-name coreutils))
+                 (eq? dep2 (rewrite dep))         ;memoization
+                 (match (package-native-inputs dep2)
+                   ((("x" dep))
+                    (string=? (package-full-name dep)
+                              (package-full-name findutils))))))))))
+
 (test-equal "package-patched-vulnerabilities"
   '(("CVE-2015-1234")
     ("CVE-2016-1234" "CVE-2018-4567")
-- 
2.21.0

Message #14 received at 34838 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 34838 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludovic.courtes <at> inria.fr>
Subject: [PATCH 5/6] guix build: '--with-commit' makes recursive checkouts.
Date: Wed, 13 Mar 2019 11:47:50 +0100

From: Ludovic Courtès <ludovic.courtes <at> inria.fr>

This was an omission from commit
024a6bfba906742c136a47b4099f06880f1d3f15.

* guix/scripts/build.scm (transform-package-source-commit): Add
'recursive?' field to SOURCE.
* tests/scripts-build.scm ("options->transformation, with-branch")
("options->transformation, with-commit"): New tests.
---
 guix/scripts/build.scm  |  3 ++-
 tests/scripts-build.scm | 49 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 51 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 8ebcf79243..20929d6110 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -342,7 +342,8 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
                               (if (< (string-length commit) 7)
                                   commit
                                   (string-take commit 7))))
-      (source (git-checkout (url url) (commit commit)))))
+      (source (git-checkout (url url) (commit commit)
+                            (recursive? #t)))))
 
   (let* ((replacements (evaluate-git-replacement-specs replacement-specs
                                                        replace))
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index 4bf1e1a719..32876e956a 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -20,6 +20,7 @@
   #:use-module (guix tests)
   #:use-module (guix store)
   #:use-module (guix packages)
+  #:use-module (guix git-download)
   #:use-module (guix scripts build)
   #:use-module (guix ui)
   #:use-module (guix utils)
@@ -168,6 +169,54 @@
                        ((("x" dep))
                         (eq? (package-replacement dep) findutils)))))))))))
 
+(test-equal "options->transformation, with-branch"
+  (git-checkout (url "https://example.org")
+                (branch "devel")
+                (recursive? #t))
+  (let* ((p (dummy-package "guix.scm"
+              (inputs `(("foo" ,grep)
+                        ("bar" ,(dummy-package "chbouib"
+                                  (source (origin
+                                            (method git-fetch)
+                                            (uri (git-reference
+                                                  (url "https://example.org")
+                                                  (commit "cabba9e")))
+                                            (sha256 #f)))))))))
+         (t (options->transformation '((with-branch . "chbouib=devel")))))
+    (with-store store
+      (let ((new (t store p)))
+        (and (not (eq? new p))
+             (match (package-inputs new)
+               ((("foo" dep1) ("bar" dep2))
+                (and (string=? (package-full-name dep1)
+                               (package-full-name grep))
+                     (string=? (package-name dep2) "chbouib")
+                     (package-source dep2)))))))))
+
+(test-equal "options->transformation, with-commit"
+  (git-checkout (url "https://example.org")
+                (commit "abcdef")
+                (recursive? #t))
+  (let* ((p (dummy-package "guix.scm"
+              (inputs `(("foo" ,grep)
+                        ("bar" ,(dummy-package "chbouib"
+                                  (source (origin
+                                            (method git-fetch)
+                                            (uri (git-reference
+                                                  (url "https://example.org")
+                                                  (commit "cabba9e")))
+                                            (sha256 #f)))))))))
+         (t (options->transformation '((with-commit . "chbouib=abcdef")))))
+    (with-store store
+      (let ((new (t store p)))
+        (and (not (eq? new p))
+             (match (package-inputs new)
+               ((("foo" dep1) ("bar" dep2))
+                (and (string=? (package-full-name dep1)
+                               (package-full-name grep))
+                     (string=? (package-name dep2) "chbouib")
+                     (package-source dep2)))))))))
+
 (test-equal "options->transformation, with-git-url"
   (let ((source (git-checkout (url "https://example.org")
                               (recursive? #t))))
-- 
2.21.0

Message #17 received at 34838 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 34838 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludovic.courtes <at> inria.fr>
Subject: [PATCH 1/6] guix build: Add '--with-git-url'.
Date: Wed, 13 Mar 2019 11:47:46 +0100

From: Ludovic Courtès <ludovic.courtes <at> inria.fr>

* guix/scripts/build.scm (%not-equal): New variable.
(evaluate-git-replacement-specs): Use it instead of local variable
'not-equal'.
(transform-package-source-git-url): New procedure.
(%transformations): Add 'with-git-url'.
(%transformation-options, show-transformation-options-help): Add
'--with-git-url'.
* tests/scripts-build.scm ("options->transformation, with-git-url"):
New test.
---
 doc/guix.texi           | 36 ++++++++++++++++++++-----------
 guix/scripts/build.scm  | 47 +++++++++++++++++++++++++++++++++++------
 tests/scripts-build.scm | 24 ++++++++++++++++++++-
 3 files changed, 87 insertions(+), 20 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 82cf2babb2..42885577be 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7694,9 +7694,32 @@ must be compatible.  If @var{replacement} is somehow incompatible with
 @var{package}, then the resulting package may be unusable.  Use with
 care!
 
-@item --with-branch=@var{package}=@var{branch}
+@item --with-git-url=@var{package}=@var{url}
 @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}.
+
+For example, the following commands builds the GNU C Library (glibc) straight
+from its Git repository instead of building the currently-packaged release:
+
+@example
+guix build glibc \
+  --with-git-url=glibc=git://sourceware.org/git/glibc.git
+@end example
+
+@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
+rebuild entire software stacks against the latest commit of one or more
+packages.  This is particularly useful in the context of continuous
+integration (CI).
+
+Checkouts are kept in a cache under @file{~/.cache/guix/checkouts} to speed up
+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
@@ -7712,17 +7735,6 @@ specific @code{guile-sqlite3} build:
 guix build --with-branch=guile-sqlite3=master cuirass
 @end example
 
-@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
-rebuild entire software stacks against the latest commit of one or more
-packages.  This is particularly useful in the context of continuous
-integration (CI).
-
-Checkouts are kept in a cache under @file{~/.cache/guix/checkouts} to speed up
-consecutive accesses to the same repository.  You may want to clean it up once
-in a while to save disk space.
-
 @item --with-commit=@var{package}=@var{commit}
 This is similar to @code{--with-branch}, except that it builds from
 @var{commit} rather than the tip of a branch.  @var{commit} must be a valid
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 6b29c470fb..5883dbfb44 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -272,16 +272,16 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
           (rewrite obj)
           obj))))
 
+(define %not-equal
+  (char-set-complement (char-set #\=)))
+
 (define (evaluate-git-replacement-specs specs proc)
   "Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list
 of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the
 replacement package.  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)
+         (match (string-tokenize spec %not-equal)
            ((name branch-or-commit)
             (let* ((old    (specification->package name))
                    (source (package-source old))
@@ -341,6 +341,33 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
           (rewrite obj)
           obj))))
 
+(define (transform-package-source-git-url replacement-specs)
+  "Return a procedure that, when passed a package, replaces its dependencies
+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)))))
+         replacement-specs))
+
+  (define rewrite
+    (package-input-rewriting replacements))
+
+  (lambda (store obj)
+    (if (package? obj)
+        (rewrite 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
@@ -350,7 +377,8 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
     (with-input  . ,transform-package-inputs)
     (with-graft  . ,transform-package-inputs/graft)
     (with-branch . ,transform-package-source-branch)
-    (with-commit . ,transform-package-source-commit)))
+    (with-commit . ,transform-package-source-commit)
+    (with-git-url . ,transform-package-source-git-url)))
 
 (define %transformation-options
   ;; The command-line interface to the above transformations.
@@ -368,7 +396,9 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
           (option '("with-branch") #t #f
                   (parser 'with-branch))
           (option '("with-commit") #t #f
-                  (parser 'with-commit)))))
+                  (parser 'with-commit))
+          (option '("with-git-url") #t #f
+                  (parser 'with-git-url)))))
 
 (define (show-transformation-options-help)
   (display (G_ "
@@ -385,7 +415,10 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
                          build PACKAGE from the latest commit of BRANCH"))
   (display (G_ "
       --with-commit=PACKAGE=COMMIT
-                         build PACKAGE from COMMIT")))
+                         build PACKAGE from COMMIT"))
+  (display (G_ "
+      --with-git-url=PACKAGE=URL
+                         build PACKAGE from the repository at URL")))
 
 
 (define (options->transformation opts)
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index 190426ed06..54681274b9 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo <at> gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +23,7 @@
   #:use-module (guix scripts build)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix git)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages busybox)
@@ -164,4 +165,25 @@
                        ((("x" dep))
                         (eq? (package-replacement dep) findutils)))))))))))
 
+(test-equal "options->transformation, with-git-url"
+  (let ((source (git-checkout (url "https://example.org")
+                              (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 '((with-git-url . "grep=https://example.org")))))
+    (with-store store
+      (let ((new (t store p)))
+        (and (not (eq? new p))
+             (match (package-inputs new)
+               ((("foo" dep1) ("bar" dep2))
+                (and (string=? (package-full-name dep1)
+                               (package-full-name grep))
+                     (string=? (package-name dep2) "chbouib")
+                     (match (package-native-inputs dep2)
+                       ((("x" dep3))
+                        (map package-source (list dep1 dep3))))))))))))
+
 (test-end)
-- 
2.21.0

Message #20 received at 34838 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 34838 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 6/6] guix build: '--with-branch' strips slashes from the
 version string.
Date: Wed, 13 Mar 2019 11:47:51 +0100

This fixes things like:

  guix build glibc \
    --with-git-url=glibc=git://sourceware.org/git/glibc.git \
    --with-branch=glibc=release/2.25/master

whereby slashes would before go straight to the 'version' field, leading
to an invalid store file name.

* guix/scripts/build.scm (transform-package-source-branch)[replace]:
Replace slashes with hyphens in BRANCH when building the version
string.
---
 guix/scripts/build.scm | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 20929d6110..28864435df 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -318,7 +318,10 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
   (define (replace old url branch)
     (package
       (inherit old)
-      (version (string-append "git." branch))
+      (version (string-append "git." (string-map (match-lambda
+                                                   (#\/ #\-)
+                                                   (chr chr))
+                                                 branch)))
       (source (git-checkout (url url) (branch branch)
                             (recursive? #t)))))
 
-- 
2.21.0

Message #23 received at 34838 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 34838 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludovic.courtes <at> inria.fr>
Subject: [PATCH 4/6] guix build: Transformation options match packages by spec.
Date: Wed, 13 Mar 2019 11:47:49 +0100

From: Ludovic Courtès <ludovic.courtes <at> inria.fr>

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.
---
 doc/guix.texi           | 24 ++++++-----
 guix/scripts/build.scm  | 90 +++++++++++++++++++++++------------------
 tests/scripts-build.scm | 36 +++++++++++++++--
 3 files changed, 97 insertions(+), 53 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b0b7ee5dd0..6779ea418e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7721,16 +7721,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
@@ -7743,11 +7747,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 <at> 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 <at> 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 <at> 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 <at> 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)
-- 
2.21.0

Message #28 received at 34838-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 34838-done <at> debbugs.gnu.org
Subject: Re: [bug#34838] [PATCH 0/6] Add '--with-git-url' and make sure it
 composes well
Date: Sun, 17 Mar 2019 22:56:27 +0100

Ludovic Courtès <ludo <at> gnu.org> skribis:

> This patch series allows for things like this:
>
>   guix build python-numpy \
>     --with-git-url=python=https://github.com/python/cpython \
>     --with-commit=python=86900a49000c4a96ad1dc34e49d8af4245b08843

Merged!

  d831b19079 guix build: '--with-branch' strips slashes from the version string.
  845c44012c guix build: '--with-commit' makes recursive checkouts.
  14328b81a2 guix build: Transformation options match packages by spec.
  0c0ff42a24 guix build: Factorize 'package-git-url'.
  f258d88628 packages: Add 'package-input-rewriting/spec'.
  880916ac52 guix build: Add '--with-git-url'.

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.