rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

inferior: Add 'inferior-available-packages'. 

* guix/inferior.scm (inferior-available-packages): New procedure.
* tests/inferior.scm ("inferior-available-packages"): New test.
This commit is contained in:
Ludovic Courtès 2019-02-12 22:17:11 +01:00
parent 46765f82db
commit 739380542d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 47 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
guix/inferior.scm
View File

@ -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

22
tests/inferior.scm
View File

@ -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)