summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-01-25 10:20:02 +0100
committerLudovic Courtès <ludo@gnu.org>2017-01-25 11:04:25 +0100
commit482fda2729c3e76999892cb8f9a0391a7bd37119 (patch)
tree377fa547185e3e9114d562033aac00de44efe226 /guix
parentad91454281506869f571e225a0ba7d09303f51a1 (diff)
grafts: Do not pull derivation outputs not depended on.
Fixes <http://bugs.gnu.org/24886>. Previously, the grafting derivation of, say, brdf-explorer would pull in qt:doc even though brdf-explorer depends only on qt:out, not qt:doc. * guix/grafts.scm (with-cache): Use 'vhash-assoc' and 'vhash-cons' instead of 'vhash-assq' and 'vhash-consq'. (cumulative-grafts): Pass #:outputs to 'graft-derivation/shallow'. Use OUTPUTS instead of (derivation-output-names drv). (graft-derivation): Add #:outputs parameter; pass it to 'cumulative-grafts'. * tests/grafts.scm (make-derivation-input): New variable. ("graft-derivation, replaced derivation has multiple outputs"): Make sure P2:zzz is not part of the outputs of P3D. ("graft-derivation with #:outputs") ("graft-derivation, unused outputs not depended on"): New tests.
Diffstat (limited to 'guix')
-rw-r--r--guix/grafts.scm25
1 files changed, 12 insertions, 13 deletions
diff --git a/guix/grafts.scm b/guix/grafts.scm
index e44fc0544f..11885db226 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -216,14 +216,14 @@ available."
(define-syntax-rule (with-cache key exp ...)
"Cache the value of monadic expression EXP under KEY."
(mlet %state-monad ((cache (current-state)))
- (match (vhash-assq key cache)
+ (match (vhash-assoc key cache)
((_ . result) ;cache hit
(return result))
(#f ;cache miss
(mlet %state-monad ((result (begin exp ...))
(cache (current-state)))
(mbegin %state-monad
- (set-current-state (vhash-consq key result cache))
+ (set-current-state (vhash-cons key result cache))
(return result)))))))
(define* (cumulative-grafts store drv grafts
@@ -264,7 +264,7 @@ derivations to the corresponding set of grafts."
#:system system))
(state-return grafts))))
- (with-cache drv
+ (with-cache (cons (derivation-file-name drv) outputs)
(match (non-self-references references drv outputs)
(() ;no dependencies
(return grafts))
@@ -281,29 +281,27 @@ derivations to the corresponding set of grafts."
;; applicable to DRV, to avoid creating several identical
;; grafted variants of DRV.
(let* ((new (graft-derivation/shallow store drv applicable
+ #:outputs outputs
#:guile guile
#:system system))
-
- ;; Replace references to any of the outputs of DRV,
- ;; even if that's more than needed. This is so that
- ;; the result refers only to the outputs of NEW and
- ;; not to those of DRV.
(grafts (append (map (lambda (output)
(graft
(origin drv)
(origin-output output)
(replacement new)
(replacement-output output)))
- (derivation-output-names drv))
+ outputs)
grafts)))
(return grafts))))))))))
(define* (graft-derivation store drv grafts
- #:key (guile (%guile-for-build))
+ #:key
+ (guile (%guile-for-build))
+ (outputs (derivation-output-names drv))
(system (%current-system)))
- "Applied GRAFTS to DRV and all its dependencies, recursively. That is, if
-GRAFTS apply only indirectly to DRV, graft the dependencies of DRV, and graft
-DRV itself to refer to those grafted dependencies."
+ "Apply GRAFTS to the OUTPUTS of DRV and all their dependencies, recursively.
+That is, if GRAFTS apply only indirectly to DRV, graft the dependencies of
+DRV, and graft DRV itself to refer to those grafted dependencies."
;; First, pre-compute the dependency tree of the outputs of DRV. Do this
;; upfront to have as much parallelism as possible when querying substitute
@@ -313,6 +311,7 @@ DRV itself to refer to those grafted dependencies."
(match (run-with-state
(cumulative-grafts store drv grafts references
+ #:outputs outputs
#:guile guile #:system system)
vlist-null) ;the initial cache
((first . rest)