* bug#45300: [PATCH] Add option --with-patch
2020-12-17 11:42 bug#45300: [Suggestion] Add option --with-patch Philippe SWARTVAGHER
@ 2020-12-21 13:57 ` Ludovic Courtès
2020-12-27 16:25 ` Ludovic Courtès
0 siblings, 1 reply; 3+ messages in thread
From: Ludovic Courtès @ 2020-12-21 13:57 UTC (permalink / raw)
To: Philippe SWARTVAGHER; +Cc: 45300
[-- 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
^ permalink raw reply related [flat|nested] 3+ messages in thread