diff options
| -rw-r--r-- | guix/derivations.scm | 20 | ||||
| -rw-r--r-- | tests/derivations.scm | 14 |
2 files changed, 31 insertions, 3 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index 9b5ee367b6..8daad4b81d 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -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) diff --git a/tests/derivations.scm b/tests/derivations.scm index 72d253c465..a8cccac34a 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -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) |