(address . guix-patches@gnu.org)
e778dc3c-7f39-4302-bd3a-b7691df4d38b@www.fastmail.com
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(-)
Toggle diff (90 lines)
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