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

Test the `build-derivations' operation.

Browse source 
* 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:
Ludovic Courtès 2012-06-05 00:04:07 +02:00
parent b7a7f59847
commit fb3eec8301
2 changed files with 29 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
guix/derivations.scm
View file

@ -250,7 +250,7 @@ (define (output-path output hash name) ; makeOutputPath
(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 @@ (define (env-vars-with-empty-outputs)
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)))

24
tests/derivations.scm
View file

@ -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 @@ (define %store
(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 @@ (define %store
(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)