From: "Ludovic Courtès" <ludovic.courtes@inria.fr>
To: Philippe SWARTVAGHER <philippe.swartvagher@inria.fr>
Cc: 45300@debbugs.gnu.org
Subject: bug#45300: [PATCH] Add option --with-patch
Date: Mon, 21 Dec 2020 14:57:54 +0100 [thread overview]
Message-ID: <87tusf6z31.fsf@gnu.org> (raw)
In-Reply-To: <603c5016-6eb1-4305-2825-ed0bacf66025@inria.fr> (Philippe SWARTVAGHER's message of "Thu, 17 Dec 2020 12:42:34 +0100")
[-- 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
next prev parent reply other threads:[~2020-12-21 13:59 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-12-17 11:42 bug#45300: [Suggestion] Add option --with-patch Philippe SWARTVAGHER
2020-12-21 13:57 ` Ludovic Courtès [this message]
2020-12-27 16:25 ` bug#45300: [PATCH] " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87tusf6z31.fsf@gnu.org \
--to=ludovic.courtes@inria.fr \
--cc=45300@debbugs.gnu.org \
--cc=philippe.swartvagher@inria.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).