[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/06: packages: Add 'package-closure'.
From: |
guix-commits |
Subject: |
01/06: packages: Add 'package-closure'. |
Date: |
Fri, 25 Jan 2019 08:06:55 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 3e223a22a70138b8c57e742ad8ec737131249820
Author: Ludovic Courtès <address@hidden>
Date: Fri Jan 25 10:05:31 2019 +0100
packages: Add 'package-closure'.
* guix/packages.scm (package-closure): New procedure.
* tests/packages.scm ("package-closure"): New test.
---
guix/packages.scm | 25 ++++++++++++++++++++++++-
tests/packages.scm | 23 +++++++++++++++++++++++
2 files changed, 47 insertions(+), 1 deletion(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index e4c2ac3..f191327 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès
<address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès
<address@hidden>
;;; Copyright © 2014, 2015, 2017, 2018 Mark H Weaver <address@hidden>
;;; Copyright © 2015 Eric Bavier <address@hidden>
;;; Copyright © 2016 Alex Kost <address@hidden>
@@ -133,6 +133,7 @@
bag-transitive-host-inputs
bag-transitive-build-inputs
bag-transitive-target-inputs
+ package-closure
default-guile
default-guile-derivation
@@ -798,6 +799,28 @@ dependencies are known to build on SYSTEM."
"Return the \"target inputs\" of BAG, recursively."
(transitive-inputs (bag-target-inputs bag)))
+(define* (package-closure packages #:key (system (%current-system)))
+ "Return the closure of PACKAGES on SYSTEM--i.e., PACKAGES and the list of
+packages they depend on, recursively."
+ (let loop ((packages packages)
+ (visited vlist-null)
+ (closure (list->setq packages)))
+ (match packages
+ (()
+ (set->list closure))
+ ((package . rest)
+ (if (vhash-assq package visited)
+ (loop rest visited closure)
+ (let* ((bag (package->bag package system))
+ (dependencies (filter-map (match-lambda
+ ((label (? package? package) . _)
+ package)
+ (_ #f))
+ (bag-direct-inputs bag))))
+ (loop (append dependencies rest)
+ (vhash-consq package #t visited)
+ (fold set-insert closure dependencies))))))))
+
(define* (package-mapping proc #:optional (cut? (const #f)))
"Return a procedure that, given a package, applies PROC to all the packages
depended on and returns the resulting package. The procedure stops recursion
diff --git a/tests/packages.scm b/tests/packages.scm
index 29e5e41..e5704ae 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -249,6 +249,28 @@
(package-transitive-supported-systems d)
(package-transitive-supported-systems e))))
+(test-assert "package-closure"
+ (let-syntax ((dummy-package/no-implicit
+ (syntax-rules ()
+ ((_ name rest ...)
+ (package
+ (inherit (dummy-package name rest ...))
+ (build-system trivial-build-system))))))
+ (let* ((a (dummy-package/no-implicit "a"))
+ (b (dummy-package/no-implicit "b"
+ (propagated-inputs `(("a" ,a)))))
+ (c (dummy-package/no-implicit "c"
+ (inputs `(("a" ,a)))))
+ (d (dummy-package/no-implicit "d"
+ (native-inputs `(("b" ,b)))))
+ (e (dummy-package/no-implicit "e"
+ (inputs `(("c" ,c) ("d" ,d))))))
+ (lset= eq?
+ (list a b c d e)
+ (package-closure (list e))
+ (package-closure (list e d))
+ (package-closure (list e c b))))))
+
(test-equal "origin-actual-file-name"
"foo-1.tar.gz"
(let ((o (dummy-origin (uri "http://www.example.com/foo-1.tar.gz"))))
@@ -1180,4 +1202,5 @@
;;; Local Variables:
;;; eval: (put 'dummy-package 'scheme-indent-function 1)
+;;; eval: (put 'dummy-package/no-implicit 'scheme-indent-function 1)
;;; End:
- branch master updated (c6e33df -> 4ad7d03), guix-commits, 2019/01/25
- 04/06: refresh: Better account for private and generated packages., guix-commits, 2019/01/25
- 06/06: gnu: Add ghc-libmpd., guix-commits, 2019/01/25
- 05/06: weather: Add '--coverage'., guix-commits, 2019/01/25
- 02/06: weather: Ignore deprecated packages but not hidden packages., guix-commits, 2019/01/25
- 03/06: refresh: Fix format string that would lead '-l' to print incorrect numbers., guix-commits, 2019/01/25
- 01/06: packages: Add 'package-closure'.,
guix-commits <=