diff options
| -rw-r--r-- | doc/guix.texi | 7 | ||||
| -rw-r--r-- | guix/derivations.scm | 28 | ||||
| -rw-r--r-- | tests/derivations.scm | 68 |
3 files changed, 91 insertions, 12 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index c82d5f7480..86912ecabf 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix/derivations.scm b/guix/derivations.scm index 3d7a30aaa8..fea9984370 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -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) diff --git a/tests/derivations.scm b/tests/derivations.scm index 9833e15112..9b3d92a7bf 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -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 %bash + (bootstrap-binary "bash")) +(define %mkdir + (bootstrap-binary "mkdir")) -(define (directory-contents dir) +(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 |