From 234f84e6ae32131b06c86419a1c763667f1cee4e Mon Sep 17 00:00:00 2001
From: Ahmad Jarara <git@ajarara.io>
Date: Fri, 29 Oct 2021 21:04:06 -0400
Subject: [PATCH] gnu: transformations: apply with-source transformations to
 inputs

This patch allows for this to behave as expected:

guile build guile-ssh \
    --with-source=../guile-ssh \
    --with-source=../libssh`

Previously only the first transformation took effect.
---
 guix/transformations.scm  | 40 ++++++++++++++++++++++++++++-----------
 tests/transformations.scm | 23 ++++++++++++++++++++++
 2 files changed, 52 insertions(+), 11 deletions(-)

diff --git a/guix/transformations.scm b/guix/transformations.scm
index 5ae1977cb2..08e7d0777f 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -145,18 +145,36 @@ (define new-sources
                         (string-drop uri (+ 1 index))))))))
          sources))
 
+  (define (inject-when-applicable pkg)
+    (match (assoc-ref new-sources (package-name pkg))
+      ((version source)
+       (package-with-source pkg source version))
+      (#f
+       pkg)))
+
+  (define (inject-new-sources pkg)
+    (define (inject-new-sources-for-input input)
+      (list (car input) (inject-new-sources (cadr input))))
+    (let ((new-inputs (map inject-new-sources-for-input (package-inputs pkg)))
+          (new-native-inputs (map inject-new-sources-for-input (package-native-inputs pkg)))
+          (new-propagated-inputs (map inject-new-sources-for-input (package-propagated-inputs pkg)))
+          (new-pkg (inject-when-applicable pkg)))
+      (if (not
+           (and (eq? new-inputs (package-inputs pkg))
+                (eq? new-native-inputs (package-native-inputs pkg))
+                (eq? new-propagated-inputs (package-propagated-inputs pkg))
+                (eq? new-pkg pkg)))
+          (package
+            (inherit new-pkg)
+            (inputs new-inputs)
+            (native-inputs new-native-inputs)
+            (propagated-inputs new-propagated-inputs))
+          pkg)))
+
   (lambda (obj)
-    (let loop ((sources  new-sources)
-               (result   '()))
-      (match obj
-        ((? package? p)
-         (match (assoc-ref sources (package-name p))
-           ((version source)
-            (package-with-source p source version))
-           (#f
-            p)))
-        (_
-         obj)))))
+    (if (package? obj)
+        (inject-new-sources obj)
+        obj)))
 
 (define (evaluate-replacement-specs specs proc)
   "Parse SPECS, a list of strings like \"guile=guile@2.1\" and return a list
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 09839dc1c5..868bcbdf7b 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -145,6 +145,29 @@ (define-module (test-transformations)
                        (add-to-store store (basename s) #t
                                      "sha256" s)))))))
 
+(test-assert "options->transformation, with-source, applied to package input"
+  (let* ((d (dummy-package "bar"))
+         (p (dummy-package "foo"
+              (inputs `(("bar" ,d)))))
+         (s (search-path %load-path "guix.scm"))
+         (f (string-append "bar=" s))
+         (t (options->transformation `((with-source . ,f)))))
+    (with-store store
+      (let* ((new (t p)))
+        (and (not
+              (string=? (derivation-file-name
+                         (package-derivation store p))
+                        (derivation-file-name
+                         (package-derivation store new))))
+             (string=? (derivation-file-name
+                        (package-derivation store p))
+                       (derivation-file-name
+                        (package-derivation
+                         store
+                         (package
+                           (inherit new)
+                           (inputs (package-inputs p)))))))))))
+
 (test-assert "options->transformation, with-input"
   (let* ((p (dummy-package "guix.scm"
               (inputs `(("foo" ,(specification->package "coreutils"))

base-commit: 89d8417b371f3918f0508bbc561675ec100a6add
-- 
2.33.1