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.
This commit is contained in:
parent
cc9553562c
commit
58c08df054
|
@ -239,7 +239,8 @@ result is the set of prerequisites of DRV not already in valid."
|
||||||
(derivation-output-path (assoc-ref outputs sub-drv)))
|
(derivation-output-path (assoc-ref outputs sub-drv)))
|
||||||
sub-drvs))))
|
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,
|
"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, *except*
|
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)
|
(let ((self (match (derivation->output-paths drv)
|
||||||
(((names . paths) ...)
|
(((names . paths) ...)
|
||||||
paths))))
|
paths))))
|
||||||
(if (every valid? self)
|
(cond ((eqv? mode (build-mode check))
|
||||||
result
|
(cons (dependencies drv) result))
|
||||||
(cons* self (dependencies drv) result))))
|
((every valid? self)
|
||||||
|
result)
|
||||||
|
(else
|
||||||
|
(cons* self (dependencies drv) result)))))
|
||||||
'()
|
'()
|
||||||
drv))))
|
drv))))
|
||||||
(subst (list->set (substitutable-paths store paths))))
|
(subst (list->set (substitutable-paths store paths))))
|
||||||
|
@ -281,11 +285,13 @@ substituter many times."
|
||||||
|
|
||||||
(define* (derivation-prerequisites-to-build store drv
|
(define* (derivation-prerequisites-to-build store drv
|
||||||
#:key
|
#:key
|
||||||
|
(mode (build-mode normal))
|
||||||
(outputs
|
(outputs
|
||||||
(derivation-output-names drv))
|
(derivation-output-names drv))
|
||||||
(substitutable?
|
(substitutable?
|
||||||
(substitution-oracle store
|
(substitution-oracle store
|
||||||
(list drv))))
|
(list drv)
|
||||||
|
#:mode mode)))
|
||||||
"Return two values: the list of derivation-inputs required to build the
|
"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
|
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
|
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.
|
;; least one is missing, then everything must be rebuilt.
|
||||||
(compose (cut every substitutable? <>) derivation-input-output-paths))
|
(compose (cut every substitutable? <>) derivation-input-output-paths))
|
||||||
|
|
||||||
(define (derivation-built? drv sub-drvs)
|
(define (derivation-built? drv* sub-drvs)
|
||||||
(every built? (derivation-output-paths 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)
|
(define (derivation-substitutable? drv sub-drvs)
|
||||||
(and (substitutable-derivation? drv)
|
(and (substitutable-derivation? drv)
|
||||||
|
|
12
guix/ui.scm
12
guix/ui.scm
|
@ -531,17 +531,18 @@ error."
|
||||||
(derivation-outputs derivation))))
|
(derivation-outputs derivation))))
|
||||||
|
|
||||||
(define* (show-what-to-build store drv
|
(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
|
"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
|
derivations listed in DRV using MODE, a 'build-mode' value. Return #t if
|
||||||
otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
|
there's something to build, #f otherwise. When USE-SUBSTITUTES?, check and
|
||||||
available for download."
|
report what is prerequisites are available for download."
|
||||||
(define substitutable?
|
(define substitutable?
|
||||||
;; Call 'substitutation-oracle' upfront so we don't end up launching the
|
;; Call 'substitutation-oracle' upfront so we don't end up launching the
|
||||||
;; substituter many times. This makes a big difference, especially when
|
;; substituter many times. This makes a big difference, especially when
|
||||||
;; DRV is a long list as is the case with 'guix environment'.
|
;; DRV is a long list as is the case with 'guix environment'.
|
||||||
(if use-substitutes?
|
(if use-substitutes?
|
||||||
(substitution-oracle store drv)
|
(substitution-oracle store drv #:mode mode)
|
||||||
(const #f)))
|
(const #f)))
|
||||||
|
|
||||||
(define (built-or-substitutable? drv)
|
(define (built-or-substitutable? drv)
|
||||||
|
@ -555,6 +556,7 @@ available for download."
|
||||||
(let-values (((b d)
|
(let-values (((b d)
|
||||||
(derivation-prerequisites-to-build
|
(derivation-prerequisites-to-build
|
||||||
store drv
|
store drv
|
||||||
|
#:mode mode
|
||||||
#:substitutable? substitutable?)))
|
#:substitutable? substitutable?)))
|
||||||
(values (append b build)
|
(values (append b build)
|
||||||
(append d download))))
|
(append d download))))
|
||||||
|
|
|
@ -670,6 +670,26 @@
|
||||||
(((? string? item))
|
(((? string? item))
|
||||||
(string=? item (derivation->output-path drv))))))))))
|
(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"
|
(test-assert "build-expression->derivation with expression returning #f"
|
||||||
(let* ((builder '(begin
|
(let* ((builder '(begin
|
||||||
(mkdir %output)
|
(mkdir %output)
|
||||||
|
|
Loading…
Reference in New Issue