From 860a6f1ae06151d76d39a402d3d92cc7ea6f36ff Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 4 Dec 2012 23:46:50 +0100
Subject: 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.
---
 guix/derivations.scm  |  3 +--
 tests/derivations.scm | 23 +++++++++++++++++++++++
 tests/packages.scm    | 17 +++++++++++++++++
 3 files changed, 41 insertions(+), 2 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index cda1f065d4..b1f54232bc 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -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))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index bcedfbf948..14e1863a12 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -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" '()))
diff --git a/tests/packages.scm b/tests/packages.scm
index cb69e4be4e..c89f6e7721 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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)
-- 
cgit v1.2.3