derivations: 'derivation-build-plan' recurses on substituables.

This fixes a bug whereby "guix build texlive -n" would report:

  0.0 MB would be downloaded:
     /gnu/store/…-texlive-20180414

instead of:

  The following derivation would be built:
     /gnu/store/…-texlive-texmf-20180414.drv
  2,595.2 MB would be downloaded:
     /gnu/store/…-texlive-20180414-texmf.tar.xz
     /gnu/store/…-texlive-20180414

where 'texlive-texmf' is a non-substitutable dependency of 'texlive'.

* guix/derivations.scm (dependencies-of-substitutables): New procedure.
(derivation-build-plan): When 'input-substitutable-info' returns true,
append the subset of DEPS that corresponds to SUBSTITUABLES to the first
argument of 'loop'.
* guix/ui.scm (show-what-to-build): Remove half-baked traversal of
DOWNLOAD.
* tests/derivations.scm ("derivation-build-plan and substitutes,
non-substitutable dep"): New test.
This commit is contained in:
Ludovic Courtès 2019-07-04 23:09:11 +02:00
parent 87850c05a2
commit b1510fd8d2
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 50 additions and 20 deletions

View File

@ -352,6 +352,16 @@ substituter many times."
(#f #f)
((key . value) value)))))
(define (dependencies-of-substitutables substitutables inputs)
"Return the subset of INPUTS whose output file names is among the references
of SUBSTITUTABLES."
(let ((items (fold set-insert (set)
(append-map substitutable-references substitutables))))
(filter (lambda (input)
(any (cut set-contains? items <>)
(derivation-input-output-paths input)))
inputs)))
(define* (derivation-build-plan store inputs
#:key
(mode (build-mode normal))
@ -391,7 +401,9 @@ by 'substitution-oracle'."
(()
(values build substitute))
((input rest ...)
(let ((key (derivation-input-key input)))
(let ((key (derivation-input-key input))
(deps (derivation-inputs
(derivation-input-derivation input))))
(cond ((set-contains? visited key)
(loop rest build substitute visited))
((input-built? input)
@ -400,16 +412,17 @@ by 'substitution-oracle'."
((input-substitutable-info input)
=>
(lambda (substitutables)
(loop rest build
(loop (append (dependencies-of-substitutables substitutables
deps)
rest)
build
(append substitutables substitute)
(set-insert key visited))))
(else
(let ((deps (derivation-inputs
(derivation-input-derivation input))))
(loop (append deps rest)
(cons (derivation-input-derivation input) build)
substitute
(set-insert key visited))))))))))
(loop (append deps rest)
(cons (derivation-input-derivation input) build)
substitute
(set-insert key visited)))))))))
(define-deprecated (derivation-prerequisites-to-build store drv #:rest rest)
derivation-build-plan

View File

@ -844,18 +844,6 @@ check and report what is prerequisites are available for download."
#:mode mode
#:substitutable-info
substitutable-info))
((download) ; add the references of DOWNLOAD
(if use-substitutes?
(delete-duplicates
(append download
(filter-map (lambda (item)
(if (valid-path? store item)
#f
(substitutable-info item)))
(append-map
substitutable-references
download))))
download))
((graft hook build)
(match (fold (lambda (drv acc)
(let ((file (derivation-file-name drv)))

View File

@ -896,6 +896,35 @@
(((= derivation-file-name build))
(string=? build (derivation-file-name drv)))))))))
(test-assert "derivation-build-plan and substitutes, non-substitutable dep"
(with-store store
(let* ((drv1 (build-expression->derivation store "prereq-no-subst"
(random 1000)
#:substitutable? #f))
(drv2 (build-expression->derivation store "substitutable"
(random 1000)
#:inputs `(("dep" ,drv1)))))
;; Make sure substitutes are usable.
(set-build-options store #:use-substitutes? #t
#:substitute-urls (%test-substitute-urls))
(with-derivation-narinfo drv2
(sha256 => (make-bytevector 32 0))
(references => (list (derivation->output-path drv1)))
(let-values (((build download)
(derivation-build-plan store
(list (derivation-input drv2)))))
;; Although DRV2 is available as a substitute, we must build its
;; dependency, DRV1, due to #:substitutable? #f.
(and (match download
(((= substitutable-path item))
(string=? item (derivation->output-path drv2))))
(match build
(((= derivation-file-name build))
(string=? build (derivation-file-name drv1))))))))))
(test-assert "derivation-build-plan and substitutes, local build"
(with-store store
(let* ((drv (build-expression->derivation store "prereq-subst-local"