aboutsummaryrefslogtreecommitdiffstats
path: root/test/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp')
-rw-r--r--test/lisp/abbrev-tests.el53
-rw-r--r--test/lisp/autorevert-tests.el4
-rw-r--r--test/lisp/calendar/icalendar-tests.el56
-rw-r--r--test/lisp/character-fold-tests.el72
-rw-r--r--test/lisp/emacs-lisp/package-tests.el14
-rw-r--r--test/lisp/faces-tests.el5
-rw-r--r--test/lisp/gnus/auth-source-tests.el45
-rw-r--r--test/lisp/gnus/message-tests.el6
-rw-r--r--test/lisp/help-fns-tests.el10
-rw-r--r--test/lisp/json-tests.el297
-rw-r--r--test/lisp/net/tramp-tests.el47
-rw-r--r--test/lisp/progmodes/elisp-mode-tests.el4
-rw-r--r--test/lisp/simple-tests.el89
-rw-r--r--test/lisp/subr-tests.el112
-rw-r--r--test/lisp/url/url-expand-tests.el105
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
2238PRODID:-//www.norwegian.no//iCalendar MIMEDIR//EN\r
2239VERSION:2.0\r
2240METHOD:REQUEST\r
2241BEGIN:VEVENT\r
2242UID:RFCALITEM1\r
2243SEQUENCE:1512040950\r
2244DTSTAMP:20141204T095043Z\r
2245ORGANIZER:noreply@norwegian.no\r
2246DTSTART:20141208T173000Z\r
2247
2248DTEND:20141208T215500Z\r
2249
2250LOCATION:Stavanger-Sola\r
2251
2252DESCRIPTION: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
2254X-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>
2255SUMMARY:Norwegian til Tromsoe-Langnes -\r
2256
2257CATEGORIES:Appointment\r
2258
2259
2260PRIORITY:5\r
2261
2262CLASS:PUBLIC\r
2263
2264TRANSP:OPAQUE\r
2265END:VEVENT\r
2266END:VCALENDAR
2267"
2268"&2014/12/8 18:30-22:55 Norwegian til Tromsoe-Langnes -
2269 Desc: Fly med Norwegian, reservasjon. Fra Stavanger til Troms&#248; 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Troms&#248; 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&#248; 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Troms&#248; 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&#248; 8. des 2014 18:30, DY545Fly med Norwegian, reservasjon . Fra Stavanger til Troms&#248; 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.
27Point 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.
1781Several 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