me
/
guix
Archived
1
0
Fork 0
Code

derivations: Don't invoke the substituter when an item is already in store. 

Fixes <http://bugs.gnu.org/20188>.
Reported by Mark H Weaver <mhw@netris.org>.

* guix/derivations.scm (substitution-oracle): Add 'valid?' procedure.
  Remove 'valid?' items from PATHS.
master
Ludovic Courtès 2015-03-24 22:47:25 +01:00
parent b655b2154c
commit c7d1d88f6c
1 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
guix/derivations.scm
View File

@ -225,22 +225,28 @@ download with a fixed hash (aka. `fetchurl')."
(define* (substitution-oracle store drv) (define* (substitution-oracle store drv)
"Return a one-argument procedure that, when passed a store file name, "Return a one-argument procedure that, when passed a store file name,
returns #t if it's substitutable and #f otherwise. The returned procedure returns #t if it's substitutable and #f otherwise. The returned procedure
knows about all substitutes for all the derivations listed in DRV and their knows about all substitutes for all the derivations listed in DRV; it also
prerequisites. knows about their prerequisites, unless they are themselves substitutable.
Creating a single oracle (thus making a single 'substitutable-paths' call) and Creating a single oracle (thus making a single 'substitutable-paths' call) and
reusing it is much more efficient than calling 'has-substitutes?' or similar reusing it is much more efficient than calling 'has-substitutes?' or similar
repeatedly, because it avoids the costs associated with launching the repeatedly, because it avoids the costs associated with launching the
substituter many times." substituter many times."
(define valid?
(cut valid-path? store <>))
(let* ((paths (delete-duplicates (let* ((paths (delete-duplicates
(fold (lambda (drv result) (fold (lambda (drv result)
(let ((self (match (derivation->output-paths drv) (let ((self (match (derivation->output-paths drv)
(((names . paths) ...) (((names . paths) ...)
paths))) paths))))
(deps (append-map derivation-input-output-paths (if (every valid? self)
(derivation-prerequisites result
drv)))) (let ((deps
(append self deps result))) (append-map derivation-input-output-paths
(derivation-prerequisites drv))))
(append (remove valid? (append self deps))
result)))))
'() '()
drv))) drv)))
(subst (list->set (substitutable-paths store paths)))) (subst (list->set (substitutable-paths store paths))))