~ruther/guix-local

2acb2cb6d006a4799ae9f477c22177824fcc8f52 — Ludovic Courtès 13 years ago c36db98
Change `build-expression->derivation' to support sub-derivation inputs.

* 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.
4 files changed, 25 insertions(+), 20 deletions(-)

M guix/derivations.scm
M guix/gnu-build-system.scm
M tests/builders.scm
M tests/derivations.scm
M guix/derivations.scm => guix/derivations.scm +19 -15
@@ 397,7 397,7 @@ system, imported, and appears under FINAL-PATH in the resulting store path."

  (let* ((files   (map (match-lambda
                        ((final-path . file-name)
                         (cons final-path
                         (list final-path
                               (add-to-store store (basename final-path) #t #f
                                             "sha256" file-name))))
                       files))


@@ 405,7 405,7 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
          `(begin
             (mkdir %output) (chdir %output)
             ,@(append-map (match-lambda
                            ((final-path . store-path)
                            ((final-path store-path)
                             (append (match (parent-dirs final-path)
                                       (() '())
                                       ((head ... tail)


@@ 442,11 442,11 @@ search path."
                                       hash hash-algo
                                       (modules '()))
  "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 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."
derivation NAME.  INPUTS must be a list of (NAME DRV-PATH SUB-DRV) tuples;
when SUB-DRV is omitted, \"out\" is assumed.  EXP 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"))


@@ 459,17 459,21 @@ INPUTS."
                             ',outputs))
                      (define %build-inputs
                        ',(map (match-lambda
                                ((name . drv)
                                 (cons name
                                       (if (derivation-path? drv)
                                           (derivation-path->output-path drv)
                                           drv))))
                               inputs))) )
                                ((name drv . rest)
                                 (let ((sub (match rest
                                              (() "out")
                                              ((x) x))))
                                   (cons name
                                         (if (derivation-path? drv)
                                             (derivation-path->output-path drv
                                                                           sub)
                                             drv)))))
                               inputs))))
         (builder  (add-text-to-store store
                                      (string-append name "-guile-builder")
                                      (string-append (object->string prologue)
                                                     (object->string exp))
                                      (map cdr inputs)))
                                      (map second inputs)))
         (mod-drv  (if (null? modules)
                       #f
                       (imported-modules store modules)))


@@ 482,7 486,7 @@ INPUTS."
                '(("HOME" . "/homeless"))
                `((,(%guile-for-build))
                  (,builder)
                  ,@(map (compose list cdr) inputs)
                  ,@(map cdr inputs)
                  ,@(if mod-drv `((,mod-drv)) '()))
                #:hash hash #:hash-algo hash-algo
                #:outputs outputs)))

M guix/gnu-build-system.scm => guix/gnu-build-system.scm +4 -3
@@ 32,7 32,7 @@

(define %standard-inputs
  (map (lambda (name)
         (cons name (nixpkgs-derivation name)))
         (list name (nixpkgs-derivation name)))
       '("gnutar" "gzip" "bzip2" "xz"
         "coreutils" "gnused" "gnugrep" "bash"
         "gcc" "binutils" "gnumake" "glibc")))


@@ 54,8 54,9 @@ input derivation INPUTS, using the usual procedure of the GNU Build System."

  (build-expression->derivation store name system
                                builder
                                (alist-cons "source" source
                                            (append inputs %standard-inputs))
                                `(("source" ,source)
                                  ,@inputs
                                  ,@%standard-inputs)
                                #:outputs outputs
                                #:modules '((guix build gnu-build-system)
                                            (guix build utils))))

M tests/builders.scm => tests/builders.scm +1 -1
@@ 47,7 47,7 @@
                    "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
         (tarball  (http-fetch %store url 'sha256 hash))
         (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)))
         (file-exists? (string-append (derivation-path->output-path build)
                                      "/bin/hello")))))

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