From 9bc07f4df0b69b4eae86e8ca574713e3048d9a31 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 9 Jun 2012 23:16:55 +0200
Subject: Add multiple-output support to `build-expression->derivation'.

* guix/derivations.scm (build-expression->derivation): Add `outputs'
  keyword parameter; pass it to `derivation'.  Define `%outputs' in the
  prologue.

* tests/derivations.scm ("build-expression->derivation with two
  outputs"): New test.
---
 guix/derivations.scm  | 17 ++++++++++++-----
 tests/derivations.scm | 20 ++++++++++++++++++++
 2 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 38e05b25f2..b5e3db2d21 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -373,18 +373,24 @@ known in advance, such as a file download."
   (make-parameter (false-if-exception (nixpkgs-derivation "guile"))))
 
 (define* (build-expression->derivation store name system exp inputs
-                                       #:key hash hash-algo)
+                                       #:key (outputs '("out"))
+                                       hash hash-algo)
   "Return a derivation that executes Scheme expression EXP as a builder for
 derivation NAME.  INPUTS must be a list of string/derivation-path pairs.  EXP
-is evaluated in an environment where %OUTPUT is bound to the output path, and
-where %BUILD-INPUTS is bound to an alist of string/output-path pairs made
-from INPUTS."
+is evaluated in an environment where %OUTPUT is bound to the main output
+path, %OUTPUTS is bound to a list of output/path pairs, and where
+%BUILD-INPUTS is bound to an alist of string/output-path pairs made from
+INPUTS."
   (define guile
     (string-append (derivation-path->output-path (%guile-for-build))
                    "/bin/guile"))
 
   (let* ((prologue `(begin
                       (define %output (getenv "out"))
+                      (define %outputs
+                        (map (lambda (o)
+                               (cons o (getenv o)))
+                             ',outputs))
                       (define %build-inputs
                         ',(map (match-lambda
                                 ((name . drv)
@@ -400,4 +406,5 @@ from INPUTS."
                 '(("HOME" . "/homeless"))
                 `((,(%guile-for-build))
                   (,builder))
-                #:hash hash #:hash-algo hash-algo)))
+                #:hash hash #:hash-algo hash-algo
+                #:outputs outputs)))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 5d4fea8403..cbeedde4a1 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -145,6 +145,26 @@
            (equal? '(hello guix)
                    (call-with-input-file (string-append p "/test") read))))))
 
+(test-assert "build-expression->derivation with two outputs"
+  (let* ((builder    '(begin
+                        (call-with-output-file (assoc-ref %outputs "out")
+                          (lambda (p)
+                            (display '(hello) p)))
+                        (call-with-output-file (assoc-ref %outputs "second")
+                          (lambda (p)
+                            (display '(world) p)))))
+         (drv-path   (build-expression->derivation %store "double"
+                                                   "x86_64-linux"
+                                                   builder '()
+                                                   #:outputs '("out"
+                                                               "second")))
+         (succeeded? (build-derivations %store (list drv-path))))
+    (and succeeded?
+         (let ((one (derivation-path->output-path drv-path))
+               (two (derivation-path->output-path drv-path "second")))
+           (and (equal? '(hello) (call-with-input-file one read))
+                (equal? '(world) (call-with-input-file two read)))))))
+
 (test-assert "build-expression->derivation with one input"
   (let* ((builder    '(call-with-output-file %output
                         (lambda (p)
-- 
cgit v1.2.3