bug#45300: [Suggestion] Add option --with-patch

bug#45300: [Suggestion] Add option --with-patch

[Philippe SWARTVAGHER]

Hello,

We already have `--with-branch=`, `with-commit=`, ... An additional
option could be `--with-patch=package=add-extra-feature.patch` which
would apply the patch file `add-extra-feature.patch` located in the my
current directory to the sources of `package` before Guix starts
building `package`.

This would bring the possibility to easily share patches (for tests,
reviews, ... for instance) without having to commit the patch in the
source repository of the package, without changing the package
definition, and without applying ourselves the patch to our local source
repository of the package.

Thanks !

-- 
Philippe SWARTVAGHER

PhD Student
TADaaM team, Inria Bordeaux Sud-Ouest

bug#45300: [PATCH] Add option --with-patch

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 471 bytes --]

Hi Philippe,

Philippe SWARTVAGHER <philippe.swartvagher@inria.fr> skribis:

> We already have `--with-branch=`, `with-commit=`, ... An additional
> option could be `--with-patch=package=add-extra-feature.patch` which
> would apply the patch file `add-extra-feature.patch` located in the my
> current directory to the sources of `package` before Guix starts
> building `package`.

Good idea!  The patch below does that.

Feedback welcome.  :-)

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: the patch --]
[-- Type: text/x-patch, Size: 7814 bytes --]

From 12c8df7c61537e3834fac4bf0e8e340cbac2d2df Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludovic.courtes@inria.fr>
Date: Mon, 21 Dec 2020 14:52:38 +0100
Subject: [PATCH] transformations: Add '--with-patch'.

Suggested by Philippe Swartvagher <philippe.swartvagher@inria.fr>.

* guix/transformations.scm (transform-package-patches): New procedure.
(%transformations): Add it as 'with-patch'.
(%transformation-options, show-transformation-options-help/detailed):
Add '--with-patch'.
* tests/transformations.scm ("options->transformation, with-patch"): New
test.
* doc/guix.texi (Package Transformation Options): Document it.
---
 doc/guix.texi             | 18 +++++++++++
 guix/transformations.scm  | 63 ++++++++++++++++++++++++++++++++++++++-
 tests/transformations.scm | 24 +++++++++++++++
 3 files changed, 104 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 392baf5910..c172a898cd 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10357,6 +10357,24 @@ This is similar to @option{--with-branch}, except that it builds from
 @var{commit} rather than the tip of a branch.  @var{commit} must be a valid
 Git commit SHA1 identifier or a tag.
 
+@item --with-patch=@var{package}=@var{file}
+Add @var{file} to the list of patches applied to @var{package}, where
+@var{package} is a spec such as @code{python@@3.8} or @code{glibc}.
+@var{file} must contain a patch; it is applied with the flags specified
+in the @code{origin} of @var{package} (@pxref{origin Reference}), which
+by default includes @code{-p1} (@pxref{patch Directories,,, diffutils,
+Comparing and Merging Files}).
+
+As an example, the command below rebuilds Coreutils with the GNU C
+Library (glibc) patched with the given patch:
+
+@example
+guix build coreutils --with-patch=glibc=./glibc-frob.patch
+@end example
+
+In this example, glibc itself as well as everything that leads to
+Coreutils in the dependency graph is rebuilt.
+
 @cindex test suite, skipping
 @item --without-tests=@var{package}
 Build @var{package} without running its tests.  This can be useful in
diff --git a/guix/transformations.scm b/guix/transformations.scm
index d49041cf59..2385d3231e 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -41,6 +41,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
   #:export (options->transformation
             manifest-entry-with-transformations
 
@@ -456,6 +457,60 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field."
         (rewrite obj)
         obj)))
 
