bug#22046: [PATCH] Improve version-to-list parsing

[Alex Dunn]

This was prompted by an issue over at MELPA, where they were having
trouble packaging stable versions of erlang-mode due to Erlang’s odd
version-strings: https://github.com/milkypostman/melpa/issues/2553.  So
with this patch, 'OTP-18.0.5' is valid and parsed as '(18 0 5).

Other changes in behavior:

- “.” can be used as a priority separator.  This seemed appropriate
   since Emacs allows changing of `version-separator' to strings other
   than “.”, and in such cases “.” might be used to mark priority.

- The docstring said “.5” was invalid, when it actually was.  I’ve made it
   explicitly valid, and added tests for it.

- The docstring said “22.8X3” was invalid, when it actually was; it got
   parsed as '(22 8 24 3).  I’ve made it really invalid.

- I’ve made strings like “alpha3.2” valid, and parsed as '(3 2 -3).

>From 497052685f0b4aa4d2f0de2eb30f7beaf62c97c5 Mon Sep 17 00:00:00 2001
From: Alex Dunn <dunn.alex@gmail.com>
Date: Fri, 27 Nov 2015 15:39:24 -0800
Subject: [PATCH] Improve version-to-list parsing

* lisp/subr.el (version-regexp-alist): allow `.' as priority separator
* lisp/subr.el (version-to-list): parse versions like OTP-18.1.5 correctly
* lisp/subr.el (version-to-list): allow prefixed priority separators
* test/lisp/subr-tests.el (ert-test-version-parsing): parsing tests
---
 lisp/subr.el            | 100 +++++++++++++++++++++++++-------------
 test/lisp/subr-tests.el | 125 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 191 insertions(+), 34 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index ea926ae..74d6aa1 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4686,14 +4686,14 @@ version-separator
 
 
 (defconst version-regexp-alist
-  '(("^[-_+ ]?snapshot$"                                 . -4)
+  '(("^[-\._+ ]?snapshot$"                                 . -4)
     ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases
-    ("^[-_+]$"                                           . -4)
+    ("^[-\._+]$"                                           . -4)
     ;; treat "1.2.3-CVS" as snapshot release
-    ("^[-_+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4)
-    ("^[-_+ ]?alpha$"                                    . -3)
-    ("^[-_+ ]?beta$"                                     . -2)
-    ("^[-_+ ]?\\(pre\\|rc\\)$"                           . -1))
+    ("^[-\._+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4)
+    ("^[-\._+ ]?alpha$"                                    . -3)
+    ("^[-\._+ ]?beta$"                                     . -2)
+    ("^[-\._+ ]?\\(pre\\|rc\\)$"                           . -1))
   "Specify association between non-numeric version and its priority.
 
 This association is used to handle version string like \"1.0pre2\",
@@ -4703,6 +4703,7 @@ version-regexp-alist
    String Version    Integer List Version
    \"0.9snapshot\"     (0  9 -4)
    \"1.0-git\"         (1  0 -4)
+   \"1.0.cvs\"         (1  0 -4)
    \"1.0pre2\"         (1  0 -1 2)
    \"1.0PRE2\"         (1  0 -1 2)
    \"22.8beta3\"       (22 8 -2 3)
@@ -4742,41 +4743,68 @@ version-to-list
 
 Examples of valid version syntax:
 
-   1.0pre2   1.0.7.5   22.8beta3   0.9alpha1   6.9.30Beta
+   1.0pre2   1.0.7.5   22.8beta3   0.9alpha1   6.9.30Beta   OTP-10.0.3   
2.4.snapshot   alpha3.2   .5
 
 Examples of invalid version syntax:
 
-   1.0prepre2   1.0..7.5   22.8X3   alpha3.2   .5
+   1.0prepre2   1.0..7.5   22.8X3
 
 Examples of version conversion:
 
    Version String    Version as a List of Integers
-   \"1.0.7.5\"         (1  0  7 5)
-   \"1.0pre2\"         (1  0 -1 2)
-   \"1.0PRE2\"         (1  0 -1 2)
-   \"22.8beta3\"       (22 8 -2 3)
-   \"22.8Beta3\"       (22 8 -2 3)
-   \"0.9alpha1\"       (0  9 -3 1)
+   \".5\"              (0 5)
+   \"0.9 alpha\"       (0  9 -3)
    \"0.9AlphA1\"       (0  9 -3 1)
-   \"0.9alpha\"        (0  9 -3)
+   \"0.9alpha1\"       (0  9 -3 1)
    \"0.9snapshot\"     (0  9 -4)
    \"1.0-git\"         (1  0 -4)
+   \"1.0.7.5\"         (1  0  7 5)
+   \"1.0.cvs\"         (1  0 -4)
+   \"1.0PRE2\"         (1  0 -1 2)
+   \"1.0pre2\"         (1  0 -1 2)
+   \"22.8 Beta3\"      (22 8 -2 3)
+   \"22.8beta3\"       (22 8 -2 3)
+   \"OTP-10.0.3\"      (10 0 3)
+   \"alpha3.2\"        (3 2 -3)
 
 See documentation for `version-separator' and `version-regexp-alist'."
-  (or (and (stringp ver) (> (length ver) 0))
-      (error "Invalid version string: `%s'" ver))
-  ;; Change .x.y to 0.x.y
-  (if (and (>= (length ver) (length version-separator))
-          (string-equal (substring ver 0 (length version-separator))
-                        version-separator))
+  (unless (stringp ver)
+    (error "Version must be a string"))
+  (let ((input ver)   ; save the original version string for error messages
+         (i 0)   ; our position in the version-string
+         (case-fold-search t)   ; ignore case in matching
+         (al version-regexp-alist)
+         lst s pref)   ; lst: the list returned
+                       ; s: the starting index of the substring currently 
being parsed
+                       ; pref: the priority of a prefixed separator
+    ;; Change .x.y to 0.x.y
+    (if (and (>= (length ver) (length version-separator))
+          (string-equal (substring ver 0 (length version-separator))
+            version-separator))
       (setq ver (concat "0" ver)))
-  (save-match-data
-    (let ((i 0)
-         (case-fold-search t)          ; ignore case in matching
-         lst s al)
+    ;; Allow text separators at the beginning of the version-string,
+    ;; but strip any other non-numeric prefix (see Erlang and their
+    ;; OTP-18.1.5 version-strings)
+    (when (and (string-match "^[^0-9]+" ver) (> (length ver) 0))
+      (setq i (match-end 0))
+      (while (and al (not (string-match (caar al) (substring ver 0 i))))
+        (setq al (cdr al)))
+      (if al
+          ;; If the non-numeric beginning of the version-string is a
+          ;; separator, set it to pref, to be added to lst at the end
+          (setq pref (cdar al))
+        ;; Else trim the version string up to the first number and reset i
+        (setq ver (substring ver i)
+              i 0)))
+    ;; Die here if the version-string is now empty
+    (if (= (length ver) 0)
+      (error "Invalid version string: `%s'" input))
+    (save-match-data
+      ;; Parse the version-string up to a separator until there are none left
       (while (and (setq s (string-match "[0-9]+" ver i))
                  (= s i))
-       ;; handle numeric part
+        ;; Add the numeric part to the beginning of the version list;
+        ;; lst gets reversed at the end
        (setq lst (cons (string-to-number (substring ver i (match-end 0)))
                        lst)
              i   (match-end 0))
@@ -4790,17 +4818,21 @@ version-to-list
            (setq al version-regexp-alist)
            (while (and al (not (string-match (caar al) s)))
              (setq al (cdr al)))
-           (cond (al
+      ;; only allow alpha, beta, pre, etc. separators at the beginning
+      ;; of the version-string (handled above) or as a normal
+      ;; separator, but not as both ("beta0.9alpha1" is not valid)
+      (cond ((and al (null pref))
                   (push (cdar al) lst))
-                 ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc.
-                 ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s)
+        ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc., but only if
+        ;; the letter is the end of the version-string, to avoid
+        ;; 22.8X3 being valid
+        ((and (string-match "^[-\._+ ]?\\([a-zA-Z]\\)$" s)
+           (= i (length ver)))
                   (push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
                         lst))
-                 (t (error "Invalid version syntax: `%s'" ver))))))
-      (if (null lst)
-         (error "Invalid version syntax: `%s'" ver)
-       (nreverse lst)))))
-
+                 (t (error "Invalid version syntax: `%s'" input)))))))
+    (if pref (push pref lst))
+    (nreverse lst)))
 
 (defun version-list-< (l1 l2)
   "Return t if L1, a list specification of a version, is lower than L2.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ee8db59..605db91 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -103,5 +103,130 @@
   (should (equal (macroexpand-all '(when a b c d))
                  '(if a (progn b c d)))))
 
+(ert-deftest subr-test-version-parsing ()
+  (should (equal (version-to-list ".5") '(0 5)))
+  (should (equal (version-to-list "0.9 alpha1") '(0 9 -3 1)))
+  (should (equal (version-to-list "0.9 snapshot") '(0  9 -4)))
+  (should (equal (version-to-list "0.9-alpha1") '(0 9 -3 1)))
+  (should (equal (version-to-list "0.9-snapshot") '(0  9 -4)))
+  (should (equal (version-to-list "0.9.snapshot") '(0  9 -4)))
+  (should (equal (version-to-list "0.9_snapshot") '(0  9 -4)))
+  (should (equal (version-to-list "0.9alpha1") '(0 9 -3 1)))
+  (should (equal (version-to-list "0.9snapshot") '(0  9 -4)))
+  (should (equal (version-to-list "1.0 git") '(1  0 -4)))
+  (should (equal (version-to-list "1.0 pre2") '(1 0 -1 2)))
+  (should (equal (version-to-list "1.0-git") '(1  0 -4)))
+  (should (equal (version-to-list "1.0-pre2") '(1 0 -1 2)))
+  (should (equal (version-to-list "1.0.1-a") '(1 0 1 1)))
+  (should (equal (version-to-list "1.0.1-f") '(1 0 1 6)))
+  (should (equal (version-to-list "1.0.1.a") '(1 0 1 1)))
+  (should (equal (version-to-list "1.0.1.f") '(1 0 1 6)))
+  (should (equal (version-to-list "1.0.1_a") '(1 0 1 1)))
+  (should (equal (version-to-list "1.0.1_f") '(1 0 1 6)))
+  (should (equal (version-to-list "1.0.1a") '(1 0 1 1)))
+  (should (equal (version-to-list "1.0.1f") '(1 0 1 6)))
+  (should (equal (version-to-list "1.0.7.5") '(1 0 7 5)))
+  (should (equal (version-to-list "1.0.git") '(1  0 -4)))
+  (should (equal (version-to-list "1.0.pre2") '(1 0 -1 2)))
+  (should (equal (version-to-list "1.0_git") '(1  0 -4)))
+  (should (equal (version-to-list "1.0_pre2") '(1 0 -1 2)))
+  (should (equal (version-to-list "1.0git") '(1  0 -4)))
+  (should (equal (version-to-list "1.0pre2") '(1 0 -1 2)))
+  (should (equal (version-to-list "22.8 beta3") '(22 8 -2 3)))
+  (should (equal (version-to-list "22.8-beta3") '(22 8 -2 3)))
+  (should (equal (version-to-list "22.8.beta3") '(22 8 -2 3)))
+  (should (equal (version-to-list "22.8_beta3") '(22 8 -2 3)))
+  (should (equal (version-to-list "22.8beta3") '(22 8 -2 3)))
+  (should (equal (version-to-list "6.9.30 Beta") '(6 9 30 -2)))
+  (should (equal (version-to-list "6.9.30-Beta") '(6 9 30 -2)))
+  (should (equal (version-to-list "6.9.30.Beta") '(6 9 30 -2)))
+  (should (equal (version-to-list "6.9.30Beta") '(6 9 30 -2)))
+  (should (equal (version-to-list "6.9.30_Beta") '(6 9 30 -2)))
+  (should (equal (version-to-list "OTP 18.1.5") '(18 1 5)))
+  (should (equal (version-to-list "OTP-18.1.5") '(18 1 5)))
+  (should (equal (version-to-list "OTP.18.1.5") '(18 1 5)))
+  (should (equal (version-to-list "OTP18.1.5") '(18 1 5)))
+  (should (equal (version-to-list "alpha0.9") '(0 9 -3)))
+
+  (should (equal
+            (error-message-string (should-error (version-to-list "")))
+            "Invalid version string: `'"))
+  (should (equal
+            (error-message-string (should-error (version-to-list "1.0..7.5")))
+            "Invalid version syntax: `1.0..7.5'"))
+  (should (equal
+            (error-message-string (should-error (version-to-list 
"1.0prepre2")))
+            "Invalid version syntax: `1.0prepre2'"))
+  (should (equal
+            (error-message-string (should-error (version-to-list "22.8X3")))
+            "Invalid version syntax: `22.8X3'"))
+  (should (equal
+            (error-message-string (should-error (version-to-list 
"beta22.8alpha")))
+            "Invalid version syntax: `beta22.8alpha'"))
+  (should (equal
+            (error-message-string (should-error (version-to-list 
"beta22.8alpha3")))
+            "Invalid version syntax: `beta22.8alpha3'"))
+  (should (equal
+            (error-message-string (should-error (version-to-list "honk")))
+            "Invalid version string: `honk'"))
+  (should (equal
+            (error-message-string (should-error (version-to-list 9)))
+            "Version must be a string"))
+
+  (let ((version-separator "_"))
+    (should (equal (version-to-list "_5") '(0 5)))
+    (should (equal (version-to-list "0_9 alpha1") '(0 9 -3 1)))
+    (should (equal (version-to-list "0_9 snapshot") '(0  9 -4)))
+    (should (equal (version-to-list "0_9-alpha1") '(0 9 -3 1)))
+    (should (equal (version-to-list "0_9-snapshot") '(0  9 -4)))
+    (should (equal (version-to-list "0_9.alpha1") '(0 9 -3 1)))
+    (should (equal (version-to-list "0_9.snapshot") '(0  9 -4)))
+    (should (equal (version-to-list "0_9alpha1") '(0 9 -3 1)))
+    (should (equal (version-to-list "0_9snapshot") '(0  9 -4)))
+    (should (equal (version-to-list "1_0 git") '(1  0 -4)))
+    (should (equal (version-to-list "1_0 pre2") '(1 0 -1 2)))
+    (should (equal (version-to-list "1_0-git") '(1  0 -4)))
+    (should (equal (version-to-list "1_0.pre2") '(1 0 -1 2)))
+    (should (equal (version-to-list "1_0_1-a") '(1 0 1 1)))
+    (should (equal (version-to-list "1_0_1-f") '(1 0 1 6)))
+    (should (equal (version-to-list "1_0_1.a") '(1 0 1 1)))
+    (should (equal (version-to-list "1_0_1.f") '(1 0 1 6)))
+    (should (equal (version-to-list "1_0_1_a") '(1 0 1 1)))
+    (should (equal (version-to-list "1_0_1_f") '(1 0 1 6)))
+    (should (equal (version-to-list "1_0_1a") '(1 0 1 1)))
+    (should (equal (version-to-list "1_0_1f") '(1 0 1 6)))
+    (should (equal (version-to-list "1_0_7_5") '(1 0 7 5)))
+    (should (equal (version-to-list "1_0_git") '(1  0 -4)))
+    (should (equal (version-to-list "1_0pre2") '(1 0 -1 2)))
+    (should (equal (version-to-list "22_8 beta3") '(22 8 -2 3)))
+    (should (equal (version-to-list "22_8-beta3") '(22 8 -2 3)))
+    (should (equal (version-to-list "22_8.beta3") '(22 8 -2 3)))
+    (should (equal (version-to-list "22_8beta3") '(22 8 -2 3)))
+    (should (equal (version-to-list "6_9_30 Beta") '(6 9 30 -2)))
+    (should (equal (version-to-list "6_9_30-Beta") '(6 9 30 -2)))
+    (should (equal (version-to-list "6_9_30.Beta") '(6 9 30 -2)))
+    (should (equal (version-to-list "6_9_30Beta") '(6 9 30 -2)))
+    (should (equal (version-to-list "OTP 18_1_5") '(18 1 5)))
+    (should (equal (version-to-list "OTP-18_1_5") '(18 1 5)))
+    (should (equal (version-to-list "OTP.18_1_5") '(18 1 5)))
+    (should (equal (version-to-list "OTP18_1_5") '(18 1 5)))
+    (should (equal (version-to-list "alpha0_9") '(0 9 -3)))
+
+    (should (equal
+              (error-message-string (should-error (version-to-list 
"1_0__7_5")))
+              "Invalid version syntax: `1_0__7_5'"))
+    (should (equal
+              (error-message-string (should-error (version-to-list 
"1_0prepre2")))
+              "Invalid version syntax: `1_0prepre2'"))
+    (should (equal
+              (error-message-string (should-error (version-to-list "22.8X3")))
+              "Invalid version syntax: `22.8X3'"))
+    (should (equal
+              (error-message-string (should-error (version-to-list 
"beta22_8alpha")))
+              "Invalid version syntax: `beta22_8alpha'"))
+    (should (equal
+              (error-message-string (should-error (version-to-list 
"beta22_8alpha3")))
+              "Invalid version syntax: `beta22_8alpha3'"))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.6.3

2015-11-28  Alex Dunn  <dunn.alex@gmail.com>

        Improve version-to-list parsing

        * lisp/subr.el (version-regexp-alist): allow `.' as priority separator
        * lisp/subr.el (version-to-list): parse versions like OTP-18.1.5 
correctly
        * lisp/subr.el (version-to-list): allow prefixed priority separators
        * test/lisp/subr-tests.el (ert-test-version-parsing): parsing tests