[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/04: transformations: 'with-patch' works on non-origin sources.
From: |
guix-commits |
Subject: |
03/04: transformations: 'with-patch' works on non-origin sources. |
Date: |
Wed, 11 Aug 2021 10:36:06 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 373e7ac4f9d510d3a58fcdbe9ec2d67eb426336b
Author: Ludovic Courtès <ludovic.courtes@inria.fr>
AuthorDate: Wed Aug 11 15:54:59 2021 +0200
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.
---
guix/transformations.scm | 45 ++++++++++++++++++++++++++++++++++++---------
tests/transformations.scm | 30 +++++++++++++++++++++++++++++-
2 files changed, 65 insertions(+), 10 deletions(-)
diff --git a/guix/transformations.scm b/guix/transformations.scm
index b0c09a0..5122baa 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 902bd45..3417c99 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