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

Change `build-expression->derivation' to support sub-derivation inputs.

Browse source 
* guix/derivations.scm (build-expression->derivation): Change to expect
  INPUTS to have the form (NAME DRV-PATH SUB-DRV) or (NAME DRV-PATH),
  instead of (NAME . DRV-PATH).  Update callers accordingly.

* guix/gnu-build-system.scm, tests/builders.scm, tests/derivations.scm:
  Update accordingly.
This commit is contained in:
Ludovic Courtès 2012-06-13 17:21:27 +02:00
parent c36db98c8e
commit 2acb2cb6d0
4 changed files with 25 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
guix/derivations.scm
View file

@ -397,7 +397,7 @@ (define (parent-dirs file-name)
(let* ((files (map (match-lambda (let* ((files (map (match-lambda
((final-path . file-name) ((final-path . file-name)
(cons final-path (list final-path
(add-to-store store (basename final-path) #t #f (add-to-store store (basename final-path) #t #f
"sha256" file-name)))) "sha256" file-name))))
files)) files))
@ -405,7 +405,7 @@ (define (parent-dirs file-name)
`(begin `(begin
(mkdir %output) (chdir %output) (mkdir %output) (chdir %output)
,@(append-map (match-lambda ,@(append-map (match-lambda
((final-path . store-path) ((final-path store-path)
(append (match (parent-dirs final-path) (append (match (parent-dirs final-path)
(() '()) (() '())
((head ... tail) ((head ... tail)
@ -442,11 +442,11 @@ (define* (build-expression->derivation store name system exp inputs
hash hash-algo hash hash-algo
(modules '())) (modules '()))
"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 (NAME DRV-PATH SUB-DRV) tuples;
is evaluated in an environment where %OUTPUT is bound to the main output when SUB-DRV is omitted, \"out\" is assumed. EXP is evaluated in an
path, %OUTPUTS is bound to a list of output/path pairs, and where environment where %OUTPUT is bound to the main output path, %OUTPUTS is bound
%BUILD-INPUTS is bound to an alist of string/output-path pairs made from to a list of output/path pairs, and where %BUILD-INPUTS is bound to an alist
INPUTS." 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"))
@ -459,17 +459,21 @@ (define %outputs
',outputs)) ',outputs))
(define %build-inputs (define %build-inputs
',(map (match-lambda ',(map (match-lambda
((name . drv) ((name drv . rest)
(cons name (let ((sub (match rest
(if (derivation-path? drv) (() "out")
(derivation-path->output-path drv) ((x) x))))
drv)))) (cons name
inputs))) ) (if (derivation-path? drv)
(derivation-path->output-path drv
sub)
drv)))))
inputs))))
(builder (add-text-to-store store (builder (add-text-to-store store
(string-append name "-guile-builder") (string-append name "-guile-builder")
(string-append (object->string prologue) (string-append (object->string prologue)
(object->string exp)) (object->string exp))
(map cdr inputs))) (map second inputs)))
(mod-drv (if (null? modules) (mod-drv (if (null? modules)
#f #f
(imported-modules store modules))) (imported-modules store modules)))
@ -482,7 +486,7 @@ (define %build-inputs
'(("HOME" . "/homeless")) '(("HOME" . "/homeless"))
`((,(%guile-for-build)) `((,(%guile-for-build))
(,builder) (,builder)
,@(map (compose list cdr) inputs) ,@(map cdr inputs)
,@(if mod-drv `((,mod-drv)) '())) ,@(if mod-drv `((,mod-drv)) '()))
#:hash hash #:hash-algo hash-algo #:hash hash #:hash-algo hash-algo
#:outputs outputs))) #:outputs outputs)))

7
guix/gnu-build-system.scm
View file

@ -32,7 +32,7 @@ (define-module (guix gnu-build-system)
(define %standard-inputs (define %standard-inputs
(map (lambda (name) (map (lambda (name)
(cons name (nixpkgs-derivation name))) (list name (nixpkgs-derivation name)))
'("gnutar" "gzip" "bzip2" "xz" '("gnutar" "gzip" "bzip2" "xz"
"coreutils" "gnused" "gnugrep" "bash" "coreutils" "gnused" "gnugrep" "bash"
"gcc" "binutils" "gnumake" "glibc"))) "gcc" "binutils" "gnumake" "glibc")))
@ -54,8 +54,9 @@ (define builder
(build-expression->derivation store name system (build-expression->derivation store name system
builder builder
(alist-cons "source" source `(("source" ,source)
(append inputs %standard-inputs)) ,@inputs
,@%standard-inputs)
#:outputs outputs #:outputs outputs
#:modules '((guix build gnu-build-system) #:modules '((guix build gnu-build-system)
(guix build utils)))) (guix build utils))))

2
tests/builders.scm
View file

@ -47,7 +47,7 @@ (define %store
"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")) "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
(tarball (http-fetch %store url 'sha256 hash)) (tarball (http-fetch %store url 'sha256 hash))
(build (gnu-build %store "hello-2.8" tarball (build (gnu-build %store "hello-2.8" tarball
`(("gawk" . ,(nixpkgs-derivation "gawk")))))) `(("gawk" ,(nixpkgs-derivation "gawk"))))))
(and (build-derivations %store (list (pk 'hello-drv build))) (and (build-derivations %store (list (pk 'hello-drv build)))
(file-exists? (string-append (derivation-path->output-path build) (file-exists? (string-append (derivation-path->output-path build)
"/bin/hello"))))) "/bin/hello")))))

2
tests/derivations.scm
View file

@ -211,7 +211,7 @@ (define %coreutils
"uname" "-a"))))) "uname" "-a")))))
(drv-path (build-expression->derivation %store "uname" (%current-system) (drv-path (build-expression->derivation %store "uname" (%current-system)
builder builder
`(("cu" . ,%coreutils)))) `(("cu" ,%coreutils))))
(succeeded? (build-derivations %store (list drv-path)))) (succeeded? (build-derivations %store (list drv-path))))
(and succeeded? (and succeeded?
(let ((p (derivation-path->output-path drv-path))) (let ((p (derivation-path->output-path drv-path)))