[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#43578] [PATCH 4/4] packages: 'package-input-rewriting' has a #:deep
From: |
Ludovic Courtès |
Subject: |
[bug#43578] [PATCH 4/4] packages: 'package-input-rewriting' has a #:deep? parameter. |
Date: |
Wed, 23 Sep 2020 18:23:18 +0200 |
* guix/packages.scm (package-input-rewriting): Add #:deep? and pass it
to 'package-mapping'.
[replacement-property]: New variable.
[rewrite]: Check it.
[cut?]: New procedure.
* tests/packages.scm ("package-input-rewriting"): Pass #:deep? #f and
ensure implicit inputs were not rewritten. Avoid 'eq?' comparisons.
("package-input-rewriting, deep"): New test.
* gnu/packages/guile.scm (package-for-guile-2.0, package-for-guile-3.0):
Pass #:deep? #f.
---
doc/guix.texi | 10 +++++-----
gnu/packages/guile.scm | 6 ++++--
guix/packages.scm | 35 +++++++++++++++++++++++++----------
tests/packages.scm | 20 ++++++++++++++++++--
4 files changed, 52 insertions(+), 19 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index e9e1d122ab..193529bbb1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6236,12 +6236,12 @@ transformation is @dfn{input rewriting}, whereby the
dependency tree of
a package is rewritten by replacing specific inputs by others:
@deffn {Scheme Procedure} package-input-rewriting @var{replacements} @
- [@var{rewrite-name}]
+ [@var{rewrite-name}] [#:deep? #t]
Return a procedure that, when passed a package, replaces its direct and
-indirect dependencies (but not its implicit inputs) according to
-@var{replacements}. @var{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.
+indirect dependencies, including implicit inputs when @var{deep?} is
+true, according to @var{replacements}. @var{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.
Optionally, @var{rewrite-name} is a one-argument procedure that takes
the name of a package and returns its new name after rewrite.
diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm
index c59daeebe2..280053bf06 100644
--- a/gnu/packages/guile.scm
+++ b/gnu/packages/guile.scm
@@ -420,11 +420,13 @@ GNU@tie{}Guile. Use the @code{(ice-9 readline)} module
and call its
;; A procedure that rewrites the dependency tree of the given package to use
;; GUILE-2.0 instead of GUILE-3.0.
(package-input-rewriting `((,guile-3.0 . ,guile-2.0))
- (guile-variant-package-name "guile2.0")))
+ (guile-variant-package-name "guile2.0")
+ #:deep? #f))
(define package-for-guile-2.2
(package-input-rewriting `((,guile-3.0 . ,guile-2.2))
- (guile-variant-package-name "guile2.2")))
+ (guile-variant-package-name "guile2.2")
+ #:deep? #f))
(define-syntax define-deprecated-guile3.0-package
(lambda (s)
diff --git a/guix/packages.scm b/guix/packages.scm
index 0d0d7492b6..4f2bb432be 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1044,22 +1044,37 @@ applied to implicit inputs as well."
replace)
(define* (package-input-rewriting replacements
- #:optional (rewrite-name identity))
+ #:optional (rewrite-name identity)
+ #:key (deep? #t))
"Return a procedure that, when passed a package, replaces its direct and
-indirect dependencies (but not its implicit inputs) according 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.
+indirect dependencies, including implicit inputs when DEEP? is true, according
+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.
Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
package and returns its new name after rewrite."
+ (define replacement-property
+ ;; Property to tag right-hand sides in REPLACEMENTS.
+ (gensym " package-replacement"))
+
(define (rewrite p)
- (match (assq-ref replacements p)
- (#f (package
- (inherit p)
- (name (rewrite-name (package-name p)))))
- (new new)))
+ (if (assq-ref (package-properties p) replacement-property)
+ p
+ (match (assq-ref replacements p)
+ (#f (package/inherit p
+ (name (rewrite-name (package-name p)))))
+ (new (if deep?
+ (package/inherit new
+ (properties `((,replacement-property . #t)
+ ,@(package-properties new))))
+ new)))))
- (package-mapping rewrite (cut assq <> replacements)))
+ (define (cut? p)
+ (or (assq-ref (package-properties p) replacement-property)
+ (assq-ref replacements p)))
+
+ (package-mapping rewrite cut?
+ #:deep? deep?))
(define* (package-input-rewriting/spec replacements #:key (deep? #t))
"Return a procedure that, given a package, applies the given REPLACEMENTS to
diff --git a/tests/packages.scm b/tests/packages.scm
index e31dea6f72..af8941c2e2 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1239,7 +1239,8 @@
("baz" ,dep)))))
(rewrite (package-input-rewriting `((,coreutils . ,sed)
(,grep . ,findutils))
- (cut string-append "r-" <>)))
+ (cut string-append "r-" <>)
+ #:deep? #f))
(p1 (rewrite p0))
(p2 (rewrite p0)))
(and (not (eq? p1 p0))
@@ -1253,7 +1254,22 @@
(eq? dep3 (rewrite dep)) ;memoization
(match (package-native-inputs dep3)
((("x" dep))
- (eq? dep findutils)))))))))
+ (eq? dep findutils))))))
+
+ ;; Make sure implicit inputs were left unchanged.
+ (equal? (drop (bag-direct-inputs (package->bag p1)) 3)
+ (drop (bag-direct-inputs (package->bag p0)) 3)))))
+
+(test-eq "package-input-rewriting, deep"
+ (derivation-file-name (package-derivation %store sed))
+ (let* ((p0 (dummy-package "chbouib"
+ (build-system python-build-system)
+ (arguments `(#:python ,python))))
+ (rewrite (package-input-rewriting `((,python . ,sed))))
+ (p1 (rewrite p0)))
+ (match (bag-direct-inputs (package->bag p1))
+ ((("python" python) _ ...)
+ (derivation-file-name (package-derivation %store python))))))
(test-assert "package-input-rewriting/spec"
(let* ((dep (dummy-package "chbouib"
--
2.28.0