diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index 8d8003fe4c296e61cb5a3c2d9b7110e05cffde12..3c0571bac66fb68376f5da61e10bb4e26496350a 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -98,24 +98,6 @@ (define-public bazaar
as well as the classic centralized workflow.")
(license gpl2+)))
-(define (package-transitive-propagated-labels* package)
- "Return a list of the input labels of PACKAGE and its transitive inputs."
- (let ((name (package-name package)))
- `(,name
- ,@(map (match-lambda
- ((label (? package? _) . _)
- label))
- (package-transitive-propagated-inputs package)))))
-
-(define (package-propagated-input-refs inputs packages)
- "Return a list of (assoc-ref INPUTS <package-name>) for each package in
-PACKAGES and their propagated inputs."
- (map (lambda (l)
- `(assoc-ref ,inputs ,l))
- (delete-duplicates ;XXX: efficiency
- (append-map package-transitive-propagated-labels*
- packages))))
-
(define-public git
;; Keep in sync with 'git-manpages'!
(package
@@ -238,11 +220,13 @@ (define-public git
`("PERL5LIB" ":" prefix
,(map (lambda (o) (string-append o "/lib/perl5/site_perl"))
(list
- ,@(package-propagated-input-refs
+ ,@(transitive-input-references
'inputs
- (list perl-authen-sasl
- perl-net-smtp-ssl
- perl-io-socket-ssl))))))
+ (map (lambda (l)
+ (assoc l (inputs)))
+ '("perl-authen-sasl"
+ "perl-net-smtp-ssl"
+ "perl-io-socket-ssl")))))))
;; Tell 'git-submodule' where Perl is.
(wrap-program git-sm
diff --git a/guix/packages.scm b/guix/packages.scm
index 3983d1409acd900bcd660662d3978fdf0c4f2aef..e466ffeda064c4a2505861147fe91c4c3f3403d7 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -93,6 +94,8 @@ (define-module (guix packages)
package-output
package-grafts
+ transitive-input-references
+
%supported-systems
%hydra-supported-systems
supported-package?
@@ -579,6 +582,18 @@ (define (package-transitive-propagated-inputs package)
recursively."
(transitive-inputs (package-propagated-inputs package)))
+(define (transitive-input-references alist inputs)
+ "Return a list of (assoc-ref ALIST <label>) for each (<label> <package> . _)
+in INPUTS and their transitive propagated inputs."
+ (define label
+ (match-lambda
+ ((label . _)
+ label)))
+
+ (map (lambda (input)
+ `(assoc-ref ,alist ,(label input)))
+ (transitive-inputs inputs)))
+
(define-syntax define-memoized/v
(lambda (form)
"Define a memoized single-valued unary procedure with docstring.
diff --git a/tests/packages.scm b/tests/packages.scm
index 3cb532df1a96027a84cd72e5e82d22bb650c3a76..00a0998b4cb9b074de8bc1a42a591d1df6cf5e91 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -207,6 +207,23 @@ (define read-at
(member i s)
(member u s)))))
+(test-assert "transitive-input-references"
+ (let* ((a (dummy-package "a"))
+ (b (dummy-package "b"))
+ (c (dummy-package "c"
+ (inputs `(("a" ,a)))
+ (propagated-inputs `(("boo" ,b)))))
+ (d (dummy-package "d"
+ (inputs `(("c*" ,c)))))
+ (keys (map (match-lambda
+ (('assoc-ref 'l key)
+ key))
+ (pk 'refs (transitive-input-references
+ 'l (package-inputs d))))))
+ (and (= (length keys) 2)
+ (member "c*" keys)
+ (member "boo" keys))))
+
(test-equal "package-transitive-supported-systems, implicit inputs"
%supported-systems