diff options
| -rw-r--r-- | gnu/packages/version-control.scm | 28 | ||||
| -rw-r--r-- | guix/packages.scm | 15 | ||||
| -rw-r--r-- | tests/packages.scm | 17 |
3 files changed, 38 insertions, 22 deletions
diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 8d8003fe4c..3c0571bac6 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -98,24 +98,6 @@ changes to project files over time. It supports both a distributed workflow 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 @@ PACKAGES and their propagated inputs." `("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 3983d1409a..e466ffeda0 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 @@ package-output package-grafts + transitive-input-references + %supported-systems %hydra-supported-systems supported-package? @@ -579,6 +582,18 @@ for the host system (\"native inputs\"), and not target inputs." 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 3cb532df1a..00a0998b4c 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -207,6 +207,23 @@ (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 |