+(define (transform-package-patches specs)
+  "Return a procedure that, when passed a package, returns a package with
+additional patches."
+  (define (package-with-extra-patches p patches)
+    (if (origin? (package-source p))
+        (package/inherit p
+          (source (origin
+                    (inherit (package-source p))
+                    (patches (append (map (lambda (file)
+                                            (local-file file))
+                                          patches)
+                                     (origin-patches (package-source p)))))))
+        p))
+
+  (define (coalesce-alist alist)
+    ;; Coalesce multiple occurrences of the same key in ALIST.
+    (let loop ((alist alist)
+               (keys '())
+               (mapping vlist-null))
+      (match alist
+        (()
+         (map (lambda (key)
+                (cons key (vhash-fold* cons '() key mapping)))
+              (delete-duplicates (reverse keys))))
+        (((key . value) . rest)
+         (loop rest
+               (cons key keys)
+               (vhash-cons key value mapping))))))
+
+  (define patches
+    ;; Spec/patch alist.
+    (coalesce-alist
+     (map (lambda (spec)
+            (match (string-tokenize spec %not-equal)
+              ((spec patch)
+               (cons spec (canonicalize-path patch)))
+              (_
+               (raise (formatted-message
+                       (G_ "~a: invalid package patch specification")
+                       spec)))))
+          specs)))
+
+  (define rewrite
+    (package-input-rewriting/spec
+     (map (match-lambda
+            ((spec . patches)
+             (cons spec (cut package-with-extra-patches <> patches))))
+          patches)))
+
+  (lambda (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
@@ -469,7 +524,8 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field."
     (with-git-url . ,transform-package-source-git-url)
     (with-c-toolchain . ,transform-package-toolchain)
     (with-debug-info . ,transform-package-with-debug-info)
-    (without-tests . ,transform-package-tests)))
+    (without-tests . ,transform-package-tests)
+    (with-patch  . ,transform-package-patches)))
 
 (define (transformation-procedure key)
   "Return the transformation procedure associated with KEY, a symbol such as
@@ -509,6 +565,8 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field."
                   (parser 'with-debug-info))
           (option '("without-tests") #t #f
                   (parser 'without-tests))
+          (option '("with-patch") #t #f
+                  (parser 'with-patch))
 
           (option '("help-transform") #f #f
                   (lambda _
@@ -537,6 +595,9 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field."
   (display (G_ "
       --with-git-url=PACKAGE=URL
                          build PACKAGE from the repository at URL"))
+  (display (G_ "
+      --with-patch=PACKAGE=FILE
+                         add FILE to the list of patches of PACKAGE"))
   (display (G_ "
       --with-c-toolchain=PACKAGE=TOOLCHAIN
                          build PACKAGE and its dependents with TOOLCHAIN"))
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 2d33bed7ae..9053deba41 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -26,6 +26,7 @@
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
   #:use-module (guix transformations)
+  #:use-module ((guix gexp) #:select (local-file? local-file-file))
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix git)
@@ -372,6 +373,29 @@
               (match (memq #:tests? (package-arguments tar))
                 ((#:tests? #f _ ...) #t))))))))
 
+(test-equal "options->transformation, with-patch"
+  (search-patches "glibc-locales.patch" "guile-relocatable.patch")
+  (let* ((dep    (dummy-package "dep"
+                   (source (dummy-origin))))
+         (p      (dummy-package "foo"
+                   (inputs `(("dep" ,dep)))))
+         (patch1 (search-patch "glibc-locales.patch"))
+         (patch2 (search-patch "guile-relocatable.patch"))
+         (t      (options->transformation
+                  `((with-patch . ,(string-append "dep=" patch1))
+                    (with-patch . ,(string-append "dep=" patch2))
+                    (with-patch . ,(string-append "tar=" patch1))))))
+    (let ((new (t p)))
+      (match (bag-direct-inputs (package->bag new))
+        ((("dep" dep) ("tar" tar) _ ...)
+         (and (member patch1
+                      (filter-map (lambda (patch)
+                                    (and (local-file? patch)
+                                         (local-file-file patch)))
+                                  (origin-patches (package-source tar))))
+              (map local-file-file
+                   (origin-patches (package-source dep)))))))))
+
 (test-end)
 
 ;;; Local Variables:
-- 
2.29.2

bug#45300: [PATCH] Add option --with-patch

[Ludovic Courtès]

Ludovic Courtès <ludovic.courtes@inria.fr> skribis:

>>From 12c8df7c61537e3834fac4bf0e8e340cbac2d2df Mon Sep 17 00:00:00 2001
> From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludovic.courtes@inria.fr>
> Date: Mon, 21 Dec 2020 14:52:38 +0100
> Subject: [PATCH] transformations: Add '--with-patch'.
>
> Suggested by Philippe Swartvagher <philippe.swartvagher@inria.fr>.
>
> * guix/transformations.scm (transform-package-patches): New procedure.
> (%transformations): Add it as 'with-patch'.
> (%transformation-options, show-transformation-options-help/detailed):
> Add '--with-patch'.
> * tests/transformations.scm ("options->transformation, with-patch"): New
> test.
> * doc/guix.texi (Package Transformation Options): Document it.

Pushed as e38d90d497e19e00263fa28961c688a433154386!

Ludo’.