ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add multiple-output support to `build-expression->derivation'.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2012-06-09 23:16:55 +02:00
parent 7946c4e710
commit 9bc07f4df0
2 changed files with 32 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
guix/derivations.scm
View file

@ -373,18 +373,24 @@ (define %guile-for-build
(make-parameter (false-if-exception (nixpkgs-derivation "guile")))) (make-parameter (false-if-exception (nixpkgs-derivation "guile"))))
(define* (build-expression->derivation store name system exp inputs (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 "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 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 is evaluated in an environment where %OUTPUT is bound to the main output
where %BUILD-INPUTS is bound to an alist of string/output-path pairs made path, %OUTPUTS is bound to a list of output/path pairs, and where
from INPUTS." %BUILD-INPUTS is bound to an alist of string/output-path pairs made from
INPUTS."
(define guile (define guile
(string-append (derivation-path->output-path (%guile-for-build)) (string-append (derivation-path->output-path (%guile-for-build))
"/bin/guile")) "/bin/guile"))
(let* ((prologue `(begin (let* ((prologue `(begin
(define %output (getenv "out")) (define %output (getenv "out"))
(define %outputs
(map (lambda (o)
(cons o (getenv o)))
',outputs))
(define %build-inputs (define %build-inputs
',(map (match-lambda ',(map (match-lambda
((name . drv) ((name . drv)
@ -400,4 +406,5 @@ (define %build-inputs
'(("HOME" . "/homeless")) '(("HOME" . "/homeless"))
`((,(%guile-for-build)) `((,(%guile-for-build))
(,builder)) (,builder))
#:hash hash #:hash-algo hash-algo))) #:hash hash #:hash-algo hash-algo
#:outputs outputs)))

20
tests/derivations.scm
View file

@ -145,6 +145,26 @@ (define %coreutils
(equal? '(hello guix) (equal? '(hello guix)
(call-with-input-file (string-append p "/test") read)))))) (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" (test-assert "build-expression->derivation with one input"
(let* ((builder '(call-with-output-file %output (let* ((builder '(call-with-output-file %output
(lambda (p) (lambda (p)