~ruther/guix-local

58c08df0544bc39b3b5a8f6638f776159b6b8d8e — Ludovic Courtès 10 years ago cc95535
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.
3 files changed, 43 insertions(+), 12 deletions(-)

M guix/derivations.scm
M guix/ui.scm
M tests/derivations.scm
M guix/derivations.scm => guix/derivations.scm +16 -7
@@ 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)

M guix/ui.scm => guix/ui.scm +7 -5
@@ 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))))

M tests/derivations.scm => tests/derivations.scm +20 -0
@@ 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)