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

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
;; 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)

View File

@ -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 (rewrite p)
(match (assq-ref replacements p)
(#f (package
(inherit p)
(name (rewrite-name (package-name p)))))
(new new)))
(define replacement-property
;; Property to tag right-hand sides in REPLACEMENTS.
(gensym " package-replacement"))
(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))
"Return a procedure that, given a package, applies the given REPLACEMENTS to

View File

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