ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

packages: 'package-input-rewriting/spec' can rewrite implicit dependencies.

Browse source 
With this change, '--with-input', '--with-graft', etc. also apply to
implicit dependencies.  Thus, it's now possible to do:

  guix build python-itsdangerous --with-input=python-wrapper=python@2

or:

  guix build hello --with-graft=glibc=glibc@2.29

Additionally, before, implicit inputs were not rewritten, which could
lead to duplicates in the output of 'bag-transitive-inputs' (packages
that are not 'eq?' but lead to the same derivation).  This in turn would
lead to unnecessary rebuilds when using '--with-input' & co.  This
change fixes it by ensuring even implicit inputs are rewritten.

Fixes <https://bugs.gnu.org/42156>.

* guix/packages.scm (package-input-rewriting/spec): Add #:deep?
defaulting to #true, and pass it to 'package-mapping'.
[replacement-property]: New variable.
[rewrite]: Check that property and set it on the result of PROC.
[cut?]: New procedure.
* tests/packages.scm ("package-input-rewriting/spec"): Ensure implicit
inputs were unchanged.
("package-input-rewriting/spec, partial match"): Pass #:deep? #f.
("package-input-rewriting/spec, deep")
("package-input-rewriting/spec, no duplicates"): New tests.
(package/inherit): Move before use.
* tests/guix-build.sh: Add tests.
* tests/scripts-build.scm ("options->transformation, with-graft"):
Compare dependencies by package name or derivation file name.
* doc/guix.texi (Defining Packages): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2020-09-23 10:29:09 +02:00
parent ff39361c80
commit 2bf6f962b9
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 124 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
doc/guix.texi
View file

