diff options
| -rw-r--r-- | doc/guix.texi | 18 | ||||
| -rw-r--r-- | guix/transformations.scm | 63 | ||||
| -rw-r--r-- | tests/transformations.scm | 24 |
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: |