~ruther/guix-local

26b969dee0d1abb92b44998dc573dad79b76d4cd — Ludovic Courtès 13 years ago 749c656
Add support for fixed-output derivations in `build-expression->derivation'.

* guix/derivations.scm (build-expression->derivation): Pass HASH and
  HASH-ALGO to `derivation'.

* tests/derivations.scm ("build-expression->derivation for fixed-output
  derivation"): New test.
2 files changed, 25 insertions(+), 1 deletions(-)

M guix/derivations.scm
M tests/derivations.scm
M guix/derivations.scm => guix/derivations.scm +2 -1
@@ 396,4 396,5 @@ from INPUTS."
    (derivation store name system guile `("--no-auto-compile" ,builder)
                '(("HOME" . "/homeless"))
                `((,(%guile-for-build))
                  (,builder)))))
                  (,builder))
                #:hash hash #:hash-algo hash-algo)))

M tests/derivations.scm => tests/derivations.scm +23 -0
@@ 141,6 141,29 @@
         (let ((p (derivation-path->output-path drv-path)))
           (string-contains (call-with-input-file p read-line) "GNU")))))

(test-skip (if (false-if-exception (getaddrinfo "ftp.gnu.org" "http"))
               0
               1))

(test-assert "build-expression->derivation for fixed-output derivation"
  (let* ((url         "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
         (builder     `(begin
                         (use-modules (web client) (web uri)
                                      (rnrs io ports))
                         (let ((bv (http-get (string->uri ,url)
                                             #:decode-body? #f)))
                           (call-with-output-file %output
                             (lambda (p)
                               (put-bytevector p bv))))))
         (drv-path    (build-expression->derivation
                       %store "hello-2.8.tar.gz" "x86_64-linux" builder '()
                       #:hash (nix-base32-string->bytevector
                               "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6")
                       #:hash-algo 'sha256))
         (succeeded?  (build-derivations %store (list drv-path))))
    (and succeeded?
         (file-exists? (derivation-path->output-path drv-path)))))

(test-end)