TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2021-08-11 15:54:59 +02:00 committed by Ludovic Courtès
parent 168d107abf
commit 373e7ac4f9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 65 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
guix/transformations.scm
View File

@ -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.

30
tests/transformations.scm
View File

@ -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