~ruther/guix-local

860a6f1ae06151d76d39a402d3d92cc7ea6f36ff — Ludovic Courtès 13 years ago 3036a01
derivations: Fix erroneous call to `add-to-store' for local files as input.

* guix/derivations.scm (derivation)[inputs]: Fix typo in call to
  `add-to-store'.
* tests/derivations.scm ("derivation with local file as input"): New test.
* tests/packages.scm ("trivial with local file as input"): New test.
3 files changed, 41 insertions(+), 2 deletions(-)

M guix/derivations.scm
M tests/derivations.scm
M tests/packages.scm
M guix/derivations.scm => guix/derivations.scm +1 -2
@@ 418,8 418,7 @@ known in advance, such as a file download."
                           ((input . _)
                            (let ((path (add-to-store store
                                                      (basename input)
                                                      (hash-algo sha256) #t #t
                                                      input)))
                                                      #t #t "sha256" input)))
                              (make-derivation-input path '()))))
                          (delete-duplicates inputs)))
         (env-vars   (env-vars-with-empty-outputs))

M tests/derivations.scm => tests/derivations.scm +23 -0
@@ 124,6 124,29 @@
                (string=? (call-with-input-file path read-line)
                          "hello, world"))))))

(test-assert "derivation with local file as input"
  (let* ((builder    (add-text-to-store
                      %store "my-builder.sh"
                      "(while read line ; do echo $line ; done) < $in > $out"
                      '()))
         (input      (search-path %load-path "ice-9/boot-9.scm"))
         (drv-path   (derivation %store "derivation-with-input-file"
                                 (%current-system)
                                 "/bin/sh" `(,builder)
                                 `(("in"
                                    ;; Cheat to pass the actual file
                                    ;; name to the builder.
                                    . ,(add-to-store %store
                                                     (basename input)
                                                     #t #t "sha256"
                                                     input)))
                                 `((,builder)
                                   (,input)))))   ; ← local file name
    (and (build-derivations %store (list drv-path))
         (let ((p (derivation-path->output-path drv-path)))
           (and (call-with-input-file p get-bytevector-all)
                (call-with-input-file input get-bytevector-all))))))

(test-assert "fixed-output derivation"
  (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                        "echo -n hello > $out" '()))

M tests/packages.scm => tests/packages.scm +17 -0
@@ 29,6 29,7 @@
  #:use-module (distro packages bootstrap)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs io ports)
  #:use-module (ice-9 match))

;; Test the high-level packaging layer.


@@ 89,6 90,22 @@
           (equal? '(hello guix)
                   (call-with-input-file (string-append p "/test") read))))))

(test-assert "trivial with local file as input"
  (let* ((i (search-path %load-path "ice-9/boot-9.scm"))
         (p (package (inherit (dummy-package "trivial-with-input-file"))
              (build-system trivial-build-system)
              (source #f)
              (arguments
               `(#:guile ,%bootstrap-guile
                 #:builder (copy-file (assoc-ref %build-inputs "input")
                                      %output)))
              (inputs `(("input" ,i)))))
         (d (package-derivation %store p)))
    (and (build-derivations %store (list d))
         (let ((p (pk 'drv d (derivation-path->output-path d))))
           (equal? (call-with-input-file p get-bytevector-all)
                   (call-with-input-file i get-bytevector-all))))))

(test-assert "trivial with system-dependent input"
  (let* ((p (package (inherit (dummy-package "trivial-system-dependent-input"))
              (build-system trivial-build-system)