diff options
| -rw-r--r-- | guix/derivations.scm | 43 | ||||
| -rw-r--r-- | tests/derivations.scm | 19 |
2 files changed, 60 insertions, 2 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index 6011a3d97e..a2bff44a5f 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -26,19 +26,24 @@ #:use-module (ice-9 rdelim) #:use-module (guix store) #:use-module (guix utils) - #:export (derivation? + #:export (<derivation> + derivation? derivation-outputs derivation-inputs derivation-sources derivation-system derivation-builder-arguments derivation-builder-environment-vars + derivation-prerequisites + derivation-prerequisites-to-build + <derivation-output> derivation-output? derivation-output-path derivation-output-hash-algo derivation-output-hash + <derivation-input> derivation-input? derivation-input-path derivation-input-sub-derivations @@ -92,6 +97,42 @@ download with a fixed hash (aka. `fetchurl')." #t) (_ #f))) +(define (derivation-prerequisites drv) + "Return the list of derivation-inputs required to build DRV, recursively." + (let loop ((drv drv) + (result '())) + (let ((inputs (remove (cut member <> result) ; XXX: quadratic + (derivation-inputs drv)))) + (fold loop + (append inputs result) + (map (lambda (i) + (call-with-input-file (derivation-input-path i) + read-derivation)) + inputs))))) + +(define (derivation-prerequisites-to-build store drv) + "Return the list of derivation-inputs required to build DRV and not already +available in STORE, recursively." + (define input-built? + (match-lambda + (($ <derivation-input> path sub-drvs) + (let ((out (map (cut derivation-path->output-path path <>) + sub-drvs))) + (any (cut valid-path? store <>) out))))) + + (let loop ((drv drv) + (result '())) + (let ((inputs (remove (lambda (i) + (or (member i result) ; XXX: quadratic + (input-built? i))) + (derivation-inputs drv)))) + (fold loop + (append inputs result) + (map (lambda (i) + (call-with-input-file (derivation-input-path i) + read-derivation)) + inputs))))) + (define (read-derivation drv-port) "Read the derivation from DRV-PORT and return the corresponding <derivation> object." diff --git a/tests/derivations.scm b/tests/derivations.scm index 3fc7097a87..b6bd4dab0d 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -172,7 +172,16 @@ (and (valid-path? %store p) (file-exists? (string-append p "/good"))))))) -(test-skip (if (%guile-for-build) 0 4)) +(test-skip (if (%guile-for-build) 0 6)) + +(test-assert "build-expression->derivation and derivation-prerequisites" + (let-values (((drv-path drv) + (build-expression->derivation %store "fail" (%current-system) + #f '()))) + (any (match-lambda + (($ <derivation-input> path) + (string=? path (%guile-for-build)))) + (derivation-prerequisites drv)))) (test-assert "build-expression->derivation without inputs" (let* ((builder '(begin @@ -188,6 +197,14 @@ (equal? '(hello guix) (call-with-input-file (string-append p "/test") read)))))) +(test-assert "build-expression->derivation and derivation-prerequisites-to-build" + (let-values (((drv-path drv) + (build-expression->derivation %store "fail" (%current-system) + #f '()))) + ;; The only direct dependency is (%guile-for-build) and it's already + ;; built. + (null? (derivation-prerequisites-to-build %store drv)))) + (test-assert "build-expression->derivation with expression returning #f" (let* ((builder '(begin (mkdir %output) |