From a716e36de915a275e4eab42b73cf0a2affc4aa33 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 13 Nov 2013 11:22:07 +0100
Subject: [PATCH] derivations: Allow 'map-derivations' to replace sources.

* guix/derivations.scm (map-derivation)[input->output-paths]: Allow
  non-derivation inputs.
  Allow replacements to be store files.  Replace in SOURCES too.
* tests/derivations.scm ("map-derivation, sources"): New test.
---
 guix/derivations.scm  | 26 +++++++++++++++++++-------
 tests/derivations.scm | 22 ++++++++++++++++++++++
 2 files changed, 41 insertions(+), 7 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index b33e835556..63c1ba4f2b 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -674,17 +674,21 @@ recursively."
 
   (define input->output-paths
     (match-lambda
-     ((drv)
+     (((? derivation? drv))
       (list (derivation->output-path drv)))
-     ((drv sub-drvs ...)
+     (((? derivation? drv) sub-drvs ...)
       (map (cut derivation->output-path drv <>)
-           sub-drvs))))
+           sub-drvs))
+     ((file)
+      (list file))))
 
   (let ((mapping (fold (lambda (pair result)
                          (match pair
-                           ((orig . replacement)
+                           (((? derivation? orig) . replacement)
                             (vhash-cons (derivation-file-name orig)
-                                        replacement result))))
+                                        replacement result))
+                           ((file . replacement)
+                            (vhash-cons file replacement result))))
                        vlist-null
                        mapping)))
     (define rewritten-input
@@ -695,8 +699,10 @@ recursively."
          (match input
            (($ <derivation-input> path (sub-drvs ...))
             (match (vhash-assoc path mapping)
-              ((_ . replacement)
+              ((_ . (? derivation? replacement))
                (cons replacement sub-drvs))
+              ((_ . replacement)
+               (list replacement))
               (#f
                (let* ((drv (loop (call-with-input-file path read-derivation))))
                  (cons drv sub-drvs)))))))))
@@ -711,7 +717,13 @@ recursively."
              ;; Sources typically refer to the output directories of the
              ;; original inputs, INITIAL.  Rewrite them by substituting
              ;; REPLACEMENTS.
-             (sources      (map (cut substitute-file <> initial replacements)
+             (sources      (map (lambda (source)
+                                  (match (vhash-assoc source mapping)
+                                    ((_ . replacement)
+                                     replacement)
+                                    (#f
+                                     (substitute-file source
+                                                      initial replacements))))
                                 (derivation-sources drv)))
 
              ;; Now augment the lists of initials and replacements.
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 09cf81972c..a4e073bf07 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -720,6 +720,28 @@ Deriver: ~a~%"
     (and (build-derivations %store (list (pk 'remapped drv4)))
          (call-with-input-file out get-string-all))))
 
+(test-equal "map-derivation, sources"
+  "hello"
+  (let* ((script1   (add-text-to-store %store "fail.sh" "exit 1"))
+         (script2   (add-text-to-store %store "hi.sh" "echo -n hello > $out"))
+         (bash-full (package-derivation %store (@ (gnu packages bash) bash)))
+         (drv1      (derivation %store "drv-to-remap"
+
+                                ;; XXX: This wouldn't work in practice, but if
+                                ;; we append "/bin/bash" then we can't replace
+                                ;; it with the bootstrap bash, which is a
+                                ;; single file.
+                                (derivation->output-path bash-full)
+
+                                `("-e" ,script1)
+                                #:inputs `((,bash-full) (,script1))))
+         (drv2      (map-derivation %store drv1
+                                    `((,bash-full . ,%bash)
+                                      (,script1 . ,script2))))
+         (out       (derivation->output-path drv2)))
+    (and (build-derivations %store (list (pk 'remapped* drv2)))
+         (call-with-input-file out get-string-all))))
+
 (test-end)