packages: Better preserve object identity when rewriting.

Fixes a bug whereby the presence of propagated inputs could lead to two
non-eq? but actually equal packages in a bag's inputs.  The problem
would manifest itself when running, for instance:

  guix build inkscape -d --with-graft=glib=glib-networking --no-grafts

The resulting derivation would differ due from that without
'--with-graft'.  This was due to the fact that glib propagates libffi;
this instance of libffi was not rewritten even though other instances in
the graph were rewritten.  Thus, glib would end up with two non-eq?
libffi instances, which in turn would lead to duplicate entries in its
'%build-inputs' variable.

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

* guix/packages.scm (package-mapping)[rewrite]: Remove call to 'cut?'
and call 'replace' unconditionally.
[replace]: Add 'cut?' case.
* tests/guix-build.sh: Add test combining '--no-grafts' and
'--with-graft'.
* tests/packages.scm ("package-input-rewriting/spec, identity")
("package-input-rewriting, identity"): New tests.
This commit is contained in:
Ludovic Courtès 2020-10-20 09:18:07 +02:00
parent 2bd60ca1fb
commit 8db4ebb0cd
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 87 additions and 23 deletions

View file

@ -1015,8 +1015,7 @@ (define* (package-mapping proc #:optional (cut? (const #f))
(define (rewrite input) (define (rewrite input)
(match input (match input
((label (? package? package) outputs ...) ((label (? package? package) outputs ...)
(let ((proc (if (cut? package) proc replace))) (cons* label (replace package) outputs))
(cons* label (proc package) outputs)))
(_ (_
input))) input)))
@ -1027,28 +1026,44 @@ (define mapping-property
(define replace (define replace
(mlambdaq (p) (mlambdaq (p)
;; If P is the result of a previous call, return it. ;; If P is the result of a previous call, return it.
(if (assq-ref (package-properties p) mapping-property) (cond ((assq-ref (package-properties p) mapping-property)
p p)
;; Return a variant of P with PROC applied to P and its explicit ((cut? p)
;; dependencies, recursively. Memoize the transformations. Failing ;; Since P's propagated inputs are really inputs of its dependents,
;; to do that, we would build a huge object graph with lots of ;; rewrite them as well, unless we're doing a "shallow" rewrite.
;; duplicates, which in turns prevents us from benefiting from (let ((p (proc p)))
;; memoization in 'package-derivation'. (if (or (not deep?)
(let ((p (proc p))) (null? (package-propagated-inputs p)))
(package p
(inherit p) (package
(location (package-location p)) (inherit p)
(build-system (if deep? (location (package-location p))
(build-system-with-package-mapping (replacement (package-replacement p))
(package-build-system p) rewrite) (propagated-inputs (map rewrite (package-propagated-inputs p)))
(package-build-system p))) (properties `((,mapping-property . #t)
(inputs (map rewrite (package-inputs p))) ,@(package-properties p)))))))
(native-inputs (map rewrite (package-native-inputs p)))
(propagated-inputs (map rewrite (package-propagated-inputs p))) (else
(replacement (and=> (package-replacement p) replace)) ;; Return a variant of P with PROC applied to P and its explicit
(properties `((,mapping-property . #t) ;; dependencies, recursively. Memoize the transformations. Failing
,@(package-properties p)))))))) ;; to do that, we would build a huge object graph with lots of
;; duplicates, which in turns prevents us from benefiting from
;; memoization in 'package-derivation'.
(let ((p (proc p)))
(package
(inherit p)
(location (package-location p))
(build-system (if deep?
(build-system-with-package-mapping
(package-build-system p) rewrite)
(package-build-system p)))
(inputs (map rewrite (package-inputs p)))
(native-inputs (map rewrite (package-native-inputs p)))
(propagated-inputs (map rewrite (package-propagated-inputs p)))
(replacement (and=> (package-replacement p) replace))
(properties `((,mapping-property . #t)
,@(package-properties p)))))))))
replace) replace)

View file

@ -289,6 +289,12 @@ drv1=`guix build glib -d`
drv2=`guix build glib -d --with-input=libreoffice=inkscape` drv2=`guix build glib -d --with-input=libreoffice=inkscape`
test "$drv1" = "$drv2" test "$drv1" = "$drv2"
# '--with-graft' should have no effect when using '--no-grafts'.
# See <https://bugs.gnu.org/43890>.
drv1=`guix build inkscape -d --no-grafts`
drv2=`guix build inkscape -d --no-grafts --with-graft=glib=glib-networking`
test "$drv1" = "$drv2"
# Rewriting implicit inputs. # Rewriting implicit inputs.
drv1=`guix build hello -d` drv1=`guix build hello -d`
drv2=`guix build hello -d --with-input=gcc=gcc-toolchain` drv2=`guix build hello -d --with-input=gcc=gcc-toolchain`

View file

@ -1450,6 +1450,49 @@ (define toolchain-packages
(eq? foo grep) (eq? foo grep)
(eq? bar dep)))))) (eq? bar dep))))))
(test-assert "package-input-rewriting/spec, identity"
;; Make sure that 'package-input-rewriting/spec' doesn't gratuitously
;; introduce variants. In this case, the LIBFFI propagated input should not
;; be duplicated when passing GOBJECT through REWRITE.
;; See <https://issues.guix.gnu.org/43890>.
(let* ((libffi (dummy-package "libffi"
(build-system trivial-build-system)))
(glib (dummy-package "glib"
(build-system trivial-build-system)
(propagated-inputs `(("libffi" ,libffi)))))
(gobject (dummy-package "gobject-introspection"
(build-system trivial-build-system)
(inputs `(("glib" ,glib)))
(propagated-inputs `(("libffi" ,libffi)))))
(rewrite (package-input-rewriting/spec
`(("glib" . ,identity)))))
(and (= (length (package-transitive-inputs gobject))
(length (package-transitive-inputs (rewrite gobject))))
(string=? (derivation-file-name
(package-derivation %store (rewrite gobject)))
(derivation-file-name
(package-derivation %store gobject))))))
(test-assert "package-input-rewriting, identity"
;; Similar to the test above, but with 'package-input-rewriting'.
;; See <https://issues.guix.gnu.org/43890>.
(let* ((libffi (dummy-package "libffi"
(build-system trivial-build-system)))
(glib (dummy-package "glib"
(build-system trivial-build-system)
(propagated-inputs `(("libffi" ,libffi)))))
(gobject (dummy-package "gobject-introspection"
(build-system trivial-build-system)
(inputs `(("glib" ,glib)))
(propagated-inputs `(("libffi" ,libffi)))))
(rewrite (package-input-rewriting `((,glib . ,glib)))))
(and (= (length (package-transitive-inputs gobject))
(length (package-transitive-inputs (rewrite gobject))))
(string=? (derivation-file-name
(package-derivation %store (rewrite gobject)))
(derivation-file-name
(package-derivation %store gobject))))))
(test-equal "package-patched-vulnerabilities" (test-equal "package-patched-vulnerabilities"
'(("CVE-2015-1234") '(("CVE-2015-1234")
("CVE-2016-1234" "CVE-2018-4567") ("CVE-2016-1234" "CVE-2018-4567")