Browse Source

derivations: Determine what's built in 'check' mode.

* guix/derivations.scm (substitution-oracle): Add #:mode parameter and
honor it.
(derivation-prerequisites-to-build): Likewise.
[derivation-built?]: Take it into account.
* guix/ui.scm (show-what-to-build): Add #:mode parameter.  Pass it to
'substitute-oracle' and 'derivations-prerequisites-to-build'.
* tests/derivations.scm ("derivation-prerequisites-to-build in 'check'
mode"): New test.
wip-mediagoblin
Ludovic Courtès 6 years ago
parent
commit
58c08df054
  1. 23
      guix/derivations.scm
  2. 12
      guix/ui.scm
  3. 20
      tests/derivations.scm

23
guix/derivations.scm

@ -239,7 +239,8 @@ result is the set of prerequisites of DRV not already in valid."
(derivation-output-path (assoc-ref outputs sub-drv)))
sub-drvs))))
(define* (substitution-oracle store drv)
(define* (substitution-oracle store drv
#:key (mode (build-mode normal)))
"Return a one-argument procedure that, when passed a store file name,
returns #t if it's substitutable and #f otherwise. The returned procedure
knows about all substitutes for all the derivations listed in DRV, *except*
@ -271,9 +272,12 @@ substituter many times."
(let ((self (match (derivation->output-paths drv)
(((names . paths) ...)
paths))))
(if (every valid? self)
result
(cons* self (dependencies drv) result))))
(cond ((eqv? mode (build-mode check))
(cons (dependencies drv) result))
((every valid? self)
result)
(else
(cons* self (dependencies drv) result)))))
'()
drv))))
(subst (list->set (substitutable-paths store paths))))
@ -281,11 +285,13 @@ substituter many times."
(define* (derivation-prerequisites-to-build store drv
#:key
(mode (build-mode normal))
(outputs
(derivation-output-names drv))
(substitutable?
(substitution-oracle store
(list drv))))
(list drv)
#:mode mode)))
"Return two values: the list of derivation-inputs required to build the
OUTPUTS of DRV and not already available in STORE, recursively, and the list
of required store paths that can be substituted. SUBSTITUTABLE? must be a
@ -301,8 +307,11 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
;; least one is missing, then everything must be rebuilt.
(compose (cut every substitutable? <>) derivation-input-output-paths))
(define (derivation-built? drv sub-drvs)
(every built? (derivation-output-paths drv sub-drvs)))
(define (derivation-built? drv* sub-drvs)
;; In 'check' mode, assume that DRV is not built.
(and (not (and (eqv? mode (build-mode check))
(eq? drv* drv)))
(every built? (derivation-output-paths drv* sub-drvs))))
(define (derivation-substitutable? drv sub-drvs)
(and (substitutable-derivation? drv)

12
guix/ui.scm

@ -531,17 +531,18 @@ error."
(derivation-outputs derivation))))
(define* (show-what-to-build store drv
#:key dry-run? (use-substitutes? #t))
#:key dry-run? (use-substitutes? #t)
(mode (build-mode normal)))
"Show what will or would (depending on DRY-RUN?) be built in realizing the
derivations listed in DRV. Return #t if there's something to build, #f
otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
available for download."
derivations listed in DRV using MODE, a 'build-mode' value. Return #t if
there's something to build, #f otherwise. When USE-SUBSTITUTES?, check and
report what is prerequisites are available for download."
(define substitutable?
;; Call 'substitutation-oracle' upfront so we don't end up launching the
;; substituter many times. This makes a big difference, especially when
;; DRV is a long list as is the case with 'guix environment'.
(if use-substitutes?
(substitution-oracle store drv)
(substitution-oracle store drv #:mode mode)
(const #f)))
(define (built-or-substitutable? drv)
@ -555,6 +556,7 @@ available for download."
(let-values (((b d)
(derivation-prerequisites-to-build
store drv
#:mode mode
#:substitutable? substitutable?)))
(values (append b build)
(append d download))))

20
tests/derivations.scm

@ -670,6 +670,26 @@
(((? string? item))
(string=? item (derivation->output-path drv))))))))))
(test-assert "derivation-prerequisites-to-build in 'check' mode"
(with-store store
(let* ((dep (build-expression->derivation store "dep"
`(begin ,(random-text)
(mkdir %output))))
(drv (build-expression->derivation store "to-check"
'(mkdir %output)
#:inputs `(("dep" ,dep)))))
(build-derivations store (list drv))
(delete-paths store (list (derivation->output-path dep)))
;; In 'check' mode, DEP must be rebuilt.
(and (null? (derivation-prerequisites-to-build store drv))
(match (derivation-prerequisites-to-build store drv
#:mode (build-mode
check))
((input)
(string=? (derivation-input-path input)
(derivation-file-name dep))))))))
(test-assert "build-expression->derivation with expression returning #f"
(let* ((builder '(begin
(mkdir %output)

Loading…
Cancel
Save