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.
This commit is contained in:
Ludovic Courtès 2015-03-25 09:42:45 +01:00
parent 1f43445745
commit 3681db5d2c
2 changed files with 31 additions and 3 deletions

View File

@ -60,6 +60,7 @@
derivation-input-path derivation-input-path
derivation-input-sub-derivations derivation-input-sub-derivations
derivation-input-output-paths derivation-input-output-paths
valid-derivation-input?
&derivation-error &derivation-error
derivation-error? derivation-error?
@ -187,12 +188,25 @@ download with a fixed hash (aka. `fetchurl')."
(map (cut derivation-path->output-path path <>) (map (cut derivation-path->output-path path <>)
sub-drvs)))) sub-drvs))))
(define (derivation-prerequisites drv) (define (valid-derivation-input? store input)
"Return the list of derivation-inputs required to build DRV, recursively." "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) (let loop ((drv drv)
(result '()) (result '())
(input-set (set))) (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)))) (derivation-inputs drv))))
(fold2 loop (fold2 loop
(append inputs result) (append inputs result)

View File

@ -499,6 +499,20 @@
(string=? path (derivation-file-name (%guile-for-build))))) (string=? path (derivation-file-name (%guile-for-build)))))
(derivation-prerequisites drv)))) (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" (test-assert "build-expression->derivation without inputs"
(let* ((builder '(begin (let* ((builder '(begin
(mkdir %output) (mkdir %output)