~ruther/guix-local

9bc07f4df0b69b4eae86e8ca574713e3048d9a31 — Ludovic Courtès 13 years ago 7946c4e
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.
2 files changed, 32 insertions(+), 5 deletions(-)

M guix/derivations.scm
M tests/derivations.scm
M guix/derivations.scm => guix/derivations.scm +12 -5
@@ 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)))

M tests/derivations.scm => tests/derivations.scm +20 -0
@@ 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)