diff options
| -rw-r--r-- | lisp/subr.el | 55 | ||||
| -rw-r--r-- | test/automated/subr-tests.el | 112 |
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 | ||
| 4699 | This association is used to handle version string like \"1.0pre2\", | 4699 | This 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 | ||
| 4743 | Examples of valid version syntax: | 4744 | Examples 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 | ||
| 4747 | Examples of invalid version syntax: | 4748 | Examples 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 | ||
| 4751 | Examples of version conversion: | 4752 | Examples 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 | ||
| 4765 | See documentation for `version-separator' and `version-regexp-alist'." | 4767 | See 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 |