aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/subr.el55
-rw-r--r--test/automated/subr-tests.el112
2 files changed, 143 insertions, 24 deletions
diff --git a/lisp/subr.el b/lisp/subr.el
index 420b212d545..860c14c446b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4686,14 +4686,14 @@ Usually the separator is \".\", but it can be any other string.")
4686 4686
4687 4687
4688(defconst version-regexp-alist 4688(defconst version-regexp-alist
4689 '(("^[-_+ ]?snapshot$" . -4) 4689 '(("^[-._+ ]?snapshot$" . -4)
4690 ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases 4690 ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases
4691 ("^[-_+]$" . -4) 4691 ("^[-._+]$" . -4)
4692 ;; treat "1.2.3-CVS" as snapshot release 4692 ;; treat "1.2.3-CVS" as snapshot release
4693 ("^[-_+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4) 4693 ("^[-._+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4)
4694 ("^[-_+ ]?alpha$" . -3) 4694 ("^[-._+ ]?alpha$" . -3)
4695 ("^[-_+ ]?beta$" . -2) 4695 ("^[-._+ ]?beta$" . -2)
4696 ("^[-_+ ]?\\(pre\\|rc\\)$" . -1)) 4696 ("^[-._+ ]?\\(pre\\|rc\\)$" . -1))
4697 "Specify association between non-numeric version and its priority. 4697 "Specify association between non-numeric version and its priority.
4698 4698
4699This association is used to handle version string like \"1.0pre2\", 4699This association is used to handle version string like \"1.0pre2\",
@@ -4703,6 +4703,7 @@ non-numeric part of a version string to an integer. For example:
4703 String Version Integer List Version 4703 String Version Integer List Version
4704 \"0.9snapshot\" (0 9 -4) 4704 \"0.9snapshot\" (0 9 -4)
4705 \"1.0-git\" (1 0 -4) 4705 \"1.0-git\" (1 0 -4)
4706 \"1.0.cvs\" (1 0 -4)
4706 \"1.0pre2\" (1 0 -1 2) 4707 \"1.0pre2\" (1 0 -1 2)
4707 \"1.0PRE2\" (1 0 -1 2) 4708 \"1.0PRE2\" (1 0 -1 2)
4708 \"22.8beta3\" (22 8 -2 3) 4709 \"22.8beta3\" (22 8 -2 3)
@@ -4742,41 +4743,47 @@ in `version-regexp-alist'.
4742 4743
4743Examples of valid version syntax: 4744Examples of valid version syntax:
4744 4745
4745 1.0pre2 1.0.7.5 22.8beta3 0.9alpha1 6.9.30Beta 4746 1.0pre2 1.0.7.5 22.8beta3 0.9alpha1 6.9.30Beta 2.4.snapshot .5
4746 4747
4747Examples of invalid version syntax: 4748Examples of invalid version syntax:
4748 4749
4749 1.0prepre2 1.0..7.5 22.8X3 alpha3.2 .5 4750 1.0prepre2 1.0..7.5 22.8X3 alpha3.2
4750 4751
4751Examples of version conversion: 4752Examples of version conversion:
4752 4753
4753 Version String Version as a List of Integers 4754 Version String Version as a List of Integers
4754 \"1.0.7.5\" (1 0 7 5) 4755 \".5\" (0 5)
4755 \"1.0pre2\" (1 0 -1 2) 4756 \"0.9 alpha\" (0 9 -3)
4756 \"1.0PRE2\" (1 0 -1 2)
4757 \"22.8beta3\" (22 8 -2 3)
4758 \"22.8Beta3\" (22 8 -2 3)
4759 \"0.9alpha1\" (0 9 -3 1)
4760 \"0.9AlphA1\" (0 9 -3 1) 4757 \"0.9AlphA1\" (0 9 -3 1)
4761 \"0.9alpha\" (0 9 -3)
4762 \"0.9snapshot\" (0 9 -4) 4758 \"0.9snapshot\" (0 9 -4)
4763 \"1.0-git\" (1 0 -4) 4759 \"1.0-git\" (1 0 -4)
4760 \"1.0.7.5\" (1 0 7 5)
4761 \"1.0.cvs\" (1 0 -4)
4762 \"1.0PRE2\" (1 0 -1 2)
4763 \"1.0pre2\" (1 0 -1 2)
4764 \"22.8 Beta3\" (22 8 -2 3)
4765 \"22.8beta3\" (22 8 -2 3)
4764 4766
4765See documentation for `version-separator' and `version-regexp-alist'." 4767See documentation for `version-separator' and `version-regexp-alist'."
4766 (or (and (stringp ver) (> (length ver) 0)) 4768 (unless (stringp ver)
4767 (error "Invalid version string: `%s'" ver)) 4769 (error "Version must be a string"))
4768 ;; Change .x.y to 0.x.y 4770 ;; Change .x.y to 0.x.y
4769 (if (and (>= (length ver) (length version-separator)) 4771 (if (and (>= (length ver) (length version-separator))
4770 (string-equal (substring ver 0 (length version-separator)) 4772 (string-equal (substring ver 0 (length version-separator))
4771 version-separator)) 4773 version-separator))
4772 (setq ver (concat "0" ver))) 4774 (setq ver (concat "0" ver)))
4775 (unless (string-match-p "^[0-9]" ver)
4776 (error "Invalid version syntax: `%s' (must start with a number)" ver))
4777
4773 (save-match-data 4778 (save-match-data
4774 (let ((i 0) 4779 (let ((i 0)
4775 (case-fold-search t) ; ignore case in matching 4780 (case-fold-search t) ; ignore case in matching
4776 lst s al) 4781 lst s al)
4782 ;; Parse the version-string up to a separator until there are none left
4777 (while (and (setq s (string-match "[0-9]+" ver i)) 4783 (while (and (setq s (string-match "[0-9]+" ver i))
4778 (= s i)) 4784 (= s i))
4779 ;; handle numeric part 4785 ;; Add the numeric part to the beginning of the version list;
4786 ;; lst gets reversed at the end
4780 (setq lst (cons (string-to-number (substring ver i (match-end 0))) 4787 (setq lst (cons (string-to-number (substring ver i (match-end 0)))
4781 lst) 4788 lst)
4782 i (match-end 0)) 4789 i (match-end 0))
@@ -4792,15 +4799,15 @@ See documentation for `version-separator' and `version-regexp-alist'."
4792 (setq al (cdr al))) 4799 (setq al (cdr al)))
4793 (cond (al 4800 (cond (al
4794 (push (cdar al) lst)) 4801 (push (cdar al) lst))
4795 ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc. 4802 ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc., but only if
4796 ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s) 4803 ;; the letter is the end of the version-string, to avoid
4804 ;; 22.8X3 being valid
4805 ((and (string-match "^[-._+ ]?\\([a-zA-Z]\\)$" s)
4806 (= i (length ver)))
4797 (push (- (aref (downcase (match-string 1 s)) 0) ?a -1) 4807 (push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
4798 lst)) 4808 lst))
4799 (t (error "Invalid version syntax: `%s'" ver)))))) 4809 (t (error "Invalid version syntax: `%s'" ver))))))
4800 (if (null lst) 4810 (nreverse lst))))
4801 (error "Invalid version syntax: `%s'" ver)
4802 (nreverse lst)))))
4803
4804 4811
4805(defun version-list-< (l1 l2) 4812(defun version-list-< (l1 l2)
4806 "Return t if L1, a list specification of a version, is lower than L2. 4813 "Return t if L1, a list specification of a version, is lower than L2.
diff --git a/test/automated/subr-tests.el b/test/automated/subr-tests.el
index ee8db593b49..3fcb7d346a3 100644
--- a/test/automated/subr-tests.el
+++ b/test/automated/subr-tests.el
@@ -103,5 +103,117 @@
103 (should (equal (macroexpand-all '(when a b c d)) 103 (should (equal (macroexpand-all '(when a b c d))
104 '(if a (progn b c d))))) 104 '(if a (progn b c d)))))
105 105
106(ert-deftest subr-test-version-parsing ()
107 (should (equal (version-to-list ".5") '(0 5)))
108 (should (equal (version-to-list "0.9 alpha1") '(0 9 -3 1)))
109 (should (equal (version-to-list "0.9 snapshot") '(0 9 -4)))
110 (should (equal (version-to-list "0.9-alpha1") '(0 9 -3 1)))
111 (should (equal (version-to-list "0.9-snapshot") '(0 9 -4)))
112 (should (equal (version-to-list "0.9.snapshot") '(0 9 -4)))
113 (should (equal (version-to-list "0.9_snapshot") '(0 9 -4)))
114 (should (equal (version-to-list "0.9alpha1") '(0 9 -3 1)))
115 (should (equal (version-to-list "0.9snapshot") '(0 9 -4)))
116 (should (equal (version-to-list "1.0 git") '(1 0 -4)))
117 (should (equal (version-to-list "1.0 pre2") '(1 0 -1 2)))
118 (should (equal (version-to-list "1.0-git") '(1 0 -4)))
119 (should (equal (version-to-list "1.0-pre2") '(1 0 -1 2)))
120 (should (equal (version-to-list "1.0.1-a") '(1 0 1 1)))
121 (should (equal (version-to-list "1.0.1-f") '(1 0 1 6)))
122 (should (equal (version-to-list "1.0.1.a") '(1 0 1 1)))
123 (should (equal (version-to-list "1.0.1.f") '(1 0 1 6)))
124 (should (equal (version-to-list "1.0.1_a") '(1 0 1 1)))
125 (should (equal (version-to-list "1.0.1_f") '(1 0 1 6)))
126 (should (equal (version-to-list "1.0.1a") '(1 0 1 1)))
127 (should (equal (version-to-list "1.0.1f") '(1 0 1 6)))
128 (should (equal (version-to-list "1.0.7.5") '(1 0 7 5)))
129 (should (equal (version-to-list "1.0.git") '(1 0 -4)))
130 (should (equal (version-to-list "1.0.pre2") '(1 0 -1 2)))
131 (should (equal (version-to-list "1.0_git") '(1 0 -4)))
132 (should (equal (version-to-list "1.0_pre2") '(1 0 -1 2)))
133 (should (equal (version-to-list "1.0git") '(1 0 -4)))
134 (should (equal (version-to-list "1.0pre2") '(1 0 -1 2)))
135 (should (equal (version-to-list "22.8 beta3") '(22 8 -2 3)))
136 (should (equal (version-to-list "22.8-beta3") '(22 8 -2 3)))
137 (should (equal (version-to-list "22.8.beta3") '(22 8 -2 3)))
138 (should (equal (version-to-list "22.8_beta3") '(22 8 -2 3)))
139 (should (equal (version-to-list "22.8beta3") '(22 8 -2 3)))
140 (should (equal (version-to-list "6.9.30 Beta") '(6 9 30 -2)))
141 (should (equal (version-to-list "6.9.30-Beta") '(6 9 30 -2)))
142 (should (equal (version-to-list "6.9.30.Beta") '(6 9 30 -2)))
143 (should (equal (version-to-list "6.9.30Beta") '(6 9 30 -2)))
144 (should (equal (version-to-list "6.9.30_Beta") '(6 9 30 -2)))
145
146 (should (equal
147 (error-message-string (should-error (version-to-list "OTP-18.1.5")))
148 "Invalid version syntax: `OTP-18.1.5' (must start with a number)"))
149 (should (equal
150 (error-message-string (should-error (version-to-list "")))
151 "Invalid version syntax: `' (must start with a number)"))
152 (should (equal
153 (error-message-string (should-error (version-to-list "1.0..7.5")))
154 "Invalid version syntax: `1.0..7.5'"))
155 (should (equal
156 (error-message-string (should-error (version-to-list "1.0prepre2")))
157 "Invalid version syntax: `1.0prepre2'"))
158 (should (equal
159 (error-message-string (should-error (version-to-list "22.8X3")))
160 "Invalid version syntax: `22.8X3'"))
161 (should (equal
162 (error-message-string (should-error (version-to-list "beta22.8alpha3")))
163 "Invalid version syntax: `beta22.8alpha3' (must start with a number)"))
164 (should (equal
165 (error-message-string (should-error (version-to-list "honk")))
166 "Invalid version syntax: `honk' (must start with a number)"))
167 (should (equal
168 (error-message-string (should-error (version-to-list 9)))
169 "Version must be a string"))
170
171 (let ((version-separator "_"))
172 (should (equal (version-to-list "_5") '(0 5)))
173 (should (equal (version-to-list "0_9 alpha1") '(0 9 -3 1)))
174 (should (equal (version-to-list "0_9 snapshot") '(0 9 -4)))
175 (should (equal (version-to-list "0_9-alpha1") '(0 9 -3 1)))
176 (should (equal (version-to-list "0_9-snapshot") '(0 9 -4)))
177 (should (equal (version-to-list "0_9.alpha1") '(0 9 -3 1)))
178 (should (equal (version-to-list "0_9.snapshot") '(0 9 -4)))
179 (should (equal (version-to-list "0_9alpha1") '(0 9 -3 1)))
180 (should (equal (version-to-list "0_9snapshot") '(0 9 -4)))
181 (should (equal (version-to-list "1_0 git") '(1 0 -4)))
182 (should (equal (version-to-list "1_0 pre2") '(1 0 -1 2)))
183 (should (equal (version-to-list "1_0-git") '(1 0 -4)))
184 (should (equal (version-to-list "1_0.pre2") '(1 0 -1 2)))
185 (should (equal (version-to-list "1_0_1-a") '(1 0 1 1)))
186 (should (equal (version-to-list "1_0_1-f") '(1 0 1 6)))
187 (should (equal (version-to-list "1_0_1.a") '(1 0 1 1)))
188 (should (equal (version-to-list "1_0_1.f") '(1 0 1 6)))
189 (should (equal (version-to-list "1_0_1_a") '(1 0 1 1)))
190 (should (equal (version-to-list "1_0_1_f") '(1 0 1 6)))
191 (should (equal (version-to-list "1_0_1a") '(1 0 1 1)))
192 (should (equal (version-to-list "1_0_1f") '(1 0 1 6)))
193 (should (equal (version-to-list "1_0_7_5") '(1 0 7 5)))
194 (should (equal (version-to-list "1_0_git") '(1 0 -4)))
195 (should (equal (version-to-list "1_0pre2") '(1 0 -1 2)))
196 (should (equal (version-to-list "22_8 beta3") '(22 8 -2 3)))
197 (should (equal (version-to-list "22_8-beta3") '(22 8 -2 3)))
198 (should (equal (version-to-list "22_8.beta3") '(22 8 -2 3)))
199 (should (equal (version-to-list "22_8beta3") '(22 8 -2 3)))
200 (should (equal (version-to-list "6_9_30 Beta") '(6 9 30 -2)))
201 (should (equal (version-to-list "6_9_30-Beta") '(6 9 30 -2)))
202 (should (equal (version-to-list "6_9_30.Beta") '(6 9 30 -2)))
203 (should (equal (version-to-list "6_9_30Beta") '(6 9 30 -2)))
204
205 (should (equal
206 (error-message-string (should-error (version-to-list "1_0__7_5")))
207 "Invalid version syntax: `1_0__7_5'"))
208 (should (equal
209 (error-message-string (should-error (version-to-list "1_0prepre2")))
210 "Invalid version syntax: `1_0prepre2'"))
211 (should (equal
212 (error-message-string (should-error (version-to-list "22.8X3")))
213 "Invalid version syntax: `22.8X3'"))
214 (should (equal
215 (error-message-string (should-error (version-to-list "beta22_8alpha3")))
216 "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
217
106(provide 'subr-tests) 218(provide 'subr-tests)
107;;; subr-tests.el ends here 219;;; subr-tests.el ends here