packages: Add 'package-unique-version-prefix'.
* gnu/packages.scm (package-unique-version-prefix): New procedure. * guix/scripts/package.scm (manifest-entry-version-prefix): Use it. * tests/packages.scm ("package-unique-version-prefix, gcc@8") ("package-unique-version-prefix, grep"): New tests.
This commit is contained in:
parent
4b451813f7
commit
f54f2aa9df
@ -66,6 +66,8 @@
|
|||||||
specification->location
|
specification->location
|
||||||
specifications->manifest
|
specifications->manifest
|
||||||
|
|
||||||
|
package-unique-version-prefix
|
||||||
|
|
||||||
generate-package-cache))
|
generate-package-cache))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
@ -559,3 +561,22 @@ output."
|
|||||||
;; fiddle with multiple-value returns.
|
;; fiddle with multiple-value returns.
|
||||||
(packages->manifest
|
(packages->manifest
|
||||||
(map (compose list specification->package+output) specs)))
|
(map (compose list specification->package+output) specs)))
|
||||||
|
|
||||||
|
(define (package-unique-version-prefix name version)
|
||||||
|
"Search among all the versions of package NAME that are available, and
|
||||||
|
return the shortest unambiguous version prefix to designate VERSION. If only
|
||||||
|
one version of the package is available, return the empty string."
|
||||||
|
(match (map package-version (find-packages-by-name name))
|
||||||
|
((_)
|
||||||
|
;; A single version of NAME is available, so do not specify the version
|
||||||
|
;; number, even if the available version doesn't match VERSION.
|
||||||
|
"")
|
||||||
|
(versions
|
||||||
|
;; If VERSION is the latest version, don't specify any version.
|
||||||
|
;; Otherwise return the shortest unique version prefix. Note that this
|
||||||
|
;; is based on the currently available packages so the result may vary
|
||||||
|
;; over time.
|
||||||
|
(if (every (cut version>? version <>)
|
||||||
|
(delete version versions))
|
||||||
|
""
|
||||||
|
(version-unique-prefix version versions)))))
|
||||||
|
@ -334,24 +334,8 @@ Alternately, see @command{guix package --search-paths -p ~s}.")
|
|||||||
"Search among all the versions of ENTRY's package that are available, and
|
"Search among all the versions of ENTRY's package that are available, and
|
||||||
return the shortest unambiguous version prefix for this package. If only one
|
return the shortest unambiguous version prefix for this package. If only one
|
||||||
version of ENTRY's package is available, return the empty string."
|
version of ENTRY's package is available, return the empty string."
|
||||||
(let ((name (manifest-entry-name entry)))
|
(package-unique-version-prefix (manifest-entry-name entry)
|
||||||
(match (map package-version (find-packages-by-name name))
|
(manifest-entry-version entry)))
|
||||||
((_)
|
|
||||||
;; A single version of NAME is available, so do not specify the
|
|
||||||
;; version number, even if the available version doesn't match ENTRY.
|
|
||||||
"")
|
|
||||||
(versions
|
|
||||||
;; If ENTRY uses the latest version, don't specify any version.
|
|
||||||
;; Otherwise return the shortest unique version prefix. Note that
|
|
||||||
;; this is based on the currently available packages, which could
|
|
||||||
;; differ from the packages available in the revision that was used
|
|
||||||
;; to build MANIFEST.
|
|
||||||
(let ((current (manifest-entry-version entry)))
|
|
||||||
(if (every (cut version>? current <>)
|
|
||||||
(delete current versions))
|
|
||||||
""
|
|
||||||
(version-unique-prefix (manifest-entry-version entry)
|
|
||||||
versions)))))))
|
|
||||||
|
|
||||||
(define* (export-manifest manifest
|
(define* (export-manifest manifest
|
||||||
#:optional (port (current-output-port)))
|
#:optional (port (current-output-port)))
|
||||||
|
@ -1923,6 +1923,19 @@
|
|||||||
(package-location (specification->package "guile@2"))
|
(package-location (specification->package "guile@2"))
|
||||||
(specification->location "guile@2"))
|
(specification->location "guile@2"))
|
||||||
|
|
||||||
|
(test-equal "package-unique-version-prefix, gcc@8"
|
||||||
|
"8"
|
||||||
|
(let ((gcc (specification->package "gcc-toolchain@8")))
|
||||||
|
(package-unique-version-prefix (package-name gcc)
|
||||||
|
(package-version gcc))))
|
||||||
|
|
||||||
|
(test-equal "package-unique-version-prefix, grep"
|
||||||
|
""
|
||||||
|
(let ((grep (specification->package "grep")))
|
||||||
|
(package-unique-version-prefix (package-name grep)
|
||||||
|
(package-version grep))))
|
||||||
|
|
||||||
|
|
||||||
(test-eq "this-package-input, exists"
|
(test-eq "this-package-input, exists"
|
||||||
hello
|
hello
|
||||||
(package-arguments
|
(package-arguments
|
||||||
|
Loading…
Reference in New Issue
Block a user