me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2015-12-09 10:30:03 +01:00
parent cc9553562c
commit 58c08df054
3 changed files with 43 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/derivations.scm
View File

@ -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
View File

@ -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))))

20
tests/derivations.scm
View File

@ -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)