From 9c629a27a435dd37b55a3944f8d79accc710a0e4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 26 Aug 2013 22:19:21 +0200
Subject: [PATCH] derivations: Add #:dependency-graphs to
 `build-expression->derivation'.

* guix/derivations.scm (build-expression->derivation): Add
  #:dependency-graphs keyword argument.  Pass it to `derivation'.
* tests/derivations.scm ("build-expression->derivation with
  #:dependency-graphs"): New test.
* doc/guix.texi (Derivations): Update `build-expression->derivation'
  description.
---
 doc/guix.texi         |  4 +++-
 guix/derivations.scm  | 10 +++++++---
 tests/derivations.scm | 34 +++++++++++++++++++++++++++++++++-
 3 files changed, 43 insertions(+), 5 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 86912ecabf..8c7af49922 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1153,7 +1153,7 @@ As can be guessed, this primitive is cumbersome to use directly.  An
 improved variant is @code{build-expression->derivation}, which allows
 the caller to directly pass a Guile expression as the build script:
 
-@deffn {Scheme Procedure} build-expression->derivation @var{store} @var{name} @var{system} @var{exp} @var{inputs} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:env-vars '()] [#:modules '()] [#:guile-for-build #f]
+@deffn {Scheme Procedure} build-expression->derivation @var{store} @var{name} @var{system} @var{exp} @var{inputs} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:env-vars '()] [#:modules '()] [#:dependency-graphs #f] [#:guile-for-build #f]
 Return a derivation that executes Scheme expression @var{exp} as a
 builder for derivation @var{name}.  @var{inputs} must be a list of
 @code{(name drv-path sub-drv)} tuples; when @var{sub-drv} is omitted,
@@ -1174,6 +1174,8 @@ terminates by passing the result of @var{exp} to @code{exit}; thus, when
 @var{exp} is built using @var{guile-for-build} (a derivation).  When
 @var{guile-for-build} is omitted or is @code{#f}, the value of the
 @code{%guile-for-build} fluid is used instead.
+
+See the @code{derivation} procedure for the meaning of @var{dependency-graphs}.
 @end deffn
 
 @noindent
diff --git a/guix/derivations.scm b/guix/derivations.scm
index fea9984370..56a5466d9d 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -743,7 +743,8 @@ they can refer to each other."
                                        hash hash-algo
                                        (env-vars '())
                                        (modules '())
-                                       guile-for-build)
+                                       guile-for-build
+                                       dependency-graphs)
   "Return a derivation that executes Scheme expression EXP as a builder
 for derivation NAME.  INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
 tuples; when SUB-DRV is omitted, \"out\" is assumed.  MODULES is a list
@@ -760,7 +761,9 @@ builder terminates by passing the result of EXP to `exit'; thus, when
 EXP returns #f, the build is considered to have failed.
 
 EXP is built using GUILE-FOR-BUILD (a derivation).  When GUILE-FOR-BUILD is
-omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
+omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
+
+See the `derivation' procedure for the meaning of DEPENDENCY-GRAPHS."
   (define guile-drv
     (or guile-for-build (%guile-for-build)))
 
@@ -877,4 +880,5 @@ omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
                                env-vars)
 
                 #:hash hash #:hash-algo hash-algo
-                #:outputs outputs)))
+                #:outputs outputs
+                #:dependency-graphs dependency-graphs)))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 9b3d92a7bf..f9e6c28ec8 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -376,7 +376,7 @@
            (and (valid-path? %store p)
                 (file-exists? (string-append p "/good")))))))
 
-(test-skip (if (%guile-for-build) 0 7))
+(test-skip (if (%guile-for-build) 0 8))
 
 (test-assert "build-expression->derivation and derivation-prerequisites"
   (let-values (((drv-path drv)
@@ -652,6 +652,38 @@ Deriver: ~a~%"
                    (derivation-path->output-path final2))
          (build-derivations %store (list final1 final2)))))
 
+(test-assert "build-expression->derivation with #:dependency-graphs"
+  (let* ((input   (add-text-to-store %store "foo" "hello"
+                                     (list %bash %mkdir)))
+         (builder '(copy-file "input" %output))
+         (drv     (build-expression->derivation %store "dependency-graphs"
+                                                (%current-system)
+                                                builder '()
+                                                #:dependency-graphs
+                                                `(("input" . ,input))))
+         (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? (call-with-input-file out get-string-all)
+                 (string-concatenate
+                  (map cdr
+                       (sort (map (lambda (p d)
+                                    (cons p (apply deps p d)))
+                                  (list input %bash %mkdir)
+                                  (list (list %bash %mkdir)
+                                        '() '()))
+                             (lambda (x y)
+                               (match x
+                                 ((p1 . _)
+                                  (match y
+                                    ((p2 . _)
+                                     (string<? p1 p2)))))))))))))
+
 (test-end)