aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi18
-rw-r--r--guix/transformations.scm63
-rw-r--r--tests/transformations.scm24
3 files changed, 104 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index b12cb11bdf..6c681494a2 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 _
@@ -538,6 +596,9 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field."
--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"))
(display (G_ "
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: