derivations: Add #:dependency-graphs `derivation' parameter.
* guix/derivations.scm (derivation): Add `dependency-graphs' keyword
parameter; honor it.
* tests/derivations.scm (bootstrap-binary): New procedure.
(%bash): Use it.
(%mkdir): New variable.
(directory-contents): Add `slurp' optional parameter.
("derivation with #:dependency-graphs"): New test.
* doc/guix.texi (Derivations): Update accordingly.
This commit is contained in:
Ludovic Courtès
parent
a987d2c025
commit
5b0c9d1635
|
|
@ -1113,13 +1113,18 @@ derivations as Scheme objects, along with procedures to create and
|
|||
otherwise manipulate derivations. The lowest-level primitive to create
|
||||
a derivation is the @code{derivation} procedure:
|
||||
|
||||
@deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] [#:system (%current-system)]
|
||||
@deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] [#:system (%current-system)] [#:dependency-graphs #f]
|
||||
Build a derivation with the given arguments. Return the resulting store
|
||||
path and @code{<derivation>} object.
|
||||
|
||||
When @var{hash}, @var{hash-algo}, and @var{hash-mode} are given, a
|
||||
@dfn{fixed-output derivation} is created---i.e., one whose result is
|
||||
known in advance, such as a file download.
|
||||
|
||||
When @var{dependency-graphs} is true, it must be a list of file
|
||||
name/store path pairs. In that case, the reference graph of each store
|
||||
path is exported in the build environment in the corresponding file, in
|
||||
a simple text format.
|
||||
@end deffn
|
||||
|
||||
@noindent
|
||||
|
|
|
|||
|
|
@ -501,11 +501,16 @@ the derivation called NAME with hash HASH."
|
|||
#:key
|
||||
(system (%current-system)) (env-vars '())
|
||||
(inputs '()) (outputs '("out"))
|
||||
hash hash-algo hash-mode)
|
||||
hash hash-algo hash-mode
|
||||
dependency-graphs)
|
||||
"Build a derivation with the given arguments. Return the resulting
|
||||
store path and <derivation> object. When HASH, HASH-ALGO, and HASH-MODE
|
||||
are given, a fixed-output derivation is created---i.e., one whose result is
|
||||
known in advance, such as a file download."
|
||||
known in advance, such as a file download.
|
||||
|
||||
When DEPENDENCY-GRAPHS is true, it must be a list of file name/store path
|
||||
pairs. In that case, the reference graph of each store path is exported in
|
||||
the build environment in the corresponding file, in a simple text format."
|
||||
(define direct-store-path?
|
||||
(let ((len (+ 1 (string-length (%store-prefix)))))
|
||||
(lambda (p)
|
||||
|
|
@ -540,7 +545,22 @@ known in advance, such as a file download."
|
|||
value))))
|
||||
env-vars))))))
|
||||
|
||||
(define (env-vars-with-empty-outputs)
|
||||
(define (user+system-env-vars)
|
||||
;; Some options are passed to the build daemon via the env. vars of
|
||||
;; derivations (urgh!). We hide that from our API, but here is the place
|
||||
;; where we kludgify those options.
|
||||
(match dependency-graphs
|
||||
(((file . path) ...)
|
||||
(let ((value (map (cut string-append <> " " <>)
|
||||
file path)))
|
||||
;; XXX: This all breaks down if an element of FILE or PATH contains
|
||||
;; white space.
|
||||
`(("exportReferencesGraph" . ,(string-join value " "))
|
||||
,@env-vars)))
|
||||
(#f
|
||||
env-vars)))
|
||||
|
||||
(define (env-vars-with-empty-outputs env-vars)
|
||||
;; Return a variant of ENV-VARS where each OUTPUTS is associated with an
|
||||
;; empty string, even outputs that do not appear in ENV-VARS.
|
||||
(let ((e (map (match-lambda
|
||||
|
|
@ -572,7 +592,7 @@ known in advance, such as a file download."
|
|||
#t "sha256" input)))
|
||||
(make-derivation-input path '()))))
|
||||
(delete-duplicates inputs)))
|
||||
(env-vars (env-vars-with-empty-outputs))
|
||||
(env-vars (env-vars-with-empty-outputs (user+system-env-vars)))
|
||||
(drv-masked (make-derivation outputs
|
||||
(filter (compose derivation-path?
|
||||
derivation-input-path)
|
||||
|
|
|
|||
|
|
@ -50,19 +50,23 @@
|
|||
(let ((drv (package-derivation %store %bootstrap-guile)))
|
||||
(%guile-for-build drv)))
|
||||
|
||||
(define %bash
|
||||
(let ((bash (search-bootstrap-binary "bash" (%current-system))))
|
||||
(define (bootstrap-binary name)
|
||||
(let ((bin (search-bootstrap-binary name (%current-system))))
|
||||
(and %store
|
||||
(add-to-store %store "bash" #t "sha256" bash))))
|
||||
(add-to-store %store name #t "sha256" bin))))
|
||||
|
||||
(define (directory-contents dir)
|
||||
(define %bash
|
||||
(bootstrap-binary "bash"))
|
||||
(define %mkdir
|
||||
(bootstrap-binary "mkdir"))
|
||||
|
||||
(define* (directory-contents dir #:optional (slurp get-bytevector-all))
|
||||
"Return an alist representing the contents of DIR."
|
||||
(define prefix-len (string-length dir))
|
||||
(sort (file-system-fold (const #t) ; enter?
|
||||
(lambda (path stat result) ; leaf
|
||||
(alist-cons (string-drop path prefix-len)
|
||||
(call-with-input-file path
|
||||
get-bytevector-all)
|
||||
(call-with-input-file path slurp)
|
||||
result))
|
||||
(lambda (path stat result) result) ; down
|
||||
(lambda (path stat result) result) ; up
|
||||
|
|
@ -84,7 +88,7 @@
|
|||
(and (equal? b1 b2)
|
||||
(equal? d1 d2))))
|
||||
|
||||
(test-skip (if %store 0 11))
|
||||
(test-skip (if %store 0 12))
|
||||
|
||||
(test-assert "add-to-store, flat"
|
||||
(let* ((file (search-path %load-path "language/tree-il/spec.scm"))
|
||||
|
|
@ -292,6 +296,56 @@
|
|||
(and (valid-path? %store p)
|
||||
(equal? '(one two) (call-with-input-file p read)))))))
|
||||
|
||||
(test-assert "derivation with #:dependency-graphs"
|
||||
(let* ((input1 (add-text-to-store %store "foo" "hello"
|
||||
(list %bash)))
|
||||
(input2 (add-text-to-store %store "bar"
|
||||
(number->string (random 7777))
|
||||
(list input1)))
|
||||
(builder (add-text-to-store %store "build-graph"
|
||||
(format #f "
|
||||
~a $out
|
||||
(while read l ; do echo $l ; done) < bash > $out/bash
|
||||
(while read l ; do echo $l ; done) < input1 > $out/input1
|
||||
(while read l ; do echo $l ; done) < input2 > $out/input2"
|
||||
%mkdir)
|
||||
(list %mkdir)))
|
||||
(drv (derivation %store "closure-graphs"
|
||||
%bash `(,builder)
|
||||
#:dependency-graphs
|
||||
`(("bash" . ,%bash)
|
||||
("input1" . ,input1)
|
||||
("input2" . ,input2))
|
||||
#:inputs `((,%bash) (,builder))))
|
||||
(out (derivation-path->output-path drv)))
|
||||
(define (deps path . deps)
|
||||
(let ((count (length deps)))
|
||||
(string-append path "\n\n" (number->string count) "\n"
|
||||
(string-join (sort deps string<?) "\n")
|
||||
(if (zero? count) "" "\n"))))
|
||||
|
||||
(and (build-derivations %store (list drv))
|
||||
(equal? (directory-contents out get-string-all)
|
||||
`(("/bash" . ,(string-append %bash "\n\n0\n"))
|
||||
("/input1" . ,(if (string>? input1 %bash)
|
||||
(string-append (deps %bash)
|
||||
(deps input1 %bash))
|
||||
(string-append (deps input1 %bash)
|
||||
(deps %bash))))
|
||||
("/input2" . ,(string-concatenate
|
||||
(map cdr
|
||||
(sort
|
||||
(map (lambda (p d)
|
||||
(cons p (apply deps p d)))
|
||||
(list %bash input1 input2)
|
||||
(list '() (list %bash) (list input1)))
|
||||
(lambda (x y)
|
||||
(match x
|
||||
((p1 . _)
|
||||
(match y
|
||||
((p2 . _)
|
||||
(string<? p1 p2)))))))))))))))
|
||||
|
||||
|
||||
(define %coreutils
|
||||
(false-if-exception
|
||||
|
|
|
|||
Loading…
Reference in New Issue