me
/
guix
Archived
1
0
Fork 0

packages: 'package-input-rewriting' has a #:deep? parameter.

* 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.
master
Ludovic Courtès 2020-09-23 14:56:38 +02:00
parent b3fc03ee26
commit 8819551c8d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 53 additions and 20 deletions

View File

@ -6238,12 +6238,12 @@ transformation is @dfn{input rewriting}, whereby the dependency tree of
a package is rewritten by replacing specific inputs by others: a package is rewritten by replacing specific inputs by others:
@deffn {Scheme Procedure} package-input-rewriting @var{replacements} @ @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 Return a procedure that, when passed a package, replaces its direct and
indirect dependencies (but not its implicit inputs) according to indirect dependencies, including implicit inputs when @var{deep?} is
@var{replacements}. @var{replacements} is a list of package pairs; the true, according to @var{replacements}. @var{replacements} is a list of
first element of each pair is the package to replace, and the second one package pairs; the first element of each pair is the package to replace,
is the replacement. and the second one is the replacement.
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.

View File

@ -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 ;; A procedure that rewrites the dependency tree of the given package to use
;; GUILE-2.0 instead of GUILE-3.0. ;; GUILE-2.0 instead of GUILE-3.0.
(package-input-rewriting `((,guile-3.0 . ,guile-2.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 (define package-for-guile-2.2
(package-input-rewriting `((,guile-3.0 . ,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 (define-syntax define-deprecated-guile3.0-package
(lambda (s) (lambda (s)

View File

@ -1044,22 +1044,37 @@ applied to implicit inputs as well."
replace) replace)
(define* (package-input-rewriting replacements (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 "Return a procedure that, when passed a package, replaces its direct and
indirect dependencies (but not its implicit inputs) according to REPLACEMENTS. indirect dependencies, including implicit inputs when DEEP? is true, according
REPLACEMENTS is a list of package pairs; the first element of each pair is the to REPLACEMENTS. REPLACEMENTS is a list of package pairs; the first element
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.
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 (rewrite p) (define replacement-property
(match (assq-ref replacements p) ;; Property to tag right-hand sides in REPLACEMENTS.
(#f (package (gensym " package-replacement"))
(inherit p)
(name (rewrite-name (package-name p)))))
(new new)))
(package-mapping rewrite (cut assq <> replacements))) (define (rewrite p)
(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)))))
(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)) (define* (package-input-rewriting/spec replacements #:key (deep? #t))
"Return a procedure that, given a package, applies the given REPLACEMENTS to "Return a procedure that, given a package, applies the given REPLACEMENTS to

View File

@ -1239,7 +1239,8 @@
("baz" ,dep))))) ("baz" ,dep)))))
(rewrite (package-input-rewriting `((,coreutils . ,sed) (rewrite (package-input-rewriting `((,coreutils . ,sed)
(,grep . ,findutils)) (,grep . ,findutils))
(cut string-append "r-" <>))) (cut string-append "r-" <>)
#:deep? #f))
(p1 (rewrite p0)) (p1 (rewrite p0))
(p2 (rewrite p0))) (p2 (rewrite p0)))
(and (not (eq? p1 p0)) (and (not (eq? p1 p0))
@ -1253,7 +1254,22 @@
(eq? dep3 (rewrite dep)) ;memoization (eq? dep3 (rewrite dep)) ;memoization
(match (package-native-inputs dep3) (match (package-native-inputs dep3)
((("x" dep)) ((("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" (test-assert "package-input-rewriting/spec"
(let* ((dep (dummy-package "chbouib" (let* ((dep (dummy-package "chbouib"