Test the `build-derivations' operation.
* guix/derivations.scm (derivation): Return DRV as a second value. * tests/derivations.scm ("build derivation with 1 source"): New test.
This commit is contained in:
parent
b7a7f59847
commit
fb3eec8301
|
@ -250,7 +250,7 @@ the derivation called NAME with hash HASH."
|
||||||
(define* (derivation store name system builder args env-vars inputs
|
(define* (derivation store name system builder args env-vars inputs
|
||||||
#:key (outputs '("out")) hash hash-algo hash-mode)
|
#:key (outputs '("out")) hash hash-algo hash-mode)
|
||||||
"Build a derivation with the given arguments. Return the resulting
|
"Build a derivation with the given arguments. Return the resulting
|
||||||
<derivation> object and its store path. When HASH, HASH-ALGO, and HASH-MODE
|
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
|
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."
|
||||||
(define (add-output-paths drv)
|
(define (add-output-paths drv)
|
||||||
|
@ -321,8 +321,9 @@ known in advance, such as a file download."
|
||||||
inputs)
|
inputs)
|
||||||
system builder args env-vars))
|
system builder args env-vars))
|
||||||
(drv (add-output-paths drv-masked)))
|
(drv (add-output-paths drv-masked)))
|
||||||
(add-text-to-store store (string-append name ".drv")
|
(values (add-text-to-store store (string-append name ".drv")
|
||||||
(call-with-output-string
|
(call-with-output-string
|
||||||
(cut write-derivation drv <>))
|
(cut write-derivation drv <>))
|
||||||
(map derivation-input-path
|
(map derivation-input-path
|
||||||
inputs))))
|
inputs))
|
||||||
|
drv)))
|
||||||
|
|
|
@ -20,9 +20,11 @@
|
||||||
(define-module (test-derivations)
|
(define-module (test-derivations)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (rnrs io ports))
|
#:use-module (rnrs io ports)
|
||||||
|
#:use-module (ice-9 rdelim))
|
||||||
|
|
||||||
(define %store
|
(define %store
|
||||||
(false-if-exception (open-connection)))
|
(false-if-exception (open-connection)))
|
||||||
|
@ -37,7 +39,7 @@
|
||||||
(and (equal? b1 b2)
|
(and (equal? b1 b2)
|
||||||
(equal? d1 d2))))
|
(equal? d1 d2))))
|
||||||
|
|
||||||
(test-skip (if %store 0 1))
|
(test-skip (if %store 0 2))
|
||||||
|
|
||||||
(test-assert "derivation with no inputs"
|
(test-assert "derivation with no inputs"
|
||||||
(let ((builder (add-text-to-store %store "my-builder.sh"
|
(let ((builder (add-text-to-store %store "my-builder.sh"
|
||||||
|
@ -46,6 +48,24 @@
|
||||||
(store-path? (derivation %store "foo" "x86_64-linux" builder
|
(store-path? (derivation %store "foo" "x86_64-linux" builder
|
||||||
'() '(("HOME" . "/homeless")) '()))))
|
'() '(("HOME" . "/homeless")) '()))))
|
||||||
|
|
||||||
|
(test-assert "build derivation with 1 source"
|
||||||
|
(let*-values (((builder)
|
||||||
|
(add-text-to-store %store "my-builder.sh"
|
||||||
|
"#!/bin/sh\necho hello, world > \"$out\"\n"
|
||||||
|
'()))
|
||||||
|
((drv-path drv)
|
||||||
|
(derivation %store "foo" "x86_64-linux"
|
||||||
|
"/bin/sh" `(,builder)
|
||||||
|
'(("HOME" . "/homeless"))
|
||||||
|
`((,builder))))
|
||||||
|
((succeeded?)
|
||||||
|
(build-derivations %store (list drv-path))))
|
||||||
|
(and succeeded?
|
||||||
|
(let ((path (derivation-output-path
|
||||||
|
(assoc-ref (derivation-outputs drv) "out"))))
|
||||||
|
(string=? (call-with-input-file path read-line)
|
||||||
|
"hello, world")))))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue