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:
Ludovic Courtès
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)))
|
||||
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
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))))
|
||||
|
|
|
|||
|
|
@ -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…
Reference in New Issue