diff options
Diffstat (limited to 'test/lisp')
| -rw-r--r-- | test/lisp/abbrev-tests.el | 53 | ||||
| -rw-r--r-- | test/lisp/autorevert-tests.el | 4 | ||||
| -rw-r--r-- | test/lisp/calendar/icalendar-tests.el | 56 | ||||
| -rw-r--r-- | test/lisp/character-fold-tests.el | 72 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/package-tests.el | 14 | ||||
| -rw-r--r-- | test/lisp/faces-tests.el | 5 | ||||
| -rw-r--r-- | test/lisp/gnus/auth-source-tests.el | 45 | ||||
| -rw-r--r-- | test/lisp/gnus/message-tests.el | 6 | ||||
| -rw-r--r-- | test/lisp/help-fns-tests.el | 10 | ||||
| -rw-r--r-- | test/lisp/json-tests.el | 297 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 47 | ||||
| -rw-r--r-- | test/lisp/progmodes/elisp-mode-tests.el | 4 | ||||
| -rw-r--r-- | test/lisp/simple-tests.el | 89 | ||||
| -rw-r--r-- | test/lisp/subr-tests.el | 112 | ||||
| -rw-r--r-- | test/lisp/url/url-expand-tests.el | 105 |
15 files changed, 740 insertions, 179 deletions
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index 17aea5d0f82..37917ec5353 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el | |||
| @@ -22,10 +22,21 @@ | |||
| 22 | 22 | ||
| 23 | ;;; Commentary: | 23 | ;;; Commentary: |
| 24 | 24 | ||
| 25 | ;; `kill-all-abbrevs-test' will remove all user *and* system abbrevs | ||
| 26 | ;; if called noninteractively with the init file loaded. | ||
| 27 | |||
| 25 | ;;; Code: | 28 | ;;; Code: |
| 26 | 29 | ||
| 27 | (require 'ert) | 30 | (require 'ert) |
| 28 | (require 'abbrev) | 31 | (require 'abbrev) |
| 32 | (require 'seq) | ||
| 33 | |||
| 34 | ;; set up test abbrev table and abbrev entry | ||
| 35 | (defun setup-test-abbrev-table () | ||
| 36 | (defvar ert-test-abbrevs nil) | ||
| 37 | (define-abbrev-table 'ert-test-abbrevs '(("a-e-t" "abbrev-ert-test"))) | ||
| 38 | (abbrev-table-put ert-test-abbrevs :ert-test "ert-test-value") | ||
| 39 | ert-test-abbrevs) | ||
| 29 | 40 | ||
| 30 | (ert-deftest abbrev-table-p-test () | 41 | (ert-deftest abbrev-table-p-test () |
| 31 | (should-not (abbrev-table-p 42)) | 42 | (should-not (abbrev-table-p 42)) |
| @@ -70,5 +81,47 @@ | |||
| 70 | (should (abbrev-table-p new-foo-abbrev-table))) | 81 | (should (abbrev-table-p new-foo-abbrev-table))) |
| 71 | (should-not (string-equal (buffer-name) "*Backtrace*"))) | 82 | (should-not (string-equal (buffer-name) "*Backtrace*"))) |
| 72 | 83 | ||
| 84 | (ert-deftest kill-all-abbrevs-test () | ||
| 85 | "Test undefining all defined abbrevs" | ||
| 86 | (unless noninteractive | ||
| 87 | (ert-skip "Cannot test kill-all-abbrevs in interactive mode")) | ||
| 88 | |||
| 89 | (let ((num-tables 0)) | ||
| 90 | ;; ensure at least one abbrev exists | ||
| 91 | (should (abbrev-table-p (setup-test-abbrev-table))) | ||
| 92 | (setf num-tables (length abbrev-table-name-list)) | ||
| 93 | (kill-all-abbrevs) | ||
| 94 | |||
| 95 | ;; no tables should have been removed/added | ||
| 96 | (should (= num-tables (length abbrev-table-name-list))) | ||
| 97 | ;; number of empty tables should be the same as number of tables | ||
| 98 | (should (= num-tables (length (seq-filter | ||
| 99 | (lambda (table) | ||
| 100 | (abbrev-table-empty-p (symbol-value table))) | ||
| 101 | abbrev-table-name-list)))))) | ||
| 102 | |||
| 103 | (ert-deftest abbrev-table-name-test () | ||
| 104 | "Test returning name of abbrev-table" | ||
| 105 | (let ((ert-test-abbrevs (setup-test-abbrev-table)) | ||
| 106 | (no-such-table nil)) | ||
| 107 | (should (equal 'ert-test-abbrevs (abbrev-table-name ert-test-abbrevs))) | ||
| 108 | (should (equal nil (abbrev-table-name no-such-table))))) | ||
| 109 | |||
| 110 | (ert-deftest clear-abbrev-table-test () | ||
| 111 | "Test clearing single abbrev table" | ||
| 112 | (let ((ert-test-abbrevs (setup-test-abbrev-table))) | ||
| 113 | (should (equal "a-e-t" (symbol-name | ||
| 114 | (abbrev-symbol "a-e-t" ert-test-abbrevs)))) | ||
| 115 | (should (equal "abbrev-ert-test" (symbol-value | ||
| 116 | (abbrev-symbol "a-e-t" ert-test-abbrevs)))) | ||
| 117 | |||
| 118 | (clear-abbrev-table ert-test-abbrevs) | ||
| 119 | |||
| 120 | (should (equal "nil" (symbol-name | ||
| 121 | (abbrev-symbol "a-e-t" ert-test-abbrevs)))) | ||
| 122 | (should (equal nil (symbol-value | ||
| 123 | (abbrev-symbol "a-e-t" ert-test-abbrevs)))) | ||
| 124 | (should (equal t (abbrev-table-empty-p ert-test-abbrevs))))) | ||
| 125 | |||
| 73 | (provide 'abbrev-tests) | 126 | (provide 'abbrev-tests) |
| 74 | ;;; abbrev-tests.el ends here | 127 | ;;; abbrev-tests.el ends here |
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 6f186973ee7..043f80de49e 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el | |||
| @@ -39,7 +39,9 @@ | |||
| 39 | (null (string-match | 39 | (null (string-match |
| 40 | (format-message "Reverting buffer `%s'." (buffer-name buffer)) | 40 | (format-message "Reverting buffer `%s'." (buffer-name buffer)) |
| 41 | (buffer-string))) | 41 | (buffer-string))) |
| 42 | (read-event nil nil 0.1))))) | 42 | (if (with-current-buffer buffer auto-revert-use-notify) |
| 43 | (read-event nil nil 0.1) | ||
| 44 | (sleep-for 0.1)))))) | ||
| 43 | 45 | ||
| 44 | (ert-deftest auto-revert-test00-auto-revert-mode () | 46 | (ert-deftest auto-revert-test00-auto-revert-mode () |
| 45 | "Check autorevert for a file." | 47 | "Check autorevert for a file." |
diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 7e05d49883e..829cbf2d765 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el | |||
| @@ -2231,7 +2231,63 @@ END:VCALENDAR" | |||
| 2231 | Class: PUBLIC | 2231 | Class: PUBLIC |
| 2232 | UID: 040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000010000000575268034ECDB649A15349B1BF240F15 | 2232 | UID: 040000008200E00074C5B7101A82E0080000000020FFAED0CFEFCC01000000000000000010000000575268034ECDB649A15349B1BF240F15 |
| 2233 | " nil) | 2233 | " nil) |
| 2234 | |||
| 2235 | ;; 2015-12-05, mixed line endings and empty lines, see Bug#22092. | ||
| 2236 | (icalendar-tests--test-import | ||
| 2237 | "BEGIN:VCALENDAR\r | ||
| 2238 | PRODID:-//www.norwegian.no//iCalendar MIMEDIR//EN\r | ||
| 2239 | VERSION:2.0\r | ||
| 2240 | METHOD:REQUEST\r | ||
| 2241 | BEGIN:VEVENT\r | ||
| 2242 | UID:RFCALITEM1\r | ||
| 2243 | SEQUENCE:1512040950\r | ||
| 2244 | DTSTAMP:20141204T095043Z\r | ||
| 2245 | ORGANIZER:noreply@norwegian.no\r | ||
| 2246 | DTSTART:20141208T173000Z\r | ||
| 2247 | |||
| 2248 | DTEND:20141208T215500Z\r | ||
| 2249 | |||
| 2250 | LOCATION:Stavanger-Sola\r | ||
| 2251 | |||
| 2252 | DESCRIPTION:Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390\r | ||
| 2253 | |||
| 2254 | X-ALT-DESC;FMTTYPE=text/html:<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2//EN\"><html><head><META NAME=\"Generator\" CONTENT=\"MS Exchange Server version 08.00.0681.000\"><title></title></head><body><b><font face=\"Calibri\" size=\"3\">Reisereferanse</p></body></html> | ||
| 2255 | SUMMARY:Norwegian til Tromsoe-Langnes -\r | ||
| 2256 | |||
| 2257 | CATEGORIES:Appointment\r | ||
| 2258 | |||
| 2259 | |||
| 2260 | PRIORITY:5\r | ||
| 2261 | |||
| 2262 | CLASS:PUBLIC\r | ||
| 2263 | |||
| 2264 | TRANSP:OPAQUE\r | ||
| 2265 | END:VEVENT\r | ||
| 2266 | END:VCALENDAR | ||
| 2267 | " | ||
| 2268 | "&2014/12/8 18:30-22:55 Norwegian til Tromsoe-Langnes - | ||
| 2269 | Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390 | ||
| 2270 | Location: Stavanger-Sola | ||
| 2271 | Organizer: noreply@norwegian.no | ||
| 2272 | Class: PUBLIC | ||
| 2273 | UID: RFCALITEM1 | ||
| 2274 | " | ||
| 2275 | "&8/12/2014 18:30-22:55 Norwegian til Tromsoe-Langnes - | ||
| 2276 | Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390 | ||
| 2277 | Location: Stavanger-Sola | ||
| 2278 | Organizer: noreply@norwegian.no | ||
| 2279 | Class: PUBLIC | ||
| 2280 | UID: RFCALITEM1 | ||
| 2281 | " | ||
| 2282 | "&12/8/2014 18:30-22:55 Norwegian til Tromsoe-Langnes - | ||
| 2283 | Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Tromsø 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Tromsø 8. des 2014 21:00, DY390 | ||
| 2284 | Location: Stavanger-Sola | ||
| 2285 | Organizer: noreply@norwegian.no | ||
| 2286 | Class: PUBLIC | ||
| 2287 | UID: RFCALITEM1 | ||
| 2288 | " | ||
| 2234 | ) | 2289 | ) |
| 2290 | ) | ||
| 2235 | 2291 | ||
| 2236 | (provide 'icalendar-tests) | 2292 | (provide 'icalendar-tests) |
| 2237 | ;;; icalendar-tests.el ends here | 2293 | ;;; icalendar-tests.el ends here |
diff --git a/test/lisp/character-fold-tests.el b/test/lisp/character-fold-tests.el index 2b1a15c9e76..c0568625649 100644 --- a/test/lisp/character-fold-tests.el +++ b/test/lisp/character-fold-tests.el | |||
| @@ -37,13 +37,13 @@ | |||
| 37 | 37 | ||
| 38 | 38 | ||
| 39 | (ert-deftest character-fold--test-consistency () | 39 | (ert-deftest character-fold--test-consistency () |
| 40 | (dotimes (n 100) | 40 | (dotimes (n 30) |
| 41 | (let ((w (character-fold--random-word n))) | 41 | (let ((w (character-fold--random-word n))) |
| 42 | ;; A folded string should always match the original string. | 42 | ;; A folded string should always match the original string. |
| 43 | (character-fold--test-search-with-contents w w)))) | 43 | (character-fold--test-search-with-contents w w)))) |
| 44 | 44 | ||
| 45 | (ert-deftest character-fold--test-lax-whitespace () | 45 | (ert-deftest character-fold--test-lax-whitespace () |
| 46 | (dotimes (n 100) | 46 | (dotimes (n 40) |
| 47 | (let ((w1 (character-fold--random-word n)) | 47 | (let ((w1 (character-fold--random-word n)) |
| 48 | (w2 (character-fold--random-word n)) | 48 | (w2 (character-fold--random-word n)) |
| 49 | (search-spaces-regexp "\\s-+")) | 49 | (search-spaces-regexp "\\s-+")) |
| @@ -52,7 +52,73 @@ | |||
| 52 | (concat w1 " " w2)) | 52 | (concat w1 " " w2)) |
| 53 | (character-fold--test-search-with-contents | 53 | (character-fold--test-search-with-contents |
| 54 | (concat w1 "\s\n\s\t\f\t\n\r\t" w2) | 54 | (concat w1 "\s\n\s\t\f\t\n\r\t" w2) |
| 55 | (concat w1 (make-string 90 ?\s) w2))))) | 55 | (concat w1 (make-string 10 ?\s) w2))))) |
| 56 | |||
| 57 | (defun character-fold--test-match-exactly (string &rest strings-to-match) | ||
| 58 | (let ((re (concat "\\`" (character-fold-to-regexp string) "\\'"))) | ||
| 59 | (dolist (it strings-to-match) | ||
| 60 | (should (string-match re it))) | ||
| 61 | ;; Case folding | ||
| 62 | (let ((case-fold-search t)) | ||
| 63 | (dolist (it strings-to-match) | ||
| 64 | (should (string-match (upcase re) (downcase it))) | ||
| 65 | (should (string-match (downcase re) (upcase it))))))) | ||
| 66 | |||
| 67 | (ert-deftest character-fold--test-some-defaults () | ||
| 68 | (dolist (it '(("ffl" . "ffl") ("ffi" . "ffi") | ||
| 69 | ("fi" . "fi") ("ff" . "ff") | ||
| 70 | ("ä" . "ä"))) | ||
| 71 | (character-fold--test-search-with-contents (cdr it) (car it)) | ||
| 72 | (let ((multi (char-table-extra-slot character-fold-table 0)) | ||
| 73 | (character-fold-table (make-char-table 'character-fold-table))) | ||
| 74 | (set-char-table-extra-slot character-fold-table 0 multi) | ||
| 75 | (character-fold--test-match-exactly (car it) (cdr it))))) | ||
| 76 | |||
| 77 | (ert-deftest character-fold--test-fold-to-regexp () | ||
| 78 | (let ((character-fold-table (make-char-table 'character-fold-table)) | ||
| 79 | (multi (make-char-table 'character-fold-table))) | ||
| 80 | (set-char-table-extra-slot character-fold-table 0 multi) | ||
| 81 | (aset character-fold-table ?a "xx") | ||
| 82 | (aset character-fold-table ?1 "44") | ||
| 83 | (aset character-fold-table ?\s "-!-") | ||
| 84 | (character-fold--test-match-exactly "a1a1" "xx44xx44") | ||
| 85 | (character-fold--test-match-exactly "a1 a 1" "xx44-!--!-xx-!-44") | ||
| 86 | (aset multi ?a '(("1" . "99") | ||
| 87 | ("2" . "88") | ||
| 88 | ("12" . "77"))) | ||
| 89 | (character-fold--test-match-exactly "a" "xx") | ||
| 90 | (character-fold--test-match-exactly "a1" "xx44" "99") | ||
| 91 | (character-fold--test-match-exactly "a12" "77" "xx442" "992") | ||
| 92 | (character-fold--test-match-exactly "a2" "88") | ||
| 93 | (aset multi ?1 '(("2" . "yy"))) | ||
| 94 | (character-fold--test-match-exactly "a1" "xx44" "99") | ||
| 95 | (character-fold--test-match-exactly "a12" "77" "xx442" "992") | ||
| 96 | ;; Support for this case is disabled. See function definition or: | ||
| 97 | ;; https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02562.html | ||
| 98 | ;; (character-fold--test-match-exactly "a12" "xxyy") | ||
| 99 | )) | ||
| 100 | |||
| 101 | (ert-deftest character-fold--speed-test () | ||
| 102 | (dolist (string (append '("tty-set-up-initial-frame-face" | ||
| 103 | "tty-set-up-initial-frame-face-frame-faceframe-faceframe-faceframe-face") | ||
| 104 | (mapcar #'character-fold--random-word '(10 50 100 | ||
| 105 | 50 100)))) | ||
| 106 | (message "Testing %s" string) | ||
| 107 | ;; Make sure we didn't just fallback on the trivial search. | ||
| 108 | (should-not (string= (regexp-quote string) | ||
| 109 | (character-fold-to-regexp string))) | ||
| 110 | (with-temp-buffer | ||
| 111 | (save-excursion (insert string)) | ||
| 112 | (let ((time (time-to-seconds (current-time)))) | ||
| 113 | ;; Our initial implementation of case-folding in char-folding | ||
| 114 | ;; created a lot of redundant paths in the regexp. Because of | ||
| 115 | ;; that, if a really long string "almost" matches, the regexp | ||
| 116 | ;; engine took a long time to realize that it doesn't match. | ||
| 117 | (should-not (character-fold-search-forward (concat string "c") nil 'noerror)) | ||
| 118 | ;; Ensure it took less than a second. | ||
| 119 | (should (< (- (time-to-seconds (current-time)) | ||
| 120 | time) | ||
| 121 | 1)))))) | ||
| 56 | 122 | ||
| 57 | (provide 'character-fold-tests) | 123 | (provide 'character-fold-tests) |
| 58 | ;;; character-fold-tests.el ends here | 124 | ;;; character-fold-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 6b3069c2a54..7206084f324 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el | |||
| @@ -242,6 +242,20 @@ Must called from within a `tar-mode' buffer." | |||
| 242 | (should (package-installed-p 'simple-single)) | 242 | (should (package-installed-p 'simple-single)) |
| 243 | (should (package-installed-p 'simple-depend)))) | 243 | (should (package-installed-p 'simple-depend)))) |
| 244 | 244 | ||
| 245 | (ert-deftest package-test-macro-compilation () | ||
| 246 | "Install a package which includes a dependency." | ||
| 247 | (with-package-test (:basedir "data/package") | ||
| 248 | (package-install-file (expand-file-name "macro-problem-package-1.0/")) | ||
| 249 | (require 'macro-problem) | ||
| 250 | ;; `macro-problem-func' uses a macro from `macro-aux'. | ||
| 251 | (should (equal (macro-problem-func) '(progn a b))) | ||
| 252 | (package-install-file (expand-file-name "macro-problem-package-2.0/")) | ||
| 253 | ;; After upgrading, `macro-problem-func' depends on a new version | ||
| 254 | ;; of the macro from `macro-aux'. | ||
| 255 | (should (equal (macro-problem-func) '(1 b))) | ||
| 256 | ;; `macro-problem-10-and-90' depends on an entirely new macro from `macro-aux'. | ||
| 257 | (should (equal (macro-problem-10-and-90) '(10 90))))) | ||
| 258 | |||
| 245 | (ert-deftest package-test-install-two-dependencies () | 259 | (ert-deftest package-test-install-two-dependencies () |
| 246 | "Install a package which includes a dependency." | 260 | "Install a package which includes a dependency." |
| 247 | (with-package-test () | 261 | (with-package-test () |
diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el index 007bc805120..ff9dfc53fbe 100644 --- a/test/lisp/faces-tests.el +++ b/test/lisp/faces-tests.el | |||
| @@ -38,6 +38,11 @@ | |||
| 38 | (should (equal (background-color-at-point) "black")) | 38 | (should (equal (background-color-at-point) "black")) |
| 39 | (should (equal (foreground-color-at-point) "black"))) | 39 | (should (equal (foreground-color-at-point) "black"))) |
| 40 | (with-temp-buffer | 40 | (with-temp-buffer |
| 41 | (insert (propertize "STRING" 'face '(:foreground "black" :background "black"))) | ||
| 42 | (goto-char (point-min)) | ||
| 43 | (should (equal (background-color-at-point) "black")) | ||
| 44 | (should (equal (foreground-color-at-point) "black"))) | ||
| 45 | (with-temp-buffer | ||
| 41 | (emacs-lisp-mode) | 46 | (emacs-lisp-mode) |
| 42 | (setq-local font-lock-comment-face 'faces--test1) | 47 | (setq-local font-lock-comment-face 'faces--test1) |
| 43 | (setq-local font-lock-constant-face 'faces--test2) | 48 | (setq-local font-lock-constant-face 'faces--test2) |
diff --git a/test/lisp/gnus/auth-source-tests.el b/test/lisp/gnus/auth-source-tests.el index 0b49b9013f7..dd70d546d5c 100644 --- a/test/lisp/gnus/auth-source-tests.el +++ b/test/lisp/gnus/auth-source-tests.el | |||
| @@ -174,5 +174,50 @@ | |||
| 174 | (:search-function . auth-source-secrets-search) | 174 | (:search-function . auth-source-secrets-search) |
| 175 | (:create-function . auth-source-secrets-create))))) | 175 | (:create-function . auth-source-secrets-create))))) |
| 176 | 176 | ||
| 177 | (defun auth-source--test-netrc-parse-entry (entry host user port) | ||
| 178 | "Parse a netrc entry from buffer." | ||
| 179 | (auth-source-forget-all-cached) | ||
| 180 | (setq port (auth-source-ensure-strings port)) | ||
| 181 | (with-temp-buffer | ||
| 182 | (insert entry) | ||
| 183 | (goto-char (point-min)) | ||
| 184 | (let* ((check (lambda(alist) | ||
| 185 | (and alist | ||
| 186 | (auth-source-search-collection | ||
| 187 | host | ||
| 188 | (or | ||
| 189 | (auth-source--aget alist "machine") | ||
| 190 | (auth-source--aget alist "host") | ||
| 191 | t)) | ||
| 192 | (auth-source-search-collection | ||
| 193 | user | ||
| 194 | (or | ||
| 195 | (auth-source--aget alist "login") | ||
| 196 | (auth-source--aget alist "account") | ||
| 197 | (auth-source--aget alist "user") | ||
| 198 | t)) | ||
| 199 | (auth-source-search-collection | ||
| 200 | port | ||
| 201 | (or | ||
| 202 | (auth-source--aget alist "port") | ||
| 203 | (auth-source--aget alist "protocol") | ||
| 204 | t))))) | ||
| 205 | (entries (auth-source-netrc-parse-entries check 1))) | ||
| 206 | entries))) | ||
| 207 | |||
| 208 | (ert-deftest auth-source-test-netrc-parse-entry () | ||
| 209 | (should (equal (auth-source--test-netrc-parse-entry | ||
| 210 | "machine mymachine1 login user1 password pass1\n" t t t) | ||
| 211 | '((("password" . "pass1") | ||
| 212 | ("login" . "user1") | ||
| 213 | ("machine" . "mymachine1"))))) | ||
| 214 | (should (equal (auth-source--test-netrc-parse-entry | ||
| 215 | "machine mymachine1 login user1 password pass1 port 100\n" | ||
| 216 | t t t) | ||
| 217 | '((("port" . "100") | ||
| 218 | ("password" . "pass1") | ||
| 219 | ("login" . "user1") | ||
| 220 | ("machine" . "mymachine1")))))) | ||
| 221 | |||
| 177 | (provide 'auth-source-tests) | 222 | (provide 'auth-source-tests) |
| 178 | ;;; auth-source-tests.el ends here | 223 | ;;; auth-source-tests.el ends here |
diff --git a/test/lisp/gnus/message-tests.el b/test/lisp/gnus/message-tests.el index 49a72b0e67a..790b5c15125 100644 --- a/test/lisp/gnus/message-tests.el +++ b/test/lisp/gnus/message-tests.el | |||
| @@ -40,9 +40,9 @@ | |||
| 40 | "and here's a closer ") | 40 | "and here's a closer ") |
| 41 | (let ((last-command-event ?\))) | 41 | (let ((last-command-event ?\))) |
| 42 | (ert-simulate-command '(self-insert-command 1))) | 42 | (ert-simulate-command '(self-insert-command 1))) |
| 43 | ;; Syntax propertization doesn't kick in batch mode | 43 | ;; Auto syntax propertization doesn't kick in until |
| 44 | (when noninteractive | 44 | ;; parse-sexp-lookup-properties is set. |
| 45 | (syntax-propertize (point-max))) | 45 | (setq-local parse-sexp-lookup-properties t) |
| 46 | (backward-sexp) | 46 | (backward-sexp) |
| 47 | (should (string= "here's an opener " | 47 | (should (string= "here's an opener " |
| 48 | (buffer-substring-no-properties | 48 | (buffer-substring-no-properties |
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index b8772eb84d6..79e90f7819c 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el | |||
| @@ -57,4 +57,14 @@ | |||
| 57 | (should (search-forward | 57 | (should (search-forward |
| 58 | "(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)")))) | 58 | "(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)")))) |
| 59 | 59 | ||
| 60 | (ert-deftest help-fns-test-describe-symbol () | ||
| 61 | "Test the `describe-symbol' function." | ||
| 62 | ;; 'describe-symbol' would originally signal an error for | ||
| 63 | ;; 'font-lock-comment-face'. | ||
| 64 | (describe-symbol 'font-lock-comment-face) | ||
| 65 | (with-current-buffer "*Help*" | ||
| 66 | (should (> (point-max) 1)) | ||
| 67 | (goto-char (point-min)) | ||
| 68 | (should (looking-at "^font-lock-comment-face is ")))) | ||
| 69 | |||
| 60 | ;;; help-fns.el ends here | 70 | ;;; help-fns.el ends here |
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index 8f0cd6f0857..bb043dc4e05 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el | |||
| @@ -22,6 +22,38 @@ | |||
| 22 | (require 'ert) | 22 | (require 'ert) |
| 23 | (require 'json) | 23 | (require 'json) |
| 24 | 24 | ||
| 25 | (defmacro json-tests--with-temp-buffer (content &rest body) | ||
| 26 | "Create a temporary buffer with CONTENT and evaluate BODY there. | ||
| 27 | Point is moved to beginning of the buffer." | ||
| 28 | (declare (indent 1)) | ||
| 29 | `(with-temp-buffer | ||
| 30 | (insert ,content) | ||
| 31 | (goto-char (point-min)) | ||
| 32 | ,@body)) | ||
| 33 | |||
| 34 | ;;; Utilities | ||
| 35 | |||
| 36 | (ert-deftest test-json-join () | ||
| 37 | (should (equal (json-join '() ", ") "")) | ||
| 38 | (should (equal (json-join '("a" "b" "c") ", ") "a, b, c"))) | ||
| 39 | |||
| 40 | (ert-deftest test-json-alist-p () | ||
| 41 | (should (json-alist-p '())) | ||
| 42 | (should (json-alist-p '((a 1) (b 2) (c 3)))) | ||
| 43 | (should (json-alist-p '((:a 1) (:b 2) (:c 3)))) | ||
| 44 | (should (json-alist-p '(("a" 1) ("b" 2) ("c" 3)))) | ||
| 45 | (should-not (json-alist-p '(:a :b :c))) | ||
| 46 | (should-not (json-alist-p '(:a 1 :b 2 :c 3))) | ||
| 47 | (should-not (json-alist-p '((:a 1) (:b 2) 3)))) | ||
| 48 | |||
| 49 | (ert-deftest test-json-plist-p () | ||
| 50 | (should (json-plist-p '())) | ||
| 51 | (should (json-plist-p '(:a 1 :b 2 :c 3))) | ||
| 52 | (should-not (json-plist-p '(a 1 b 2 c 3))) | ||
| 53 | (should-not (json-plist-p '("a" 1 "b" 2 "c" 3))) | ||
| 54 | (should-not (json-plist-p '(:a :b :c))) | ||
| 55 | (should-not (json-plist-p '((:a 1) (:b 2) (:c 3))))) | ||
| 56 | |||
| 25 | (ert-deftest test-json-plist-reverse () | 57 | (ert-deftest test-json-plist-reverse () |
| 26 | (should (equal (json--plist-reverse '()) '())) | 58 | (should (equal (json--plist-reverse '()) '())) |
| 27 | (should (equal (json--plist-reverse '(:a 1)) '(:a 1))) | 59 | (should (equal (json--plist-reverse '(:a 1)) '(:a 1))) |
| @@ -34,49 +66,32 @@ | |||
| 34 | (should (equal (json--plist-to-alist '(:a 1 :b 2 :c 3)) | 66 | (should (equal (json--plist-to-alist '(:a 1 :b 2 :c 3)) |
| 35 | '((:a . 1) (:b . 2) (:c . 3))))) | 67 | '((:a . 1) (:b . 2) (:c . 3))))) |
| 36 | 68 | ||
| 37 | (ert-deftest test-json-encode-plist () | 69 | (ert-deftest test-json-advance () |
| 38 | (let ((plist '(:a 1 :b 2))) | 70 | (json-tests--with-temp-buffer "{ \"a\": 1 }" |
| 39 | (should (equal (json-encode plist) "{\"a\":1,\"b\":2}")))) | 71 | (json-advance 0) |
| 40 | 72 | (should (= (point) (point-min))) | |
| 41 | (ert-deftest json-encode-simple-alist () | 73 | (json-advance 3) |
| 42 | (should (equal (json-encode '((a . 1) | 74 | (should (= (point) (+ (point-min) 3))))) |
| 43 | (b . 2))) | ||
| 44 | "{\"a\":1,\"b\":2}"))) | ||
| 45 | |||
| 46 | (ert-deftest test-json-encode-hash-table () | ||
| 47 | (let ((hash-table (make-hash-table)) | ||
| 48 | (json-encoding-object-sort-predicate 'string<)) | ||
| 49 | (puthash :a 1 hash-table) | ||
| 50 | (puthash :b 2 hash-table) | ||
| 51 | (puthash :c 3 hash-table) | ||
| 52 | (should (equal (json-encode hash-table) | ||
| 53 | "{\"a\":1,\"b\":2,\"c\":3}")))) | ||
| 54 | |||
| 55 | (ert-deftest test-json-encode-alist-with-sort-predicate () | ||
| 56 | (let ((alist '((:c . 3) (:a . 1) (:b . 2))) | ||
| 57 | (json-encoding-object-sort-predicate 'string<)) | ||
| 58 | (should (equal (json-encode alist) "{\"a\":1,\"b\":2,\"c\":3}")))) | ||
| 59 | 75 | ||
| 60 | (ert-deftest test-json-encode-plist-with-sort-predicate () | 76 | (ert-deftest test-json-peek () |
| 61 | (let ((plist '(:c 3 :a 1 :b 2)) | 77 | (json-tests--with-temp-buffer "" |
| 62 | (json-encoding-object-sort-predicate 'string<)) | 78 | (should (eq (json-peek) :json-eof))) |
| 63 | (should (equal (json-encode plist) "{\"a\":1,\"b\":2,\"c\":3}")))) | 79 | (json-tests--with-temp-buffer "{ \"a\": 1 }" |
| 80 | (should (equal (json-peek) ?{)))) | ||
| 64 | 81 | ||
| 65 | (ert-deftest json-read-simple-alist () | 82 | (ert-deftest test-json-pop () |
| 66 | (let ((json-object-type 'alist)) | 83 | (json-tests--with-temp-buffer "" |
| 67 | (should (equal (json-read-from-string "{\"a\": 1, \"b\": 2}") | 84 | (should-error (json-pop) :type 'json-end-of-file)) |
| 68 | '((a . 1) | 85 | (json-tests--with-temp-buffer "{ \"a\": 1 }" |
| 69 | (b . 2)))))) | 86 | (should (equal (json-pop) ?{)) |
| 87 | (should (= (point) (+ (point-min) 1))))) | ||
| 70 | 88 | ||
| 71 | (ert-deftest json-encode-string-with-special-chars () | 89 | (ert-deftest test-json-skip-whitespace () |
| 72 | (should (equal (json-encode-string "a\n\fb") | 90 | (json-tests--with-temp-buffer "\t\r\n\f\b { \"a\": 1 }" |
| 73 | "\"a\\n\\fb\"")) | 91 | (json-skip-whitespace) |
| 74 | (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t") | 92 | (should (equal (char-after (point)) ?{)))) |
| 75 | "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) | ||
| 76 | 93 | ||
| 77 | (ert-deftest json-read-string-with-special-chars () | 94 | ;;; Paths |
| 78 | (should (equal (json-read-from-string "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"") | ||
| 79 | "\nasdфывfgh\t"))) | ||
| 80 | 95 | ||
| 81 | (ert-deftest test-json-path-to-position-with-objects () | 96 | (ert-deftest test-json-path-to-position-with-objects () |
| 82 | (let* ((json-string "{\"foo\": {\"bar\": {\"baz\": \"value\"}}}") | 97 | (let* ((json-string "{\"foo\": {\"bar\": {\"baz\": \"value\"}}}") |
| @@ -97,5 +112,209 @@ | |||
| 97 | (matched-path (json-path-to-position 5 json-string))) | 112 | (matched-path (json-path-to-position 5 json-string))) |
| 98 | (should (null matched-path)))) | 113 | (should (null matched-path)))) |
| 99 | 114 | ||
| 115 | ;;; Keywords | ||
| 116 | |||
| 117 | (ert-deftest test-json-read-keyword () | ||
| 118 | (json-tests--with-temp-buffer "true" | ||
| 119 | (should (json-read-keyword "true"))) | ||
| 120 | (json-tests--with-temp-buffer "true" | ||
| 121 | (should-error | ||
| 122 | (json-read-keyword "false") :type 'json-unknown-keyword)) | ||
| 123 | (json-tests--with-temp-buffer "foo" | ||
| 124 | (should-error | ||
| 125 | (json-read-keyword "foo") :type 'json-unknown-keyword))) | ||
| 126 | |||
| 127 | (ert-deftest test-json-encode-keyword () | ||
| 128 | (should (equal (json-encode-keyword t) "true")) | ||
| 129 | (should (equal (json-encode-keyword json-false) "false")) | ||
| 130 | (should (equal (json-encode-keyword json-null) "null"))) | ||
| 131 | |||
| 132 | ;;; Numbers | ||
| 133 | |||
| 134 | (ert-deftest test-json-read-number () | ||
| 135 | (json-tests--with-temp-buffer "3" | ||
| 136 | (should (= (json-read-number) 3))) | ||
| 137 | (json-tests--with-temp-buffer "-5" | ||
| 138 | (should (= (json-read-number) -5))) | ||
| 139 | (json-tests--with-temp-buffer "123.456" | ||
| 140 | (should (= (json-read-number) 123.456))) | ||
| 141 | (json-tests--with-temp-buffer "1e3" | ||
| 142 | (should (= (json-read-number) 1e3))) | ||
| 143 | (json-tests--with-temp-buffer "2e+3" | ||
| 144 | (should (= (json-read-number) 2e3))) | ||
| 145 | (json-tests--with-temp-buffer "3E3" | ||
| 146 | (should (= (json-read-number) 3e3))) | ||
| 147 | (json-tests--with-temp-buffer "1e-7" | ||
| 148 | (should (= (json-read-number) 1e-7))) | ||
| 149 | (json-tests--with-temp-buffer "abc" | ||
| 150 | (should-error (json-read-number) :type 'json-number-format))) | ||
| 151 | |||
| 152 | (ert-deftest test-json-encode-number () | ||
| 153 | (should (equal (json-encode-number 3) "3")) | ||
| 154 | (should (equal (json-encode-number -5) "-5")) | ||
| 155 | (should (equal (json-encode-number 123.456) "123.456"))) | ||
| 156 | |||
| 157 | ;; Strings | ||
| 158 | |||
| 159 | (ert-deftest test-json-read-escaped-char () | ||
| 160 | (json-tests--with-temp-buffer "\\\"" | ||
| 161 | (should (equal (json-read-escaped-char) ?\")))) | ||
| 162 | |||
| 163 | (ert-deftest test-json-read-string () | ||
| 164 | (json-tests--with-temp-buffer "\"foo \\\"bar\\\"\"" | ||
| 165 | (should (equal (json-read-string) "foo \"bar\""))) | ||
| 166 | (json-tests--with-temp-buffer "\"abcαβγ\"" | ||
| 167 | (should (equal (json-read-string) "abcαβγ"))) | ||
| 168 | (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"" | ||
| 169 | (should (equal (json-read-string) "\nasdфывfgh\t"))) | ||
| 170 | (json-tests--with-temp-buffer "foo" | ||
| 171 | (should-error (json-read-string) :type 'json-string-format))) | ||
| 172 | |||
| 173 | (ert-deftest test-json-encode-string () | ||
| 174 | (should (equal (json-encode-string "foo") "\"foo\"")) | ||
| 175 | (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\"")) | ||
| 176 | (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t") | ||
| 177 | "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) | ||
| 178 | |||
| 179 | (ert-deftest test-json-encode-key () | ||
| 180 | (should (equal (json-encode-key "foo") "\"foo\"")) | ||
| 181 | (should (equal (json-encode-key 'foo) "\"foo\"")) | ||
| 182 | (should (equal (json-encode-key :foo) "\"foo\"")) | ||
| 183 | (should-error (json-encode-key 5) :type 'json-key-format) | ||
| 184 | (should-error (json-encode-key ["foo"]) :type 'json-key-format) | ||
| 185 | (should-error (json-encode-key '("foo")) :type 'json-key-format)) | ||
| 186 | |||
| 187 | ;;; Objects | ||
| 188 | |||
| 189 | (ert-deftest test-json-new-object () | ||
| 190 | (let ((json-object-type 'alist)) | ||
| 191 | (should (equal (json-new-object) '()))) | ||
| 192 | (let ((json-object-type 'plist)) | ||
| 193 | (should (equal (json-new-object) '()))) | ||
| 194 | (let* ((json-object-type 'hash-table) | ||
| 195 | (json-object (json-new-object))) | ||
| 196 | (should (hash-table-p json-object)) | ||
| 197 | (should (= (hash-table-count json-object) 0)))) | ||
| 198 | |||
| 199 | (ert-deftest test-json-add-to-object () | ||
| 200 | (let* ((json-object-type 'alist) | ||
| 201 | (json-key-type nil) | ||
| 202 | (obj (json-new-object))) | ||
| 203 | (setq obj (json-add-to-object obj "a" 1)) | ||
| 204 | (setq obj (json-add-to-object obj "b" 2)) | ||
| 205 | (should (equal (assq 'a obj) '(a . 1))) | ||
| 206 | (should (equal (assq 'b obj) '(b . 2)))) | ||
| 207 | (let* ((json-object-type 'plist) | ||
| 208 | (json-key-type nil) | ||
| 209 | (obj (json-new-object))) | ||
| 210 | (setq obj (json-add-to-object obj "a" 1)) | ||
| 211 | (setq obj (json-add-to-object obj "b" 2)) | ||
| 212 | (should (= (plist-get obj :a) 1)) | ||
| 213 | (should (= (plist-get obj :b) 2))) | ||
| 214 | (let* ((json-object-type 'hash-table) | ||
| 215 | (json-key-type nil) | ||
| 216 | (obj (json-new-object))) | ||
| 217 | (setq obj (json-add-to-object obj "a" 1)) | ||
| 218 | (setq obj (json-add-to-object obj "b" 2)) | ||
| 219 | (should (= (gethash "a" obj) 1)) | ||
| 220 | (should (= (gethash "b" obj) 2)))) | ||
| 221 | |||
| 222 | (ert-deftest test-json-read-object () | ||
| 223 | (json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }" | ||
| 224 | (let ((json-object-type 'alist)) | ||
| 225 | (should (equal (json-read-object) '((a . 1) (b . 2)))))) | ||
| 226 | (json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }" | ||
| 227 | (let ((json-object-type 'plist)) | ||
| 228 | (should (equal (json-read-object) '(:a 1 :b 2))))) | ||
| 229 | (json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }" | ||
| 230 | (let* ((json-object-type 'hash-table) | ||
| 231 | (hash-table (json-read-object))) | ||
| 232 | (should (= (gethash "a" hash-table) 1)) | ||
| 233 | (should (= (gethash "b" hash-table) 2)))) | ||
| 234 | (json-tests--with-temp-buffer "{ \"a\": 1 \"b\": 2 }" | ||
| 235 | (should-error (json-read-object) :type 'json-object-format))) | ||
| 236 | |||
| 237 | (ert-deftest test-json-encode-hash-table () | ||
| 238 | (let ((hash-table (make-hash-table)) | ||
| 239 | (json-encoding-object-sort-predicate 'string<) | ||
| 240 | (json-encoding-pretty-print nil)) | ||
| 241 | (puthash :a 1 hash-table) | ||
| 242 | (puthash :b 2 hash-table) | ||
| 243 | (puthash :c 3 hash-table) | ||
| 244 | (should (equal (json-encode hash-table) | ||
| 245 | "{\"a\":1,\"b\":2,\"c\":3}")))) | ||
| 246 | |||
| 247 | (ert-deftest json-encode-simple-alist () | ||
| 248 | (let ((json-encoding-pretty-print nil)) | ||
| 249 | (should (equal (json-encode '((a . 1) (b . 2))) | ||
| 250 | "{\"a\":1,\"b\":2}")))) | ||
| 251 | |||
| 252 | (ert-deftest test-json-encode-plist () | ||
| 253 | (let ((plist '(:a 1 :b 2)) | ||
| 254 | (json-encoding-pretty-print nil)) | ||
| 255 | (should (equal (json-encode plist) "{\"a\":1,\"b\":2}")))) | ||
| 256 | |||
| 257 | (ert-deftest test-json-encode-plist-with-sort-predicate () | ||
| 258 | (let ((plist '(:c 3 :a 1 :b 2)) | ||
| 259 | (json-encoding-object-sort-predicate 'string<) | ||
| 260 | (json-encoding-pretty-print nil)) | ||
| 261 | (should (equal (json-encode plist) "{\"a\":1,\"b\":2,\"c\":3}")))) | ||
| 262 | |||
| 263 | (ert-deftest test-json-encode-alist-with-sort-predicate () | ||
| 264 | (let ((alist '((:c . 3) (:a . 1) (:b . 2))) | ||
| 265 | (json-encoding-object-sort-predicate 'string<) | ||
| 266 | (json-encoding-pretty-print nil)) | ||
| 267 | (should (equal (json-encode alist) "{\"a\":1,\"b\":2,\"c\":3}")))) | ||
| 268 | |||
| 269 | (ert-deftest test-json-encode-list () | ||
| 270 | (let ((json-encoding-pretty-print nil)) | ||
| 271 | (should (equal (json-encode-list '(:a 1 :b 2)) | ||
| 272 | "{\"a\":1,\"b\":2}")) | ||
| 273 | (should (equal (json-encode-list '((:a . 1) (:b . 2))) | ||
| 274 | "{\"a\":1,\"b\":2}")) | ||
| 275 | (should (equal (json-encode-list '(1 2 3 4)) "[1,2,3,4]")))) | ||
| 276 | |||
| 277 | ;;; Arrays | ||
| 278 | |||
| 279 | (ert-deftest test-json-read-array () | ||
| 280 | (let ((json-array-type 'vector)) | ||
| 281 | (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]" | ||
| 282 | (should (equal (json-read-array) [1 2 "a" "b"])))) | ||
| 283 | (let ((json-array-type 'list)) | ||
| 284 | (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]" | ||
| 285 | (should (equal (json-read-array) '(1 2 "a" "b"))))) | ||
| 286 | (json-tests--with-temp-buffer "[1 2]" | ||
| 287 | (should-error (json-read-array) :type 'json-error))) | ||
| 288 | |||
| 289 | (ert-deftest test-json-encode-array () | ||
| 290 | (let ((json-encoding-pretty-print nil)) | ||
| 291 | (should (equal (json-encode-array [1 2 "a" "b"]) | ||
| 292 | "[1,2,\"a\",\"b\"]")))) | ||
| 293 | |||
| 294 | ;;; Reader | ||
| 295 | |||
| 296 | (ert-deftest test-json-read () | ||
| 297 | (json-tests--with-temp-buffer "{ \"a\": 1 }" | ||
| 298 | ;; We don't care exactly what the return value is (that is tested | ||
| 299 | ;; in `test-json-read-object'), but it should parse without error. | ||
| 300 | (should (json-read))) | ||
| 301 | (json-tests--with-temp-buffer "" | ||
| 302 | (should-error (json-read) :type 'json-end-of-file)) | ||
| 303 | (json-tests--with-temp-buffer "xxx" | ||
| 304 | (should-error (json-read) :type 'json-readtable-error))) | ||
| 305 | |||
| 306 | (ert-deftest test-json-read-from-string () | ||
| 307 | (let ((json-string "{ \"a\": 1 }")) | ||
| 308 | (json-tests--with-temp-buffer json-string | ||
| 309 | (should (equal (json-read-from-string json-string) | ||
| 310 | (json-read)))))) | ||
| 311 | |||
| 312 | ;;; JSON encoder | ||
| 313 | |||
| 314 | (ert-deftest test-json-encode () | ||
| 315 | (should (equal (json-encode "foo") "\"foo\"")) | ||
| 316 | (with-temp-buffer | ||
| 317 | (should-error (json-encode (current-buffer)) :type 'json-error))) | ||
| 318 | |||
| 100 | (provide 'json-tests) | 319 | (provide 'json-tests) |
| 101 | ;;; json-tests.el ends here | 320 | ;;; json-tests.el ends here |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c5cab7d5991..23171d6e983 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -1608,6 +1608,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 1608 | (vc-handled-backends | 1608 | (vc-handled-backends |
| 1609 | (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil | 1609 | (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil |
| 1610 | (cond | 1610 | (cond |
| 1611 | ((tramp-find-executable v vc-git-program (tramp-get-remote-path v)) | ||
| 1612 | '(Git)) | ||
| 1613 | ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v)) | ||
| 1614 | '(Hg)) | ||
| 1611 | ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v)) | 1615 | ((tramp-find-executable v vc-bzr-program (tramp-get-remote-path v)) |
| 1612 | (setq tramp-remote-process-environment | 1616 | (setq tramp-remote-process-environment |
| 1613 | (cons (format "BZR_HOME=%s" | 1617 | (cons (format "BZR_HOME=%s" |
| @@ -1618,10 +1622,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 1618 | (tramp-dissect-file-name tramp-test-temporary-file-directory) | 1622 | (tramp-dissect-file-name tramp-test-temporary-file-directory) |
| 1619 | nil 'keep-password) | 1623 | nil 'keep-password) |
| 1620 | '(Bzr)) | 1624 | '(Bzr)) |
| 1621 | ((tramp-find-executable v vc-git-program (tramp-get-remote-path v)) | ||
| 1622 | '(Git)) | ||
| 1623 | ((tramp-find-executable v vc-hg-program (tramp-get-remote-path v)) | ||
| 1624 | '(Hg)) | ||
| 1625 | (t nil))))) | 1625 | (t nil))))) |
| 1626 | (skip-unless vc-handled-backends) | 1626 | (skip-unless vc-handled-backends) |
| 1627 | (message "%s" vc-handled-backends) | 1627 | (message "%s" vc-handled-backends) |
| @@ -1637,7 +1637,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." | |||
| 1637 | 1637 | ||
| 1638 | (let ((default-directory tmp-name1)) | 1638 | (let ((default-directory tmp-name1)) |
| 1639 | ;; Create empty repository, and register the file. | 1639 | ;; Create empty repository, and register the file. |
| 1640 | (vc-create-repo (car vc-handled-backends)) | 1640 | ;; Sometimes, creation of repository fails (bzr!); we skip |
| 1641 | ;; the test then. | ||
| 1642 | (condition-case nil | ||
| 1643 | (vc-create-repo (car vc-handled-backends)) | ||
| 1644 | (error (skip-unless nil))) | ||
| 1641 | ;; The structure of VC-FILESET is not documented. Let's | 1645 | ;; The structure of VC-FILESET is not documented. Let's |
| 1642 | ;; hope it won't change. | 1646 | ;; hope it won't change. |
| 1643 | (condition-case nil | 1647 | (condition-case nil |
| @@ -1772,6 +1776,14 @@ Several special characters do not work properly there." | |||
| 1772 | (file-truename tramp-test-temporary-file-directory) nil | 1776 | (file-truename tramp-test-temporary-file-directory) nil |
| 1773 | (string-match "^HP-UX" (tramp-get-connection-property v "uname" "")))) | 1777 | (string-match "^HP-UX" (tramp-get-connection-property v "uname" "")))) |
| 1774 | 1778 | ||
| 1779 | (defun tramp--test-darwin-p () | ||
| 1780 | "Check, whether the remote host runs Mac OS X. | ||
| 1781 | Several special characters do not work properly there." | ||
| 1782 | ;; We must refill the cache. `file-truename' does it. | ||
| 1783 | (with-parsed-tramp-file-name | ||
| 1784 | (file-truename tramp-test-temporary-file-directory) nil | ||
| 1785 | (string-match "^Darwin" (tramp-get-connection-property v "uname" "")))) | ||
| 1786 | |||
| 1775 | (defun tramp--test-check-files (&rest files) | 1787 | (defun tramp--test-check-files (&rest files) |
| 1776 | "Run a simple but comprehensive test over every file in FILES." | 1788 | "Run a simple but comprehensive test over every file in FILES." |
| 1777 | ;; We must use `file-truename' for the temporary directory, because | 1789 | ;; We must use `file-truename' for the temporary directory, because |
| @@ -1987,7 +1999,10 @@ Use the `perl' command." | |||
| 1987 | (let ((tramp-connection-properties | 1999 | (let ((tramp-connection-properties |
| 1988 | (append | 2000 | (append |
| 1989 | `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | 2001 | `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) |
| 1990 | "stat" nil)) | 2002 | "stat" nil) |
| 2003 | ;; See `tramp-sh-handle-file-truename'. | ||
| 2004 | (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | ||
| 2005 | "readlink" nil)) | ||
| 1991 | tramp-connection-properties))) | 2006 | tramp-connection-properties))) |
| 1992 | (tramp--test-special-characters))) | 2007 | (tramp--test-special-characters))) |
| 1993 | 2008 | ||
| @@ -2005,21 +2020,25 @@ Use the `ls' command." | |||
| 2005 | `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | 2020 | `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) |
| 2006 | "perl" nil) | 2021 | "perl" nil) |
| 2007 | (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | 2022 | (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) |
| 2008 | "stat" nil)) | 2023 | "stat" nil) |
| 2024 | ;; See `tramp-sh-handle-file-truename'. | ||
| 2025 | (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | ||
| 2026 | "readlink" nil)) | ||
| 2009 | tramp-connection-properties))) | 2027 | tramp-connection-properties))) |
| 2010 | (tramp--test-special-characters))) | 2028 | (tramp--test-special-characters))) |
| 2011 | 2029 | ||
| 2012 | (defun tramp--test-utf8 () | 2030 | (defun tramp--test-utf8 () |
| 2013 | "Perform the test in `tramp-test32-utf8*'." | 2031 | "Perform the test in `tramp-test32-utf8*'." |
| 2032 | (tramp--instrument-test-case 10 | ||
| 2014 | (let ((coding-system-for-read 'utf-8) | 2033 | (let ((coding-system-for-read 'utf-8) |
| 2015 | (coding-system-for-write 'utf-8) | 2034 | (coding-system-for-write 'utf-8) |
| 2016 | (file-name-coding-system 'utf-8)) | 2035 | (file-name-coding-system 'utf-8)) |
| 2017 | (tramp--test-check-files | 2036 | (tramp--test-check-files |
| 2018 | (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") | 2037 | (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") |
| 2019 | (unless (tramp--test-hpux-p) | 2038 | (unless (or (tramp--test-hpux-p) (tramp--test-darwin-p)) |
| 2020 | "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") | 2039 | "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت") |
| 2021 | "银河系漫游指南系列" | 2040 | "银河系漫游指南系列" |
| 2022 | "Автостопом по гала́ктике"))) | 2041 | "Автостопом по гала́ктике")))) |
| 2023 | 2042 | ||
| 2024 | (ert-deftest tramp-test32-utf8 () | 2043 | (ert-deftest tramp-test32-utf8 () |
| 2025 | "Check UTF8 encoding in file names and file contents." | 2044 | "Check UTF8 encoding in file names and file contents." |
| @@ -2059,7 +2078,10 @@ Use the `perl' command." | |||
| 2059 | (let ((tramp-connection-properties | 2078 | (let ((tramp-connection-properties |
| 2060 | (append | 2079 | (append |
| 2061 | `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | 2080 | `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) |
| 2062 | "stat" nil)) | 2081 | "stat" nil) |
| 2082 | ;; See `tramp-sh-handle-file-truename'. | ||
| 2083 | (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | ||
| 2084 | "readlink" nil)) | ||
| 2063 | tramp-connection-properties))) | 2085 | tramp-connection-properties))) |
| 2064 | (tramp--test-utf8))) | 2086 | (tramp--test-utf8))) |
| 2065 | 2087 | ||
| @@ -2077,7 +2099,10 @@ Use the `ls' command." | |||
| 2077 | `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | 2099 | `((,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) |
| 2078 | "perl" nil) | 2100 | "perl" nil) |
| 2079 | (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | 2101 | (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) |
| 2080 | "stat" nil)) | 2102 | "stat" nil) |
| 2103 | ;; See `tramp-sh-handle-file-truename'. | ||
| 2104 | (,(regexp-quote (file-remote-p tramp-test-temporary-file-directory)) | ||
| 2105 | "readlink" nil)) | ||
| 2081 | tramp-connection-properties))) | 2106 | tramp-connection-properties))) |
| 2082 | (tramp--test-utf8))) | 2107 | (tramp--test-utf8))) |
| 2083 | 2108 | ||
diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 97f86a969aa..2d0452f69d7 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el | |||
| @@ -543,7 +543,7 @@ to (xref-elisp-test-descr-to-target xref)." | |||
| 543 | ;; FIXME: deftype | 543 | ;; FIXME: deftype |
| 544 | 544 | ||
| 545 | (xref-elisp-deftest find-defs-defun-c-defvar-c | 545 | (xref-elisp-deftest find-defs-defun-c-defvar-c |
| 546 | (elisp--xref-find-definitions 'system-name) | 546 | (xref-backend-definitions 'elisp "system-name") |
| 547 | (list | 547 | (list |
| 548 | (xref-make "(defvar system-name)" | 548 | (xref-make "(defvar system-name)" |
| 549 | (xref-make-elisp-location 'system-name 'defvar "src/editfns.c")) | 549 | (xref-make-elisp-location 'system-name 'defvar "src/editfns.c")) |
| @@ -552,7 +552,7 @@ to (xref-elisp-test-descr-to-target xref)." | |||
| 552 | ) | 552 | ) |
| 553 | 553 | ||
| 554 | (xref-elisp-deftest find-defs-defun-el-defvar-c | 554 | (xref-elisp-deftest find-defs-defun-el-defvar-c |
| 555 | (elisp--xref-find-definitions 'abbrev-mode) | 555 | (xref-backend-definitions 'elisp "abbrev-mode") |
| 556 | ;; It's a minor mode, but the variable is defined in buffer.c | 556 | ;; It's a minor mode, but the variable is defined in buffer.c |
| 557 | (list | 557 | (list |
| 558 | (xref-make "(defvar abbrev-mode)" | 558 | (xref-make "(defvar abbrev-mode)" |
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 07b5eaa93e4..771241ad7ef 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el | |||
| @@ -138,6 +138,12 @@ | |||
| 138 | (open-line 1))) | 138 | (open-line 1))) |
| 139 | '("- - " . "\n(a b c d)")))) | 139 | '("- - " . "\n(a b c d)")))) |
| 140 | 140 | ||
| 141 | ;; For a while, from 24 Oct - 21 Nov 2015, `open-line' in the Emacs | ||
| 142 | ;; development tree became sensitive to `electric-indent-mode', which | ||
| 143 | ;; it had not been before. This sensitivity was reverted for the | ||
| 144 | ;; Emacs 25 release, so it could be discussed further (see thread | ||
| 145 | ;; "Questioning the new behavior of `open-line'." on the Emacs Devel | ||
| 146 | ;; mailing list, and bug #21884). | ||
| 141 | (ert-deftest open-line-indent () | 147 | (ert-deftest open-line-indent () |
| 142 | (should (equal (simple-test--dummy-buffer | 148 | (should (equal (simple-test--dummy-buffer |
| 143 | (electric-indent-local-mode 1) | 149 | (electric-indent-local-mode 1) |
| @@ -145,29 +151,34 @@ | |||
| 145 | '("(a b" . "\n c d)"))) | 151 | '("(a b" . "\n c d)"))) |
| 146 | (should (equal (simple-test--dummy-buffer | 152 | (should (equal (simple-test--dummy-buffer |
| 147 | (electric-indent-local-mode 1) | 153 | (electric-indent-local-mode 1) |
| 148 | (open-line 1 'interactive)) | 154 | (open-line 1)) |
| 149 | '("(a b" . "\n c d)"))) | 155 | '("(a b" . "\n c d)"))) |
| 150 | (should (equal (simple-test--dummy-buffer | 156 | (should (equal (simple-test--dummy-buffer |
| 151 | (electric-indent-local-mode 1) | 157 | (electric-indent-local-mode 1) |
| 152 | (let ((current-prefix-arg nil)) | 158 | (let ((current-prefix-arg nil)) |
| 153 | (call-interactively #'open-line) | 159 | (call-interactively #'open-line) |
| 154 | (call-interactively #'open-line))) | 160 | (call-interactively #'open-line))) |
| 155 | '("(a b" . "\n\n c d)"))) | 161 | '("(a b" . "\n\n c d)"))) |
| 156 | (should (equal (simple-test--dummy-buffer | 162 | (should (equal (simple-test--dummy-buffer |
| 157 | (electric-indent-local-mode 1) | 163 | (electric-indent-local-mode 1) |
| 158 | (open-line 5 'interactive)) | 164 | (open-line 5)) |
| 159 | '("(a b" . "\n\n\n\n\n c d)"))) | 165 | '("(a b" . "\n\n\n\n\n c d)"))) |
| 160 | (should (equal (simple-test--dummy-buffer | 166 | (should (equal (simple-test--dummy-buffer |
| 161 | (electric-indent-local-mode 1) | 167 | (electric-indent-local-mode 1) |
| 162 | (let ((current-prefix-arg 5)) | 168 | (let ((current-prefix-arg 5)) |
| 163 | (call-interactively #'open-line))) | 169 | (call-interactively #'open-line))) |
| 164 | '("(a b" . "\n\n\n\n\n c d)"))) | 170 | '("(a b" . "\n\n\n\n\n c d)"))) |
| 165 | (should (equal (simple-test--dummy-buffer | 171 | (should (equal (simple-test--dummy-buffer |
| 166 | (forward-char 1) | 172 | (forward-char 1) |
| 167 | (electric-indent-local-mode 1) | 173 | (electric-indent-local-mode 1) |
| 168 | (open-line 1 'interactive)) | 174 | (open-line 1)) |
| 169 | '("(a b" . "\n c d)")))) | 175 | '("(a b " . "\nc d)")))) |
| 170 | 176 | ||
| 177 | ;; From 24 Oct - 21 Nov 2015, `open-line' took a second argument | ||
| 178 | ;; INTERACTIVE and ran `post-self-insert-hook' if the argument was | ||
| 179 | ;; true. This test tested that. Currently, however, `open-line' | ||
| 180 | ;; does not run run `post-self-insert-hook' at all, so for now | ||
| 181 | ;; this test just makes sure that it doesn't. | ||
| 171 | (ert-deftest open-line-hook () | 182 | (ert-deftest open-line-hook () |
| 172 | (let* ((x 0) | 183 | (let* ((x 0) |
| 173 | (inc (lambda () (setq x (1+ x))))) | 184 | (inc (lambda () (setq x (1+ x))))) |
| @@ -177,18 +188,18 @@ | |||
| 177 | (should (= x 0)) | 188 | (should (= x 0)) |
| 178 | (simple-test--dummy-buffer | 189 | (simple-test--dummy-buffer |
| 179 | (add-hook 'post-self-insert-hook inc nil 'local) | 190 | (add-hook 'post-self-insert-hook inc nil 'local) |
| 180 | (open-line 1 'interactive)) | 191 | (open-line 1)) |
| 181 | (should (= x 1)) | 192 | (should (= x 0)) |
| 182 | 193 | ||
| 183 | (unwind-protect | 194 | (unwind-protect |
| 184 | (progn | 195 | (progn |
| 185 | (add-hook 'post-self-insert-hook inc) | 196 | (add-hook 'post-self-insert-hook inc) |
| 186 | (simple-test--dummy-buffer | 197 | (simple-test--dummy-buffer |
| 187 | (open-line 1)) | 198 | (open-line 1)) |
| 188 | (should (= x 1)) | 199 | (should (= x 0)) |
| 189 | (simple-test--dummy-buffer | 200 | (simple-test--dummy-buffer |
| 190 | (open-line 10 'interactive)) | 201 | (open-line 10)) |
| 191 | (should (= x 2))) | 202 | (should (= x 0))) |
| 192 | (remove-hook 'post-self-insert-hook inc)))) | 203 | (remove-hook 'post-self-insert-hook inc)))) |
| 193 | 204 | ||
| 194 | 205 | ||
| @@ -215,9 +226,9 @@ | |||
| 215 | 226 | ||
| 216 | 227 | ||
| 217 | ;;; auto-boundary tests | 228 | ;;; auto-boundary tests |
| 218 | (ert-deftest undo-auto--boundary-timer () | 229 | (ert-deftest undo-auto-boundary-timer () |
| 219 | (should | 230 | (should |
| 220 | undo-auto--current-boundary-timer)) | 231 | undo-auto-current-boundary-timer)) |
| 221 | 232 | ||
| 222 | (ert-deftest undo-auto--boundaries-added () | 233 | (ert-deftest undo-auto--boundaries-added () |
| 223 | ;; The change in the buffer should have caused addition | 234 | ;; The change in the buffer should have caused addition |
| @@ -252,5 +263,53 @@ | |||
| 252 | '("(s1) (s4)" . " (s2) (s3) (s5)")))) | 263 | '("(s1) (s4)" . " (s2) (s3) (s5)")))) |
| 253 | 264 | ||
| 254 | 265 | ||
| 266 | ;; Test for a regression introduced by undo-auto--boundaries changes. | ||
| 267 | ;; https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01652.html | ||
| 268 | (defun undo-test-kill-c-a-then-undo () | ||
| 269 | (with-temp-buffer | ||
| 270 | (switch-to-buffer (current-buffer)) | ||
| 271 | (setq buffer-undo-list nil) | ||
| 272 | (insert "a\nb\n\c\n") | ||
| 273 | (goto-char (point-max)) | ||
| 274 | ;; We use a keyboard macro because it adds undo events in the same | ||
| 275 | ;; way as if a user were involved. | ||
| 276 | (kmacro-call-macro nil nil nil | ||
| 277 | [left | ||
| 278 | ;; Delete "c" | ||
| 279 | backspace | ||
| 280 | left left left | ||
| 281 | ;; Delete "a" | ||
| 282 | backspace | ||
| 283 | ;; C-/ or undo | ||
| 284 | 67108911 | ||
| 285 | ]) | ||
| 286 | (point))) | ||
| 287 | |||
| 288 | (defun undo-test-point-after-forward-kill () | ||
| 289 | (with-temp-buffer | ||
| 290 | (switch-to-buffer (current-buffer)) | ||
| 291 | (setq buffer-undo-list nil) | ||
| 292 | (insert "kill word forward") | ||
| 293 | ;; Move to word "word". | ||
| 294 | (goto-char 6) | ||
| 295 | (kmacro-call-macro nil nil nil | ||
| 296 | [ | ||
| 297 | ;; kill-word | ||
| 298 | C-delete | ||
| 299 | ;; undo | ||
| 300 | 67108911 | ||
| 301 | ]) | ||
| 302 | (point))) | ||
| 303 | |||
| 304 | (ert-deftest undo-point-in-wrong-place () | ||
| 305 | (should | ||
| 306 | ;; returns 5 with the bug | ||
| 307 | (= 2 | ||
| 308 | (undo-test-kill-c-a-then-undo))) | ||
| 309 | (should | ||
| 310 | (= 6 | ||
| 311 | (undo-test-point-after-forward-kill)))) | ||
| 312 | |||
| 313 | |||
| 255 | (provide 'simple-test) | 314 | (provide 'simple-test) |
| 256 | ;;; simple-test.el ends here | 315 | ;;; simple-test.el ends here |
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index ee8db593b49..3fcb7d346a3 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/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 |
diff --git a/test/lisp/url/url-expand-tests.el b/test/lisp/url/url-expand-tests.el deleted file mode 100644 index 2bd28687f8d..00000000000 --- a/test/lisp/url/url-expand-tests.el +++ /dev/null | |||
| @@ -1,105 +0,0 @@ | |||
| 1 | ;;; url-expand-tests.el --- Test suite for relative URI/URL resolution. | ||
| 2 | |||
| 3 | ;; Copyright (C) 2012-2015 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Alain Schneble <a.s@realize.ch> | ||
| 6 | ;; Version: 1.0 | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;; Test cases covering URI reference resolution as described in RFC3986, | ||
| 26 | ;; section 5. Reference Resolution and especially the relative resolution | ||
| 27 | ;; rules specified in section 5.2. Relative Resolution. | ||
| 28 | |||
| 29 | ;; Each test calls `url-expand-file-name', typically with a relative | ||
| 30 | ;; reference URI and a base URI as string and compares the result (Actual) | ||
| 31 | ;; against a manually specified URI (Expected) | ||
| 32 | |||
| 33 | ;;; Code: | ||
| 34 | |||
| 35 | (require 'url-expand) | ||
| 36 | (require 'ert) | ||
| 37 | |||
| 38 | (ert-deftest url-expand-file-name/relative-resolution-normal-examples () | ||
| 39 | "RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.1. Normal Examples" | ||
| 40 | (should (equal (url-expand-file-name "g:h" "http://a/b/c/d;p?q") "g:h")) | ||
| 41 | (should (equal (url-expand-file-name "g" "http://a/b/c/d;p?q") "http://a/b/c/g")) | ||
| 42 | (should (equal (url-expand-file-name "./g" "http://a/b/c/d;p?q") "http://a/b/c/g")) | ||
| 43 | (should (equal (url-expand-file-name "g/" "http://a/b/c/d;p?q") "http://a/b/c/g/")) | ||
| 44 | (should (equal (url-expand-file-name "/g" "http://a/b/c/d;p?q") "http://a/g")) | ||
| 45 | (should (equal (url-expand-file-name "//g" "http://a/b/c/d;p?q") "http://g")) | ||
| 46 | (should (equal (url-expand-file-name "?y" "http://a/b/c/d;p?q") "http://a/b/c/d;p?y")) | ||
| 47 | (should (equal (url-expand-file-name "g?y" "http://a/b/c/d;p?q") "http://a/b/c/g?y")) | ||
| 48 | (should (equal (url-expand-file-name "#s" "http://a/b/c/d;p?q") "http://a/b/c/d;p?q#s")) | ||
| 49 | (should (equal (url-expand-file-name "g#s" "http://a/b/c/d;p?q") "http://a/b/c/g#s")) | ||
| 50 | (should (equal (url-expand-file-name "g?y#s" "http://a/b/c/d;p?q") "http://a/b/c/g?y#s")) | ||
| 51 | (should (equal (url-expand-file-name ";x" "http://a/b/c/d;p?q") "http://a/b/c/;x")) | ||
| 52 | (should (equal (url-expand-file-name "g;x" "http://a/b/c/d;p?q") "http://a/b/c/g;x")) | ||
| 53 | (should (equal (url-expand-file-name "g;x?y#s" "http://a/b/c/d;p?q") "http://a/b/c/g;x?y#s")) | ||
| 54 | (should (equal (url-expand-file-name "" "http://a/b/c/d;p?q") "http://a/b/c/d;p?q")) | ||
| 55 | (should (equal (url-expand-file-name "." "http://a/b/c/d;p?q") "http://a/b/c/")) | ||
| 56 | (should (equal (url-expand-file-name "./" "http://a/b/c/d;p?q") "http://a/b/c/")) | ||
| 57 | (should (equal (url-expand-file-name ".." "http://a/b/c/d;p?q") "http://a/b/")) | ||
| 58 | (should (equal (url-expand-file-name "../" "http://a/b/c/d;p?q") "http://a/b/")) | ||
| 59 | (should (equal (url-expand-file-name "../g" "http://a/b/c/d;p?q") "http://a/b/g")) | ||
| 60 | (should (equal (url-expand-file-name "../.." "http://a/b/c/d;p?q") "http://a/")) | ||
| 61 | (should (equal (url-expand-file-name "../../" "http://a/b/c/d;p?q") "http://a/")) | ||
| 62 | (should (equal (url-expand-file-name "../../g" "http://a/b/c/d;p?q") "http://a/g"))) | ||
| 63 | |||
| 64 | (ert-deftest url-expand-file-name/relative-resolution-absolute-examples () | ||
| 65 | "RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.2. Abnormal Examples" | ||
| 66 | (should (equal (url-expand-file-name "../../../g" "http://a/b/c/d;p?q") "http://a/g")) | ||
| 67 | (should (equal (url-expand-file-name "../../../../g" "http://a/b/c/d;p?q") "http://a/g")) | ||
| 68 | |||
| 69 | (should (equal (url-expand-file-name "/./g" "http://a/b/c/d;p?q") "http://a/g")) | ||
| 70 | (should (equal (url-expand-file-name "/../g" "http://a/b/c/d;p?q") "http://a/g")) | ||
| 71 | (should (equal (url-expand-file-name "g." "http://a/b/c/d;p?q") "http://a/b/c/g.")) | ||
| 72 | (should (equal (url-expand-file-name ".g" "http://a/b/c/d;p?q") "http://a/b/c/.g")) | ||
| 73 | (should (equal (url-expand-file-name "g.." "http://a/b/c/d;p?q") "http://a/b/c/g..")) | ||
| 74 | (should (equal (url-expand-file-name "..g" "http://a/b/c/d;p?q") "http://a/b/c/..g")) | ||
| 75 | |||
| 76 | (should (equal (url-expand-file-name "./../g" "http://a/b/c/d;p?q") "http://a/b/g")) | ||
| 77 | (should (equal (url-expand-file-name "./g/." "http://a/b/c/d;p?q") "http://a/b/c/g/")) | ||
| 78 | (should (equal (url-expand-file-name "g/./h" "http://a/b/c/d;p?q") "http://a/b/c/g/h")) | ||
| 79 | (should (equal (url-expand-file-name "g/../h" "http://a/b/c/d;p?q") "http://a/b/c/h")) | ||
| 80 | (should (equal (url-expand-file-name "g;x=1/./y" "http://a/b/c/d;p?q") "http://a/b/c/g;x=1/y")) | ||
| 81 | (should (equal (url-expand-file-name "g;x=1/../y" "http://a/b/c/d;p?q") "http://a/b/c/y")) | ||
| 82 | |||
| 83 | (should (equal (url-expand-file-name "g?y/./x" "http://a/b/c/d;p?q") "http://a/b/c/g?y/./x")) | ||
| 84 | (should (equal (url-expand-file-name "g?y/../x" "http://a/b/c/d;p?q") "http://a/b/c/g?y/../x")) | ||
| 85 | (should (equal (url-expand-file-name "g#s/./x" "http://a/b/c/d;p?q") "http://a/b/c/g#s/./x")) | ||
| 86 | (should (equal (url-expand-file-name "g#s/../x" "http://a/b/c/d;p?q") "http://a/b/c/g#s/../x")) | ||
| 87 | |||
| 88 | (should (equal (url-expand-file-name "http:g" "http://a/b/c/d;p?q") "http:g")) ; for strict parsers | ||
| 89 | ) | ||
| 90 | |||
| 91 | (ert-deftest url-expand-file-name/relative-resolution-additional-examples () | ||
| 92 | "Reference Resolution Examples / Arbitrary Examples" | ||
| 93 | (should (equal (url-expand-file-name "" "http://host/foobar") "http://host/foobar")) | ||
| 94 | (should (equal (url-expand-file-name "?y" "http://a/b/c/d") "http://a/b/c/d?y")) | ||
| 95 | (should (equal (url-expand-file-name "?y" "http://a/b/c/d/") "http://a/b/c/d/?y")) | ||
| 96 | (should (equal (url-expand-file-name "?y#fragment" "http://a/b/c/d;p?q") "http://a/b/c/d;p?y#fragment")) | ||
| 97 | (should (equal (url-expand-file-name "#bar" "http://host") "http://host#bar")) | ||
| 98 | (should (equal (url-expand-file-name "#bar" "http://host/") "http://host/#bar")) | ||
| 99 | (should (equal (url-expand-file-name "#bar" "http://host/foo") "http://host/foo#bar")) | ||
| 100 | (should (equal (url-expand-file-name "foo#bar" "http://host/foobar") "http://host/foo#bar")) | ||
| 101 | (should (equal (url-expand-file-name "foo#bar" "http://host/foobar/") "http://host/foobar/foo#bar"))) | ||
| 102 | |||
| 103 | (provide 'url-expand-tests) | ||
| 104 | |||
| 105 | ;;; url-expand-tests.el ends here | ||