@ -6272,12 +6272,13 @@ This is exactly what the @option{--with-input} command-line option does
The following variant of @code{package-input-rewriting} can match packages to
be replaced by name rather than by identity.
@deffn {Scheme Procedure} package-input-rewriting/spec @var{replacements}
Return a procedure that, given a package, applies the given @var{replacements} to
all the package graph (excluding implicit inputs). @var{replacements} is a list of
spec/procedures pair; each spec is a package specification such as @code{"gcc"} or
@code{"guile@@2"}, and each procedure takes a matching package and returns a
replacement for that package.
@deffn {Scheme Procedure} package-input-rewriting/spec @var{replacements} [#:deep? #t]
Return a procedure that, given a package, applies the given
@var{replacements} to all the package graph, including implicit inputs
unless @var{deep?} is false. @var{replacements} is a list of
spec/procedures pair; each spec is a package specification such as
@code{"gcc"} or @code{"guile@@2"}, and each procedure takes a matching
package and returns a replacement for that package.
@end deffn
The example above could be rewritten this way:

53
guix/packages.scm
View file

@ -422,6 +422,16 @@ (define-record-type* <package>
package)
16)))))
(define-syntax-rule (package/inherit p overrides ...)
"Like (package (inherit P) OVERRIDES ...), except that the same
transformation is done to the package replacement, if any. P must be a bare
identifier, and will be bound to either P or its replacement when evaluating
OVERRIDES."
(let loop ((p p))
(package (inherit p)
overrides ...
(replacement (and=> (package-replacement p) loop)))))
(define (package-upstream-name package)
"Return the upstream name of PACKAGE, which could be different from the name
it has in Guix."
@ -1051,12 +1061,12 @@ (define (rewrite p)
(package-mapping rewrite (cut assq <> replacements)))
(define (package-input-rewriting/spec replacements)
(define* (package-input-rewriting/spec replacements #:key (deep? #t))
"Return a procedure that, given a package, applies the given REPLACEMENTS to
all the package graph (excluding implicit inputs). REPLACEMENTS is a list of
spec/procedures pair; each spec is a package specification such as \"gcc\" or
\"guile@2\", and each procedure takes a matching package and returns a
replacement for that package."
all the package graph, including implicit inputs unless DEEP? is false.
REPLACEMENTS is a list of spec/procedures pair; each spec is a package
specification such as \"gcc\" or \"guile@2\", and each procedure takes a
matching package and returns a replacement for that package."
(define table
(fold (lambda (replacement table)
(match replacement
@ -1081,22 +1091,27 @@ (define (find-replacement package)
(package-name package)
table))
(define (rewrite package)
(match (find-replacement package)
(#f package)
(proc (proc package))))
(define replacement-property
(gensym " package-replacement"))
(package-mapping rewrite find-replacement))
(define (rewrite p)
(if (assq-ref (package-properties p) replacement-property)
p
(match (find-replacement p)
(#f p)
(proc
(let ((new (proc p)))
;; Mark NEW as already processed.
(package/inherit new
(properties `((,replacement-property . #t)
,@(package-properties new)))))))))
(define-syntax-rule (package/inherit p overrides ...)
"Like (package (inherit P) OVERRIDES ...), except that the same
transformation is done to the package replacement, if any. P must be a bare
identifier, and will be bound to either P or its replacement when evaluating
OVERRIDES."
(let loop ((p p))
(package (inherit p)
overrides ...
(replacement (and=> (package-replacement p) loop)))))
(define (cut? p)
(or (assq-ref (package-properties p) replacement-property)
(find-replacement p)))
(package-mapping rewrite cut?
#:deep? deep?))
;;;

11
tests/guix-build.sh
View file

@ -259,6 +259,17 @@ drv1=`guix build guile -d`
drv2=`guix build guile --with-input=gimp=ruby -d`
test "$drv1" = "$drv2"
# See <https://bugs.gnu.org/42156>.
drv1=`guix build glib -d`
drv2=`guix build glib -d --with-input=libreoffice=inkscape`
test "$drv1" = "$drv2"
# Rewriting implicit inputs.
drv1=`guix build hello -d`
drv2=`guix build hello -d --with-input=gcc=gcc-toolchain`
test "$drv1" != "$drv2"
guix gc -R "$drv2" | grep `guix build -d gcc-toolchain`
if guix build guile --with-input=libunistring=something-really-silly
then false; else true; fi

66
tests/packages.scm
View file

@ -38,6 +38,7 @@ (define-module (test-packages)
#:use-module (guix build-system)
#:use-module (guix build-system trivial)
#:use-module (guix build-system gnu)
#:use-module (guix build-system python)
#:use-module (guix memoization)
#:use-module (guix profiles)
#:use-module (guix scripts package)
@ -45,6 +46,7 @@ (define-module (test-packages)
#:use-module (gnu packages base)
#:use-module (gnu packages guile)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages python)
#:use-module (gnu packages version-control)
#:use-module (gnu packages xml)
#:use-module (srfi srfi-1)
@ -1262,7 +1264,8 @@ (define read-at
("baz" ,dep)))))
(rewrite (package-input-rewriting/spec
`(("coreutils" . ,(const sed))
("grep" . ,(const findutils)))))
("grep" . ,(const findutils)))
#:deep? #f))
(p1 (rewrite p0))
(p2 (rewrite p0)))
(and (not (eq? p1 p0))
@ -1279,7 +1282,11 @@ (define read-at
(match (package-native-inputs dep3)
((("x" dep))
(string=? (package-full-name dep)
(package-full-name findutils))))))))))
(package-full-name 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-assert "package-input-rewriting/spec, partial match"
(let* ((dep (dummy-package "chbouib"
@ -1290,7 +1297,8 @@ (define read-at
("bar" ,dep)))))
(rewrite (package-input-rewriting/spec
`(("chbouib@123" . ,(const sed)) ;not matched
("grep" . ,(const findutils)))))
("grep" . ,(const findutils)))
#:deep? #f))
(p1 (rewrite p0)))
(and (not (eq? p1 p0))
(string=? "example" (package-name p1))
@ -1304,6 +1312,58 @@ (define read-at
(string=? (package-full-name dep)
(package-full-name findutils))))))))))
(test-assert "package-input-rewriting/spec, deep"
(let* ((dep (dummy-package "chbouib"))
(p0 (dummy-package "example"
(build-system gnu-build-system)
(inputs `(("dep" ,dep)))))
(rewrite (package-input-rewriting/spec
`(("tar" . ,(const sed))
("gzip" . ,(const findutils)))))
(p1 (rewrite p0))
(p2 (rewrite p0)))
(and (not (eq? p1 p0))
(eq? p1 p2) ;memoization
(string=? "example" (package-name p1))
(match (package-inputs p1)
((("dep" dep1))
(and (string=? (package-full-name dep1)
(package-full-name dep))
(eq? dep1 (rewrite dep))))) ;memoization
;; Make sure implicit inputs were replaced.
(match (bag-direct-inputs (package->bag p1))
((("dep" dep1) ("tar" tar) ("gzip" gzip) _ ...)
(and (eq? dep1 (rewrite dep))
(string=? (package-full-name tar)
(package-full-name sed))
(string=? (package-full-name gzip)
(package-full-name findutils))))))))
(test-assert "package-input-rewriting/spec, no duplicates"
;; Ensure that deep input rewriting does not forget implicit inputs. Doing
;; so could lead to duplicates in a package's inputs: in the example below,
;; P0's transitive inputs would contain one rewritten "python" and one
;; original "python". These two "python" packages are thus not 'eq?' but
;; they lower to the same derivation. See <https://bugs.gnu.org/42156>,
;; which can be reproduced by passing #:deep? #f.
(let* ((dep0 (dummy-package "dep0"
(build-system trivial-build-system)
(propagated-inputs `(("python" ,python)))))
(p0 (dummy-package "chbouib"
(build-system python-build-system)
(arguments `(#:python ,python))
(inputs `(("dep0" ,dep0)))))
(rewrite (package-input-rewriting/spec '() #:deep? #t))
(p1 (rewrite p0))
(bag1 (package->bag p1))
(pythons (filter-map (match-lambda
(("python" python) python)
(_ #f))
(bag-transitive-inputs bag1))))
(match (delete-duplicates pythons eq?)
((p) (eq? p (rewrite python))))))
(test-equal "package-patched-vulnerabilities"
'(("CVE-2015-1234")
("CVE-2016-1234" "CVE-2018-4567")

12
tests/scripts-build.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,6 +19,7 @@
(define-module (test-scripts-build)
#:use-module (guix tests)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix git-download)
#:use-module (guix scripts build)
@ -163,11 +164,16 @@ (define-module (test-scripts-build)
((("foo" dep1) ("bar" dep2))
(and (string=? (package-full-name dep1)
(package-full-name grep))
(eq? (package-replacement dep1) findutils)
(string=? (package-full-name (package-replacement dep1))
(package-full-name findutils))
(string=? (package-name dep2) "chbouib")
(match (package-native-inputs dep2)
((("x" dep))
(eq? (package-replacement dep) findutils)))))))))))
(with-store store
(string=? (derivation-file-name
(package-derivation store findutils))
(derivation-file-name
(package-derivation store dep))))))))))))))
(test-equal "options->transformation, with-branch"
(git-checkout (url "https://example.org")