aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/derivations.scm23
-rw-r--r--guix/ui.scm12
-rw-r--r--tests/derivations.scm20
3 files changed, 43 insertions, 12 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 342a6c83f3..8a0fecaaee 100644
--- a/guix/derivations.scm
+++ b/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)
diff --git a/guix/ui.scm b/guix/ui.scm
index 581fb941f5..35a6671a07 100644
--- a/guix/ui.scm
+++ b/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))))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 9fc96c71ae..1bbc93fe5c 100644
--- a/tests/derivations.scm
+++ b/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)