import/utils: Allow `find-version' to match an over-specified version.

This fixes the use case of using --target-version with an exact
match (--target-version causes the partial? mode to be enabled).

* tests/import/utils.scm ("find-version, latest")
("find-version, empty versions list")
("find-version, partial, under-specified")
("find-version, partial, exact")
("find-version, partial, over-specified"): New tests.
* guix/import/utils.scm (find-version): [PARTIAL?]: Truncate VERSION to the
maximum length of VERSIONS.  Explicitly handle the empty versions case.

2 files changed, 39 insertions, 5 deletions

diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 4e0e2876af7..aef52253590 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -785,14 +785,23 @@ separated by PRED."
 (define* (find-version versions #:optional version partial?)
   "Find VERSION amongst VERSIONS.  When VERSION is not provided, return the
 latest version.  When PARTIAL? is #t, VERSION is treated as a version prefix;
-e.g. finding version \"0.1\" may return \"0.1.8\" if it is the newest \"0.1\"
-prefixed version found in VERSIONS.  Return #f when VERSION could not be
-found."
+e.g. finding version \"0.1\" may return \"0.1.8\", if it is the newest \"0.1\"
+prefixed version found in VERSIONS.  In PARTIAL? mode, if the VERSION string
+provided is longer than the longest version in VERSIONS, then it is truncated
+to that length.  Return #f when VERSION could not be found."
   (let ((versions (sort versions version>?)))
     (cond
+     ((null? versions)
+      #f)
      ((and version partial?)            ;partial version
-      (find (cut version-prefix? version <>) versions))
-     ((and version (not partial?))      ;exact version
+      (let* ((max-version-length (apply max (map string-length versions)))
+             (version-length (string-length version))
+             (version (if (> version-length max-version-length)
+                          (string-drop-right version (- version-length
+                                                        max-version-length))
+                          version)))
+        (find (cut version-prefix? version <>) versions)))
+     (version                           ;exact version
       (find (cut string=? version <>) versions))
      ((not (null? versions))            ;latest version
       (first versions))
diff --git a/tests/import/utils.scm b/tests/import/utils.scm
index c82fef78ec7..44559e2c237 100644
--- a/tests/import/utils.scm
+++ b/tests/import/utils.scm
@@ -281,6 +281,31 @@ Differences are hard to spot, e.g. in CLOS vs. GOOPS."))
   (map spdx-string->license
        '("GPL-3.0-oR-LaTeR" "AGPL-3.0" "GPL-2.0+")))
 
+
+;;;
+;;; find-version.
+;;;
+
+(test-equal "find-version, empty versions list"
+  #f
+  (find-version '()))
+
+(test-equal "find-version, latest"
+  "6.11.1"
+  (find-version '("6.9" "6.8" "6.5" "6.11.1" "6.10.3")))
+
+(test-equal "find-version, partial, exact"
+  "6.10.3"
+  (find-version '("6.9" "6.8" "6.5" "6.11.1" "6.10.3") "6.10.3" #t))
+
+(test-equal "find-version, partial, under-specified"
+  "6.10.3"
+  (find-version '("6.9" "6.8" "6.5" "6.11.1" "6.10.3") "6.10" #t))
+
+(test-equal "find-version, partial, over-specified"
+  "6.10"
+  (find-version '("6.9" "6.8" "6.5" "6.11" "6.10") "6.10.3" #t))
+
 ;;;
 ;;; default-git-error
 ;;;