~ruther/guix-local

3681db5d2c3c40f8796703325242998bbdb48403 — Ludovic Courtès 11 years ago 1f43445
derivations: Add a 'cut?' parameter to 'derivation-prerequisites'.

* guix/derivations.scm (valid-derivation-input?): New procedure.
  (derivation-prerequisites): Add 'cut?' parameter and honor it.
* tests/derivations.scm ("derivation-prerequisites and
  derivation-input-is-valid?"): New test.
2 files changed, 31 insertions(+), 3 deletions(-)

M guix/derivations.scm
M tests/derivations.scm
M guix/derivations.scm => guix/derivations.scm +17 -3
@@ 60,6 60,7 @@
            derivation-input-path
            derivation-input-sub-derivations
            derivation-input-output-paths
            valid-derivation-input?

            &derivation-error
            derivation-error?


@@ 187,12 188,25 @@ download with a fixed hash (aka. `fetchurl')."
     (map (cut derivation-path->output-path path <>)
          sub-drvs))))

(define (derivation-prerequisites drv)
  "Return the list of derivation-inputs required to build DRV, recursively."
(define (valid-derivation-input? store input)
  "Return true if INPUT is valid--i.e., if all the outputs it requests are in
the store."
  (every (cut valid-path? store <>)
         (derivation-input-output-paths input)))

(define* (derivation-prerequisites drv #:optional (cut? (const #f)))
  "Return the list of derivation-inputs required to build DRV, recursively.

CUT? is a predicate that is passed a derivation-input and returns true to
eliminate the given input and its dependencies from the search.  An example of
search a predicate is 'valid-derivation-input?'; when it is used as CUT?, the
result is the set of prerequisites of DRV not already in valid."
  (let loop ((drv       drv)
             (result    '())
             (input-set (set)))
    (let ((inputs (remove (cut set-contains? input-set <>)
    (let ((inputs (remove (lambda (input)
                            (or (set-contains? input-set input)
                                (cut? input)))
                          (derivation-inputs drv))))
      (fold2 loop
             (append inputs result)

M tests/derivations.scm => tests/derivations.scm +14 -0
@@ 499,6 499,20 @@
           (string=? path (derivation-file-name (%guile-for-build)))))
         (derivation-prerequisites drv))))

(test-assert "derivation-prerequisites and derivation-input-is-valid?"
  (let* ((a (build-expression->derivation %store "a" '(mkdir %output)))
         (b (build-expression->derivation %store "b" `(list ,(random-text))))
         (c (build-expression->derivation %store "c" `(mkdir %output)
                                          #:inputs `(("a" ,a) ("b" ,b)))))
    (build-derivations %store (list a))
    (match (derivation-prerequisites c
                                     (cut valid-derivation-input? %store
                                          <>))
      ((($ <derivation-input> file ("out")))
       (string=? file (derivation-file-name b)))
      (x
       (pk 'fail x #f)))))

(test-assert "build-expression->derivation without inputs"
  (let* ((builder    '(begin
                        (mkdir %output)