mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
store: 'build-things' accepts derivation/output pairs.
This allows callers to request the substitution of a single derivation output. * guix/store.scm (build-things): Accept derivation/output pairs among THINGS. * guix/derivations.scm (build-derivations): Likewise. * tests/store.scm ("substitute + build-things with specific output"): New test. * tests/derivations.scm ("build-derivations with specific output"): New test. * doc/guix.texi (The Store): Adjust accordingly.
This commit is contained in:
parent
416a7c69f1
commit
f8a9f99cd6
5 changed files with 72 additions and 18 deletions
|
@ -6466,10 +6466,11 @@ path. @var{references} is the list of store paths referred to by the
|
||||||
resulting store path.
|
resulting store path.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} build-derivations @var{server} @var{derivations}
|
@deffn {Scheme Procedure} build-derivations @var{store} @var{derivations} @
|
||||||
Build @var{derivations} (a list of @code{<derivation>} objects or
|
[@var{mode}]
|
||||||
derivation paths), and return when the worker is done building them.
|
Build @var{derivations}, a list of @code{<derivation>} objects, @file{.drv}
|
||||||
Return @code{#t} on success.
|
file names, or derivation/output pairs, using the specified
|
||||||
|
@var{mode}---@code{(build-mode normal)} by default.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
Note that the @code{(guix monads)} module provides a monad as well as
|
Note that the @code{(guix monads)} module provides a monad as well as
|
||||||
|
|
|
@ -982,12 +982,17 @@ (define rewritten-input
|
||||||
|
|
||||||
(define* (build-derivations store derivations
|
(define* (build-derivations store derivations
|
||||||
#:optional (mode (build-mode normal)))
|
#:optional (mode (build-mode normal)))
|
||||||
"Build DERIVATIONS, a list of <derivation> objects or .drv file names, using
|
"Build DERIVATIONS, a list of <derivation> objects, .drv file names, or
|
||||||
the specified MODE."
|
derivation/output pairs, using the specified MODE."
|
||||||
(build-things store (map (match-lambda
|
(build-things store (map (match-lambda
|
||||||
|
((? derivation? drv)
|
||||||
|
(derivation-file-name drv))
|
||||||
((? string? file) file)
|
((? string? file) file)
|
||||||
((and drv ($ <derivation>))
|
(((? derivation? drv) . output)
|
||||||
(derivation-file-name drv)))
|
(cons (derivation-file-name drv)
|
||||||
|
output))
|
||||||
|
(((? string? file) . output)
|
||||||
|
(cons file output)))
|
||||||
derivations)
|
derivations)
|
||||||
mode))
|
mode))
|
||||||
|
|
||||||
|
|
|
@ -1211,7 +1211,13 @@ (define build-things
|
||||||
"Build THINGS, a list of store items which may be either '.drv' files or
|
"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
|
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.
|
that are not derivations can only be substituted and not built locally.
|
||||||
Return #t on success."
|
Alternately, an element of THING can be a derivation/output name pair, in
|
||||||
|
which case the daemon will attempt to substitute just the requested output of
|
||||||
|
the derivation. Return #t on success."
|
||||||
|
(let ((things (map (match-lambda
|
||||||
|
((drv . output) (string-append drv "!" output))
|
||||||
|
(thing thing))
|
||||||
|
things)))
|
||||||
(parameterize ((current-store-protocol-version
|
(parameterize ((current-store-protocol-version
|
||||||
(store-connection-version store)))
|
(store-connection-version store)))
|
||||||
(if (>= (store-connection-minor-version store) 15)
|
(if (>= (store-connection-minor-version store) 15)
|
||||||
|
@ -1220,7 +1226,7 @@ (define build-things
|
||||||
(build/old store things)
|
(build/old store things)
|
||||||
(raise (condition (&store-protocol-error
|
(raise (condition (&store-protocol-error
|
||||||
(message "unsupported build mode")
|
(message "unsupported build mode")
|
||||||
(status 1))))))))))
|
(status 1)))))))))))
|
||||||
|
|
||||||
(define-operation (add-temp-root (store-path path))
|
(define-operation (add-temp-root (store-path path))
|
||||||
"Make PATH a temporary root for the duration of the current session.
|
"Make PATH a temporary root for the duration of the current session.
|
||||||
|
|
|
@ -787,6 +787,28 @@ (define %coreutils
|
||||||
(build-derivations store (list drv))
|
(build-derivations store (list drv))
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
|
(test-assert "build-derivations with specific output"
|
||||||
|
(with-store store
|
||||||
|
(let* ((content (random-text)) ;contents of the output
|
||||||
|
(drv (build-expression->derivation
|
||||||
|
store "substitute-me"
|
||||||
|
`(begin ,content (exit 1)) ;would fail
|
||||||
|
#:outputs '("out" "one" "two")
|
||||||
|
#:guile-for-build
|
||||||
|
(package-derivation store %bootstrap-guile)))
|
||||||
|
(out (derivation->output-path drv)))
|
||||||
|
(with-derivation-substitute drv content
|
||||||
|
(set-build-options store #:use-substitutes? #t
|
||||||
|
#:substitute-urls (%test-substitute-urls))
|
||||||
|
(and (has-substitutes? store out)
|
||||||
|
|
||||||
|
;; Ask for nothing but the "out" output of DRV.
|
||||||
|
(build-derivations store `((,drv . "out")))
|
||||||
|
|
||||||
|
(valid-path? store out)
|
||||||
|
(equal? (pk 'x content) (pk 'y (call-with-input-file out get-string-all)))
|
||||||
|
)))))
|
||||||
|
|
||||||
(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
|
(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
|
||||||
(let ((drv (build-expression->derivation %store "fail" #f)))
|
(let ((drv (build-expression->derivation %store "fail" #f)))
|
||||||
;; The only direct dependency is (%guile-for-build) and it's already
|
;; The only direct dependency is (%guile-for-build) and it's already
|
||||||
|
|
|
@ -599,6 +599,26 @@ (define (same? x y)
|
||||||
(valid-path? s o)
|
(valid-path? s o)
|
||||||
(equal? c (call-with-input-file o get-string-all)))))))
|
(equal? c (call-with-input-file o get-string-all)))))))
|
||||||
|
|
||||||
|
(test-assert "substitute + build-things with specific output"
|
||||||
|
(with-store s
|
||||||
|
(let* ((c (random-text)) ;contents of the output
|
||||||
|
(d (build-expression->derivation
|
||||||
|
s "substitute-me" `(begin ,c (exit 1)) ;would fail
|
||||||
|
#:outputs '("out" "one" "two")
|
||||||
|
#: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
|
||||||
|
#:substitute-urls (%test-substitute-urls))
|
||||||
|
(and (has-substitutes? s o)
|
||||||
|
|
||||||
|
;; Ask for nothing but the "out" output of D.
|
||||||
|
(build-things s `((,(derivation-file-name d) . "out")))
|
||||||
|
|
||||||
|
(valid-path? s o)
|
||||||
|
(equal? c (call-with-input-file o get-string-all)))))))
|
||||||
|
|
||||||
(test-assert "substitute, corrupt output hash"
|
(test-assert "substitute, corrupt output hash"
|
||||||
;; Tweak the substituter into installing a substitute whose hash doesn't
|
;; Tweak the substituter into installing a substitute whose hash doesn't
|
||||||
;; match the one announced in the narinfo. The daemon must notice this and
|
;; match the one announced in the narinfo. The daemon must notice this and
|
||||||
|
|
Loading…
Reference in a new issue