ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

store: 'build-things' accepts derivation/output pairs.

Browse source 
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:
Ludovic Courtès 2019-06-10 22:10:21 +02:00
parent 416a7c69f1
commit f8a9f99cd6
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 72 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
doc/guix.texi
View file

@ -6466,10 +6466,11 @@ path. @var{references} is the list of store paths referred to by the
resulting store path.
@end deffn
@deffn {Scheme Procedure} build-derivations @var{server} @var{derivations}
Build @var{derivations} (a list of @code{<derivation>} objects or
derivation paths), and return when the worker is done building them.
Return @code{#t} on success.
@deffn {Scheme Procedure} build-derivations @var{store} @var{derivations} @
[@var{mode}]
Build @var{derivations}, a list of @code{<derivation>} objects, @file{.drv}
file names, or derivation/output pairs, using the specified
@var{mode}---@code{(build-mode normal)} by default.
@end deffn
Note that the @code{(guix monads)} module provides a monad as well as

13
guix/derivations.scm
View file

@ -982,12 +982,17 @@ (define rewritten-input
(define* (build-derivations store derivations
#:optional (mode (build-mode normal)))
"Build DERIVATIONS, a list of <derivation> objects or .drv file names, using
the specified MODE."
"Build DERIVATIONS, a list of <derivation> objects, .drv file names, or
derivation/output pairs, using the specified MODE."
(build-things store (map (match-lambda
((? derivation? drv)
(derivation-file-name drv))
((? string? file) file)
((and drv ($ <derivation>))
(derivation-file-name drv)))
(((? derivation? drv) . output)
(cons (derivation-file-name drv)
output))
(((? string? file) . output)
(cons file output)))
derivations)
mode))

26
guix/store.scm
View file

@ -1211,16 +1211,22 @@ (define build-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."
(parameterize ((current-store-protocol-version
(store-connection-version store)))
(if (>= (store-connection-minor-version store) 15)
(build store things mode)
(if (= mode (build-mode normal))
(build/old store things)
(raise (condition (&store-protocol-error
(message "unsupported build mode")
(status 1))))))))))
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
(store-connection-version store)))
(if (>= (store-connection-minor-version store) 15)
(build store things mode)
(if (= mode (build-mode normal))
(build/old store things)
(raise (condition (&store-protocol-error
(message "unsupported build mode")
(status 1)))))))))))
(define-operation (add-temp-root (store-path path))
"Make PATH a temporary root for the duration of the current session.

22
tests/derivations.scm
View file

@ -787,6 +787,28 @@ (define %coreutils
(build-derivations store (list drv))
#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"
(let ((drv (build-expression->derivation %store "fail" #f)))
;; The only direct dependency is (%guile-for-build) and it's already

20
tests/store.scm
View file

@ -599,6 +599,26 @@ (define (same? x y)
(valid-path? s o)
(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"
;; Tweak the substituter into installing a substitute whose hash doesn't
;; match the one announced in the narinfo. The daemon must notice this and