GNU bug report logs - #54393
[PATCH 0/2] Add 'guix manifest' to "translate" commands to manifests

Previous Next

Full log

Message #8 received at 54393 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 54393 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 1/2] packages: Add 'package-unique-version-prefix'.
Date: Mon, 14 Mar 2022 22:51:45 +0100

* 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 <at> 8")
("package-unique-version-prefix, grep"): New tests.
---
 gnu/packages.scm         | 21 +++++++++++++++++++++
 guix/scripts/package.scm | 20 ++------------------
 tests/packages.scm       | 13 +++++++++++++
 3 files changed, 36 insertions(+), 18 deletions(-)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 65ab7a7c1e..2ba838fd0a 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -66,6 +66,8 @@ (define-module (gnu packages)
             specification->location
             specifications->manifest
 
+            package-unique-version-prefix
+
             generate-package-cache))
 
 ;;; Commentary:
@@ -559,3 +561,22 @@ (define (specifications->manifest specs)
   ;; fiddle with multiple-value returns.
   (packages->manifest
    (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)))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 9699c70c6d..22ee8a2485 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -334,24 +334,8 @@ (define (manifest-entry-version-prefix entry)
   "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
 version of ENTRY's package is available, return the empty string."
-  (let ((name (manifest-entry-name entry)))
-    (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 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)))))))
+  (package-unique-version-prefix (manifest-entry-name entry)
+                                 (manifest-entry-version entry)))
 
 (define* (export-manifest manifest
                           #:optional (port (current-output-port)))
diff --git a/tests/packages.scm b/tests/packages.scm
index 02bdba5f98..b228c9fc3b 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1923,6 +1923,19 @@ (define (list->set* lst)
   (package-location (specification->package "guile <at> 2"))
   (specification->location "guile <at> 2"))
 
+(test-equal "package-unique-version-prefix, gcc <at> 8"
+  "8"
+  (let ((gcc (specification->package "gcc-toolchain <at> 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"
   hello
   (package-arguments
-- 
2.34.0

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.