summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/inferior.scm26
-rw-r--r--tests/inferior.scm22
2 files changed, 47 insertions, 1 deletions
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 6cfa146029..027418a98d 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -61,6 +61,7 @@
inferior-object?
inferior-packages
+ inferior-available-packages
lookup-inferior-packages
inferior-package?
@@ -256,6 +257,31 @@ equivalent. Return #f if the inferior could not be launched."
vlist-null
(inferior-packages inferior)))
+(define (inferior-available-packages inferior)
+ "Return the list of name/version pairs corresponding to the set of packages
+available in INFERIOR.
+
+This is faster and requires less resource-intensive than calling
+'inferior-packages'."
+ (if (inferior-eval '(defined? 'fold-available-packages)
+ inferior)
+ (inferior-eval '(fold-available-packages
+ (lambda* (name version result
+ #:key supported? deprecated?
+ #:allow-other-keys)
+ (if (and supported? (not deprecated?))
+ (acons name version result)
+ result))
+ '())
+ inferior)
+
+ ;; As a last resort, if INFERIOR is old and lacks
+ ;; 'fold-available-packages', fall back to 'inferior-packages'.
+ (map (lambda (package)
+ (cons (inferior-package-name package)
+ (inferior-package-version package)))
+ (inferior-packages inferior))))
+
(define* (lookup-inferior-packages inferior name #:optional version)
"Return the sorted list of inferior packages matching NAME in INFERIOR, with
highest version numbers first. If VERSION is true, return only packages with
diff --git a/tests/inferior.scm b/tests/inferior.scm
index d5a894ca8f..71ebf8f59b 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -89,6 +89,26 @@
(close-inferior inferior)
result))))
+(test-equal "inferior-available-packages"
+ (take (sort (fold-available-packages
+ (lambda* (name version result
+ #:key supported? deprecated?
+ #:allow-other-keys)
+ (if (and supported? (not deprecated?))
+ (alist-cons name version result)
+ result))
+ '())
+ (lambda (x y)
+ (string<? (car x) (car y))))
+ 10)
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix"))
+ (packages (inferior-available-packages inferior)))
+ (close-inferior inferior)
+ (take (sort packages (lambda (x y)
+ (string<? (car x) (car y))))
+ 10)))
+
(test-equal "lookup-inferior-packages"
(let ((->list (lambda (package)
(list (package-name package)