diff options
| -rw-r--r-- | doc/guix.texi | 10 | ||||
| -rw-r--r-- | gnu/packages/guile.scm | 6 | ||||
| -rw-r--r-- | guix/packages.scm | 35 | ||||
| -rw-r--r-- | tests/packages.scm | 20 |
4 files changed, 52 insertions, 19 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index e72e1ec130..0805e2d508 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6238,12 +6238,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" |