diff options
| -rw-r--r-- | guix/store.scm | 17 | ||||
| -rw-r--r-- | tests/store.scm | 37 |
2 files changed, 51 insertions, 3 deletions
diff --git a/guix/store.scm b/guix/store.scm index a12abc8671..5618fa340a 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -62,6 +62,8 @@ hash-part->path add-text-to-store add-to-store + build-things + build build-derivations add-temp-root add-indirect-root @@ -140,7 +142,7 @@ (query-referrers 6) (add-to-store 7) (add-text-to-store 8) - (build-derivations 9) + (build-things 9) (ensure-path 10) (add-temp-root 11) (add-indirect-root 12) @@ -573,11 +575,16 @@ kept. HASH-ALGO must be a string such as \"sha256\"." (hash-set! cache args path) path)))))) -(define-operation (build-derivations (string-list derivations)) - "Build DERIVATIONS, and return when the worker is done building them. +(define-operation (build-things (string-list things)) + "Build THINGS, a list of store items which may be either '.drv' files or +outputs, and return when the worker is done building them. Elements of THINGS +that are not derivations can only be substituted and not built locally. Return #t on success." boolean) +;; Deprecated name for 'build-things'. +(define build-derivations build-things) + (define-operation (add-temp-root (store-path path)) "Make PATH a temporary root for the duration of the current session. Return #t." @@ -907,6 +914,10 @@ permission bits are kept." recursive? "sha256" file) store))) +(define build + ;; Monadic variant of 'build-things'. + (store-lift build-things)) + (define %guile-for-build ;; The derivation of the Guile to be used within the build environment, ;; when using 'gexp->derivation' and co. diff --git a/tests/store.scm b/tests/store.scm index 73d64e468b..db7299fc70 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -306,6 +306,24 @@ (null? (substitutable-paths s o)) (null? (substitutable-path-info s o)))))) +(test-assert "build-things with output path" + (with-store s + (let* ((c (random-text)) ;contents of the output + (d (build-expression->derivation + s "substitute-me" + `(call-with-output-file %output + (lambda (p) + (display ,c p))) + #:guile-for-build + (package-derivation s %bootstrap-guile (%current-system)))) + (o (derivation->output-path d))) + (set-build-options s #:use-substitutes? #f) + + ;; Pass 'build-things' the output file name, O. However, since there + ;; are no substitutes for O, it will just do nothing. + (build-things s (list o)) + (not (valid-path? s o))))) + (test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1)) (test-assert "substitute query" @@ -350,6 +368,25 @@ (build-derivations s (list d)) (equal? c (call-with-input-file o get-string-all))))))) +(test-assert "substitute + build-things with output path" + (with-store s + (let* ((c (random-text)) ;contents of the output + (d (build-expression->derivation + s "substitute-me" + `(call-with-output-file %output + (lambda (p) + (exit 1) ;would actually fail + (display ,c p))) + #:guile-for-build + (package-derivation s %bootstrap-guile (%current-system)))) + (o (derivation->output-path d))) + (with-derivation-substitute d c + (set-build-options s #:use-substitutes? #t) + (and (has-substitutes? s o) + (build-things s (list o)) ;give the output path + (valid-path? s o) + (equal? c (call-with-input-file o get-string-all))))))) + (test-assert "substitute, corrupt output hash" ;; Tweak the substituter into installing a substitute whose hash doesn't ;; match the one announced in the narinfo. The daemon must notice this and |