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.
This commit is contained in:
Ludovic Courtès 2012-12-04 23:46:50 +01:00
parent 3036a01ff7
commit 860a6f1ae0
3 changed files with 41 additions and 2 deletions

View File

@ -418,8 +418,7 @@ known in advance, such as a file download."
((input . _) ((input . _)
(let ((path (add-to-store store (let ((path (add-to-store store
(basename input) (basename input)
(hash-algo sha256) #t #t #t #t "sha256" input)))
input)))
(make-derivation-input path '())))) (make-derivation-input path '()))))
(delete-duplicates inputs))) (delete-duplicates inputs)))
(env-vars (env-vars-with-empty-outputs)) (env-vars (env-vars-with-empty-outputs))

View File

@ -124,6 +124,29 @@
(string=? (call-with-input-file path read-line) (string=? (call-with-input-file path read-line)
"hello, world")))))) "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" (test-assert "fixed-output derivation"
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo -n hello > $out" '())) "echo -n hello > $out" '()))

View File

@ -29,6 +29,7 @@
#:use-module (distro packages bootstrap) #:use-module (distro packages bootstrap)
#: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 (ice-9 match)) #:use-module (ice-9 match))
;; Test the high-level packaging layer. ;; Test the high-level packaging layer.
@ -89,6 +90,22 @@
(equal? '(hello guix) (equal? '(hello guix)
(call-with-input-file (string-append p "/test") read)))))) (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" (test-assert "trivial with system-dependent input"
(let* ((p (package (inherit (dummy-package "trivial-system-dependent-input")) (let* ((p (package (inherit (dummy-package "trivial-system-dependent-input"))
(build-system trivial-build-system) (build-system trivial-build-system)