aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2021-08-11 15:54:59 +0200
committerLudovic Courtès <ludo@gnu.org>2021-08-11 16:35:28 +0200
commit373e7ac4f9d510d3a58fcdbe9ec2d67eb426336b (patch)
tree5f8b69cfa8b7a458fd7f13f50a771e1ec306f855
parent168d107abf5608e6a1bfb37ee3448c4087856602 (diff)
downloadguix-373e7ac4f9d510d3a58fcdbe9ec2d67eb426336b.tar
guix-373e7ac4f9d510d3a58fcdbe9ec2d67eb426336b.tar.gz
transformations: 'with-patch' works on non-origin sources.
Fixes <https://issues.guix.gnu.org/49697>. Reported by Philippe Swartvagher <philippe.swartvagher@inria.fr>. * guix/transformations.scm (patched-source): New procedure. (transform-package-patches)[package-with-extra-patches]: Use it when (package-source p) is not an origin. * tests/transformations.scm ("options->transformation, with-commit + with-patch"): New test.
-rw-r--r--guix/transformations.scm45
-rw-r--r--tests/transformations.scm30
2 files changed, 65 insertions, 10 deletions
diff --git a/guix/transformations.scm b/guix/transformations.scm
index b0c09a0c92..5122baa403 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -460,19 +460,46 @@ to the same package but with #:strip-binaries? #f in its 'arguments' field."
(rewrite obj)
obj)))
+(define (patched-source name source patches)
+ "Return a file-like object with the given NAME that applies PATCHES to
+SOURCE. SOURCE must itself be a file-like object of any type, including
+<git-checkout>, <local-file>, etc."
+ (define patch
+ (module-ref (resolve-interface '(gnu packages base)) 'patch))
+
+ (computed-file name
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (setenv "PATH" #+(file-append patch "/bin"))
+
+ ;; XXX: Assume SOURCE is a directory. This is true in
+ ;; most practical cases, where it's a <git-checkout>.
+ (copy-recursively #+source #$output)
+ (chdir #$output)
+ (for-each (lambda (patch)
+ (invoke "patch" "-p1" "--batch"
+ "-i" patch))
+ '(#+@patches))))))
+
(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))
+ (let ((patches (map (lambda (file)
+ (local-file file))
+ patches)))
+ (if (origin? (package-source p))
+ (package/inherit p
+ (source (origin
+ (inherit (package-source p))
+ (patches (append patches
+ (origin-patches (package-source p)))))))
+ (package/inherit p
+ (source (patched-source (string-append (package-full-name p "-")
+ "-source")
+ (package-source p) patches))))))
(define (coalesce-alist alist)
;; Coalesce multiple occurrences of the same key in ALIST.
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 902bd45a6a..3417c994ec 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -29,7 +29,10 @@
#: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 gexp)
+ #:select (local-file? local-file-file
+ computed-file? computed-file-gexp
+ gexp-input-thing))
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix git)
@@ -400,6 +403,31 @@
(map local-file-file
(origin-patches (package-source dep)))))))))
+(test-equal "options->transformation, with-commit + with-patch"
+ '(#t #t)
+ (let* ((patch (search-patch "glibc-locales.patch"))
+ (commit "f8934ec94df5868ee8baf1fb0f8ed0f24e7e91eb")
+ (t (options->transformation
+ ;; Note: options are applied in reverse order, so
+ ;; 'with-patch' comes on top.
+ `((with-patch . ,(string-append "guile-gcrypt=" patch))
+ (with-commit
+ . ,(string-append "guile-gcrypt=" commit))))))
+ (let ((new (t (@ (gnu packages gnupg) guile-gcrypt))))
+ (match (package-source new)
+ ((? computed-file? source)
+ (let* ((gexp (computed-file-gexp source))
+ (inputs (map gexp-input-thing
+ ((@@ (guix gexp) gexp-inputs) gexp))))
+ (list (any (lambda (input)
+ (and (git-checkout? input)
+ (string=? commit (git-checkout-commit input))))
+ inputs)
+ (any (lambda (input)
+ (and (local-file? input)
+ (string=? (local-file-file input) patch)))
+ inputs))))))))
+
(test-equal "options->transformation, with-latest"
"42.0"
(mock ((guix upstream) %updaters