diff options
| -rw-r--r-- | guix/packages.scm | 63 | ||||
| -rw-r--r-- | tests/guix-build.sh | 6 | ||||
| -rw-r--r-- | tests/packages.scm | 43 |
3 files changed, 88 insertions, 24 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index 24d6417065..6fa761f569 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1015,8 +1015,7 @@ applied to implicit inputs as well." (define (rewrite input) (match input ((label (? package? package) outputs ...) - (let ((proc (if (cut? package) proc replace))) - (cons* label (proc package) outputs))) + (cons* label (replace package) outputs)) (_ input))) @@ -1027,28 +1026,44 @@ applied to implicit inputs as well." (define replace (mlambdaq (p) ;; If P is the result of a previous call, return it. - (if (assq-ref (package-properties p) mapping-property) - p - - ;; Return a variant of P with PROC applied to P and its explicit - ;; dependencies, recursively. Memoize the transformations. Failing - ;; 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)))))))) + (cond ((assq-ref (package-properties p) mapping-property) + p) + + ((cut? p) + ;; Since P's propagated inputs are really inputs of its dependents, + ;; rewrite them as well, unless we're doing a "shallow" rewrite. + (let ((p (proc p))) + (if (or (not deep?) + (null? (package-propagated-inputs p))) + p + (package + (inherit p) + (location (package-location p)) + (replacement (package-replacement p)) + (propagated-inputs (map rewrite (package-propagated-inputs p))) + (properties `((,mapping-property . #t) + ,@(package-properties p))))))) + + (else + ;; Return a variant of P with PROC applied to P and its explicit + ;; dependencies, recursively. Memoize the transformations. Failing + ;; 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) diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 4a58ea1476..b7602e668c 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -289,6 +289,12 @@ drv1=`guix build glib -d` drv2=`guix build glib -d --with-input=libreoffice=inkscape` 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. drv1=`guix build hello -d` drv2=`guix build hello -d --with-input=gcc=gcc-toolchain` diff --git a/tests/packages.scm b/tests/packages.scm index 2d13d91344..18e8e16e74 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1450,6 +1450,49 @@ (eq? foo grep) (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" '(("CVE-2015-1234") ("CVE-2016-1234" "CVE-2018-4567") |