mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-31 06:46:50 +01:00
packages: Add #:recursive? to ‘package-input-rewriting’.
* guix/packages.scm (package-input-rewriting): Add #:recursive? [cut?]: Honor it. * tests/packages.scm ("package-input-rewriting, recursive"): New test. * doc/guix.texi (Defining Package Variants): Document it. Change-Id: Ie82f35ae0ae873dc68f8b1c0dd6616f552772e65
This commit is contained in:
parent
2767b4ef03
commit
5316e84e1b
3 changed files with 42 additions and 3 deletions
|
@ -8665,13 +8665,17 @@ Dependency graph rewriting, for the purposes of swapping packages in the
|
||||||
graph, is what the @code{package-input-rewriting} procedure in
|
graph, is what the @code{package-input-rewriting} procedure in
|
||||||
@code{(guix packages)} implements.
|
@code{(guix packages)} implements.
|
||||||
|
|
||||||
@deffn {Procedure} package-input-rewriting replacements [rewrite-name] [#:deep? #t]
|
@deffn {Procedure} package-input-rewriting replacements [rewrite-name] @
|
||||||
|
[#:deep? #t] [#:recursive? #f]
|
||||||
Return a procedure that, when passed a package, replaces its direct and
|
Return a procedure that, when passed a package, replaces its direct and
|
||||||
indirect dependencies, including implicit inputs when @var{deep?} is
|
indirect dependencies, including implicit inputs when @var{deep?} is
|
||||||
true, according to @var{replacements}. @var{replacements} is a list of
|
true, according to @var{replacements}. @var{replacements} is a list of
|
||||||
package pairs; the first element of each pair is the package to replace,
|
package pairs; the first element of each pair is the package to replace,
|
||||||
and the second one is the replacement.
|
and the second one is the replacement.
|
||||||
|
|
||||||
|
When @var{recursive?} is true, apply replacements to the right-hand sides of
|
||||||
|
@var{replacements} as well, recursively.
|
||||||
|
|
||||||
Optionally, @var{rewrite-name} is a one-argument procedure that takes
|
Optionally, @var{rewrite-name} is a one-argument procedure that takes
|
||||||
the name of a package and returns its new name after rewrite.
|
the name of a package and returns its new name after rewrite.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
|
@ -1585,12 +1585,16 @@ (define replace
|
||||||
|
|
||||||
(define* (package-input-rewriting replacements
|
(define* (package-input-rewriting replacements
|
||||||
#:optional (rewrite-name identity)
|
#:optional (rewrite-name identity)
|
||||||
#:key (deep? #t))
|
#:key (deep? #t)
|
||||||
|
(recursive? #f))
|
||||||
"Return a procedure that, when passed a package, replaces its direct and
|
"Return a procedure that, when passed a package, replaces its direct and
|
||||||
indirect dependencies, including implicit inputs when DEEP? is true, according
|
indirect dependencies, including implicit inputs when DEEP? is true, according
|
||||||
to REPLACEMENTS. REPLACEMENTS is a list of package pairs; the first element
|
to REPLACEMENTS. REPLACEMENTS is a list of package pairs; the first element
|
||||||
of each pair is the package to replace, and the second one is the replacement.
|
of each pair is the package to replace, and the second one is the replacement.
|
||||||
|
|
||||||
|
When RECURSIVE? is true, apply replacements to the right-hand sides of
|
||||||
|
REPLACEMENTS as well, recursively.
|
||||||
|
|
||||||
Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
|
Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
|
||||||
package and returns its new name after rewrite."
|
package and returns its new name after rewrite."
|
||||||
(define replacement-property
|
(define replacement-property
|
||||||
|
@ -1611,7 +1615,8 @@ (define (rewrite p)
|
||||||
|
|
||||||
(define (cut? p)
|
(define (cut? p)
|
||||||
(or (assq-ref (package-properties p) replacement-property)
|
(or (assq-ref (package-properties p) replacement-property)
|
||||||
(assq-ref replacements p)))
|
(and (not recursive?)
|
||||||
|
(assq-ref replacements p))))
|
||||||
|
|
||||||
(package-mapping rewrite cut?
|
(package-mapping rewrite cut?
|
||||||
#:deep? deep?))
|
#:deep? deep?))
|
||||||
|
|
|
@ -1501,6 +1501,36 @@ (define right-system?
|
||||||
((("python" python) _ ...)
|
((("python" python) _ ...)
|
||||||
(derivation-file-name (package-derivation %store python))))))
|
(derivation-file-name (package-derivation %store python))))))
|
||||||
|
|
||||||
|
(test-assert "package-input-rewriting, recursive"
|
||||||
|
(let* ((dep (dummy-package "dep" (native-inputs (list grep))))
|
||||||
|
(p0 (dummy-package "example1" (inputs (list dep grep))))
|
||||||
|
(p1 (dummy-package "example2" (inputs (list dep grep))))
|
||||||
|
(replacements `((,grep . ,findutils) (,p0 . ,p1)))
|
||||||
|
(rewrite (package-input-rewriting replacements))
|
||||||
|
(rewrite/recursive (package-input-rewriting replacements
|
||||||
|
#:recursive? #t))
|
||||||
|
(p2 (rewrite p0))
|
||||||
|
(p3 (rewrite/recursive p0)))
|
||||||
|
(and (string=? (package-name p2) "example2")
|
||||||
|
;; Here P0 is replaced by P1, but P1 itself is kept unchanged.
|
||||||
|
(match (package-inputs p2)
|
||||||
|
((("dep" dep1) ("grep" dep2))
|
||||||
|
(and (match (package-native-inputs dep1)
|
||||||
|
((("grep" x)) (eq? x grep)))
|
||||||
|
(eq? dep2 grep))))
|
||||||
|
|
||||||
|
;; Here P0 is replaced by P1, and in addition references to GREP in
|
||||||
|
;; P1 and its dependencies are also replaced by FINDUTILS.
|
||||||
|
(string=? (package-name p3) "example2")
|
||||||
|
(match (package-inputs p3)
|
||||||
|
((("dep" dep1) ("grep" dep2))
|
||||||
|
(and (match (package-native-inputs dep1)
|
||||||
|
((("grep" x))
|
||||||
|
(string=? (package-full-name x)
|
||||||
|
(package-full-name findutils))))
|
||||||
|
(string=? (package-full-name dep2)
|
||||||
|
(package-full-name findutils))))))))
|
||||||
|
|
||||||
(test-assert "package-input-rewriting/spec"
|
(test-assert "package-input-rewriting/spec"
|
||||||
(let* ((dep (dummy-package "chbouib"
|
(let* ((dep (dummy-package "chbouib"
|
||||||
(native-inputs `(("x" ,grep)))))
|
(native-inputs `(("x" ,grep)))))
|
||||||
|
|
Loading…
Reference in a new issue