aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/lisp/cedet/srecode-utest-template.el5
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el43
-rw-r--r--test/lisp/emacs-lisp/cl-lib-tests.el16
-rw-r--r--test/lisp/ffap-tests.el40
-rw-r--r--test/lisp/mail/flow-fill-tests.el3
-rw-r--r--test/lisp/progmodes/compile-tests.el4
-rw-r--r--test/lisp/progmodes/cperl-mode-tests.el51
-rw-r--r--test/lisp/simple-tests.el7
-rw-r--r--test/lisp/textmodes/bibtex-tests.el57
-rw-r--r--test/lisp/textmodes/paragraphs-tests.el4
-rw-r--r--test/lisp/url/url-expand-tests.el7
-rw-r--r--test/manual/etags/c-src/abbrev.c14
-rw-r--r--test/manual/image-circular-tests.el144
-rw-r--r--test/src/comp-tests.el3
-rw-r--r--test/src/fns-tests.el6
15 files changed, 362 insertions, 42 deletions
diff --git a/test/lisp/cedet/srecode-utest-template.el b/test/lisp/cedet/srecode-utest-template.el
index 63c33a3c440..7c5bbc599a3 100644
--- a/test/lisp/cedet/srecode-utest-template.el
+++ b/test/lisp/cedet/srecode-utest-template.el
@@ -323,7 +323,6 @@ INSIDE SECTION: ARG HANDLER ONE")
323 323
324(ert-deftest srecode-utest-project () 324(ert-deftest srecode-utest-project ()
325 "Test that project filtering works." 325 "Test that project filtering works."
326 :expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed) ; fixme
327 (save-excursion 326 (save-excursion
328 (let ((testbuff (find-file-noselect srecode-utest-testfile)) 327 (let ((testbuff (find-file-noselect srecode-utest-testfile))
329 (temp nil)) 328 (temp nil))
@@ -347,6 +346,10 @@ INSIDE SECTION: ARG HANDLER ONE")
347 ;; Load the application templates, and make sure we can find them. 346 ;; Load the application templates, and make sure we can find them.
348 (srecode-load-tables-for-mode major-mode 'tests) 347 (srecode-load-tables-for-mode major-mode 'tests)
349 348
349 (dolist (table (oref (srecode-table) tables))
350 (when (gethash "test" (oref table contexthash))
351 (oset table project default-directory)))
352
350 (setq temp (srecode-template-get-table (srecode-table) 353 (setq temp (srecode-template-get-table (srecode-table)
351 "test-project" 354 "test-project"
352 "test" 355 "test"
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 894914300ae..834e3b6d914 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -365,24 +365,24 @@ bytecompiled code, and their results compared.")
365(defun bytecomp-check-1 (pat) 365(defun bytecomp-check-1 (pat)
366 "Return non-nil if PAT is the same whether directly evalled or compiled." 366 "Return non-nil if PAT is the same whether directly evalled or compiled."
367 (let ((warning-minimum-log-level :emergency) 367 (let ((warning-minimum-log-level :emergency)
368 (byte-compile-warnings nil) 368 (byte-compile-warnings nil)
369 (v0 (condition-case nil 369 (v0 (condition-case err
370 (eval pat) 370 (eval pat)
371 (error 'bytecomp-check-error))) 371 (error (list 'bytecomp-check-error (car err)))))
372 (v1 (condition-case nil 372 (v1 (condition-case err
373 (funcall (byte-compile (list 'lambda nil pat))) 373 (funcall (byte-compile (list 'lambda nil pat)))
374 (error 'bytecomp-check-error)))) 374 (error (list 'bytecomp-check-error (car err))))))
375 (equal v0 v1))) 375 (equal v0 v1)))
376 376
377(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) 377(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1)
378 378
379(defun bytecomp-explain-1 (pat) 379(defun bytecomp-explain-1 (pat)
380 (let ((v0 (condition-case nil 380 (let ((v0 (condition-case err
381 (eval pat) 381 (eval pat)
382 (error 'bytecomp-check-error))) 382 (error (list 'bytecomp-check-error (car err)))))
383 (v1 (condition-case nil 383 (v1 (condition-case err
384 (funcall (byte-compile (list 'lambda nil pat))) 384 (funcall (byte-compile (list 'lambda nil pat)))
385 (error 'bytecomp-check-error)))) 385 (error (list 'bytecomp-check-error (car err))))))
386 (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." 386 (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
387 pat v0 v1))) 387 pat v0 v1)))
388 388
@@ -405,12 +405,12 @@ Subtests signal errors if something goes wrong."
405 (print-quoted t) 405 (print-quoted t)
406 v0 v1) 406 v0 v1)
407 (dolist (pat byte-opt-testsuite-arith-data) 407 (dolist (pat byte-opt-testsuite-arith-data)
408 (condition-case nil 408 (condition-case err
409 (setq v0 (eval pat)) 409 (setq v0 (eval pat))
410 (error (setq v0 'bytecomp-check-error))) 410 (error (setq v0 (list 'bytecomp-check-error (car err)))))
411 (condition-case nil 411 (condition-case err
412 (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) 412 (setq v1 (funcall (byte-compile (list 'lambda nil pat))))
413 (error (setq v1 'bytecomp-check-error))) 413 (error (setq v1 (list 'bytecomp-check-error (car err)))))
414 (insert (format "%s" pat)) 414 (insert (format "%s" pat))
415 (indent-to-column 65) 415 (indent-to-column 65)
416 (if (equal v0 v1) 416 (if (equal v0 v1)
@@ -479,6 +479,7 @@ Subtests signal errors if something goes wrong."
479(ert-deftest bytecomp-tests--warnings () 479(ert-deftest bytecomp-tests--warnings ()
480 (with-current-buffer (get-buffer-create "*Compile-Log*") 480 (with-current-buffer (get-buffer-create "*Compile-Log*")
481 (let ((inhibit-read-only t)) (erase-buffer))) 481 (let ((inhibit-read-only t)) (erase-buffer)))
482 (mapc #'fmakunbound '(my-test0 my--test11 my--test12 my--test2))
482 (test-byte-comp-compile-and-load t 483 (test-byte-comp-compile-and-load t
483 '(progn 484 '(progn
484 (defun my-test0 () 485 (defun my-test0 ()
@@ -564,25 +565,25 @@ bytecompiled code, and their results compared.")
564 "Return non-nil if PAT is the same whether directly evalled or compiled." 565 "Return non-nil if PAT is the same whether directly evalled or compiled."
565 (let ((warning-minimum-log-level :emergency) 566 (let ((warning-minimum-log-level :emergency)
566 (byte-compile-warnings nil) 567 (byte-compile-warnings nil)
567 (v0 (condition-case nil 568 (v0 (condition-case err
568 (eval pat t) 569 (eval pat t)
569 (error 'bytecomp-check-error))) 570 (error (list 'bytecomp-check-error (car err)))))
570 (v1 (condition-case nil 571 (v1 (condition-case err
571 (funcall (let ((lexical-binding t)) 572 (funcall (let ((lexical-binding t))
572 (byte-compile `(lambda nil ,pat)))) 573 (byte-compile `(lambda nil ,pat))))
573 (error 'bytecomp-check-error)))) 574 (error (list 'bytecomp-check-error (car err))))))
574 (equal v0 v1))) 575 (equal v0 v1)))
575 576
576(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1) 577(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1)
577 578
578(defun bytecomp-lexbind-explain-1 (pat) 579(defun bytecomp-lexbind-explain-1 (pat)
579 (let ((v0 (condition-case nil 580 (let ((v0 (condition-case err
580 (eval pat t) 581 (eval pat t)
581 (error 'bytecomp-check-error))) 582 (error (list 'bytecomp-check-error (car err)))))
582 (v1 (condition-case nil 583 (v1 (condition-case err
583 (funcall (let ((lexical-binding t)) 584 (funcall (let ((lexical-binding t))
584 (byte-compile (list 'lambda nil pat)))) 585 (byte-compile (list 'lambda nil pat))))
585 (error 'bytecomp-check-error)))) 586 (error (list 'bytecomp-check-error (car err))))))
586 (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." 587 (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled."
587 pat v0 v1))) 588 pat v0 v1)))
588 589
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index 57b9d23efb0..40dd7e4eeb0 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -242,6 +242,22 @@
242 (should (= (cl-the integer (cl-incf side-effect)) 1)) 242 (should (= (cl-the integer (cl-incf side-effect)) 1))
243 (should (= side-effect 1)))) 243 (should (= side-effect 1))))
244 244
245(ert-deftest cl-lib-test-incf ()
246 (let ((var 0))
247 (should (= (cl-incf var) 1))
248 (should (= var 1)))
249 (let ((alist))
250 (should (= (cl-incf (alist-get 'a alist 0)) 1))
251 (should (= (alist-get 'a alist 0) 1))))
252
253(ert-deftest cl-lib-test-decf ()
254 (let ((var 1))
255 (should (= (cl-decf var) 0))
256 (should (= var 0)))
257 (let ((alist))
258 (should (= (cl-decf (alist-get 'a alist 0)) -1))
259 (should (= (alist-get 'a alist 0) -1))))
260
245(ert-deftest cl-lib-test-plusp () 261(ert-deftest cl-lib-test-plusp ()
246 (should-not (cl-plusp -1.0e+INF)) 262 (should-not (cl-plusp -1.0e+INF))
247 (should-not (cl-plusp -1.5e2)) 263 (should-not (cl-plusp -1.5e2))
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index 30c8f794577..e8c12669c1a 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -77,6 +77,46 @@ left alone when opening a URL in an external browser."
77 (should (compare-window-configurations (current-window-configuration) old)) 77 (should (compare-window-configurations (current-window-configuration) old))
78 (should (equal urls '("https://www.gnu.org"))))) 78 (should (equal urls '("https://www.gnu.org")))))
79 79
80(defun ffap-test-string (space string)
81 (let ((ffap-file-name-with-spaces space))
82 (with-temp-buffer
83 (insert string)
84 (goto-char (point-min))
85 (forward-char 10)
86 (ffap-string-at-point))))
87
88(ert-deftest ffap-test-with-spaces ()
89 (should
90 (equal
91 (ffap-test-string
92 t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt")
93 "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt"))
94 (should
95 (equal
96 (ffap-test-string
97 nil "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program here.txt")
98 "c:/Program"))
99 (should
100 (equal
101 (ffap-test-string
102 t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program Files/Hummingbird/")
103 "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program Files/Hummingbird/"))
104 (should
105 (equal
106 (ffap-test-string
107 t "c:\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14 x86\\Program Files\\Hummingbird\\")
108 "\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14 x86\\Program Files\\Hummingbird\\"))
109 (should
110 (equal
111 (ffap-test-string
112 t "c:\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx 2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt")
113 "\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx 2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt"))
114 (should
115 (equal
116 (ffap-test-string
117 t "C:\\temp\\program.log on Windows or /var/log/program.log on Unix.")
118 "\\temp\\program.log")))
119
80(provide 'ffap-tests) 120(provide 'ffap-tests)
81 121
82;;; ffap-tests.el ends here 122;;; ffap-tests.el ends here
diff --git a/test/lisp/mail/flow-fill-tests.el b/test/lisp/mail/flow-fill-tests.el
index 4d435aeda71..c2e4178b7d4 100644
--- a/test/lisp/mail/flow-fill-tests.el
+++ b/test/lisp/mail/flow-fill-tests.el
@@ -35,7 +35,8 @@
35 ">>> unmuzzled ratsbane!\n" 35 ">>> unmuzzled ratsbane!\n"
36 ">>>> Henceforth, the coding style is to be strictly \n" 36 ">>>> Henceforth, the coding style is to be strictly \n"
37 ">>>> enforced, including the use of only upper case.\n" 37 ">>>> enforced, including the use of only upper case.\n"
38 ">>>>> I've noticed a lack of adherence to the coding \n" 38 ">>>>> I've noticed a lack of adherence to \n"
39 ">>>>> the coding \n"
39 ">>>>> styles, of late.\n" 40 ">>>>> styles, of late.\n"
40 ">>>>>> Any complaints?\n")) 41 ">>>>>> Any complaints?\n"))
41 (output 42 (output
diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el
index cd736497e66..d566e7dd862 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -435,8 +435,8 @@ The test data is in `compile-tests--test-regexps-data'."
435 (compilation-num-infos-found 0)) 435 (compilation-num-infos-found 0))
436 (mapc #'compile--test-error-line compile-tests--test-regexps-data) 436 (mapc #'compile--test-error-line compile-tests--test-regexps-data)
437 (should (eq compilation-num-errors-found 94)) 437 (should (eq compilation-num-errors-found 94))
438 (should (eq compilation-num-warnings-found 37)) 438 (should (eq compilation-num-warnings-found 35))
439 (should (eq compilation-num-infos-found 26))))) 439 (should (eq compilation-num-infos-found 28)))))
440 440
441(ert-deftest compile-test-grep-regexps () 441(ert-deftest compile-test-grep-regexps ()
442 "Test the `grep-regexp-alist' regexps. 442 "Test the `grep-regexp-alist' regexps.
diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el
new file mode 100644
index 00000000000..be8b42d99a8
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -0,0 +1,51 @@
1;;; cperl-mode-tests --- Test for cperl-mode -*- lexical-binding: t -*-
2
3;; Copyright (C) 2020 Free Software Foundation, Inc.
4
5;; Author: Harald Jörg <haj@posteo.de>
6;; Maintainer: Harald Jörg
7;; Keywords: internal
8;; Homepage: https://github.com/HaraldJoerg/cperl-mode
9
10;;; Commentary:
11
12;; This is a collection of tests for the fontification of CPerl-mode.
13
14;; Run these tests interactively:
15;; (ert-run-tests-interactively '(tag :fontification))
16
17;;; Code:
18
19(defvar cperl-test-mode #'cperl-mode)
20
21(defun cperl-test-ppss (text regexp)
22 "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT."
23 (interactive)
24 (with-temp-buffer
25 (insert text)
26 (funcall cperl-test-mode)
27 (goto-char (point-min))
28 (re-search-forward regexp)
29 (syntax-ppss)))
30
31(ert-deftest cperl-mode-test-bug-42168 ()
32 "Verify that '/' is a division after ++ or --, not a regexp.
33Reported in https://github.com/jrockway/cperl-mode/issues/45.
34If seen as regular expression, then the slash is displayed using
35font-lock-constant-face. If seen as a division, then it doesn't
36have a face property."
37 :tags '(:fontification)
38 ;; The next two Perl expressions have divisions. Perl "punctuation"
39 ;; operators don't get a face.
40 (let ((code "{ $a++ / $b }"))
41 (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
42 (let ((code "{ $a-- / $b }"))
43 (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
44 ;; The next two Perl expressions have regular expressions. The
45 ;; delimiter of a RE is fontified with font-lock-constant-face.
46 (let ((code "{ $a+ / $b } # /"))
47 (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))
48 (let ((code "{ $a- / $b } # /"))
49 (should (equal (nth 8 (cperl-test-ppss code "/")) 7))))
50
51;;; cperl-mode-tests.el ends here
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 4adcacb279b..63e504bbe17 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -39,6 +39,13 @@
39 (with-no-warnings (simple-test--buffer-substrings)))) 39 (with-no-warnings (simple-test--buffer-substrings))))
40 40
41 41
42;;; `count-words'
43(ert-deftest simple-test-count-words-bug-41761 ()
44 (with-temp-buffer
45 (dotimes (i 10) (insert (propertize "test " 'field (cons nil nil))))
46 (should (= (count-words (point-min) (point-max)) 10))))
47
48
42;;; `transpose-sexps' 49;;; `transpose-sexps'
43(defmacro simple-test--transpositions (&rest body) 50(defmacro simple-test--transpositions (&rest body)
44 (declare (indent 0) 51 (declare (indent 0)
diff --git a/test/lisp/textmodes/bibtex-tests.el b/test/lisp/textmodes/bibtex-tests.el
new file mode 100644
index 00000000000..b3858de9e61
--- /dev/null
+++ b/test/lisp/textmodes/bibtex-tests.el
@@ -0,0 +1,57 @@
1;;; bibtex-tests.el --- Test suite for bibtex.
2
3;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
4
5;; Keywords: bibtex
6
7;; This file is part of GNU Emacs.
8
9;; GNU Emacs is free software: you can redistribute it and/or modify
10;; it under the terms of the GNU General Public License as published by
11;; the Free Software Foundation, either version 3 of the License, or
12;; (at your option) any later version.
13
14;; GNU Emacs is distributed in the hope that it will be useful,
15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17;; GNU General Public License for more details.
18
19;; You should have received a copy of the GNU General Public License
20;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
21
22;;; Commentary:
23
24;;; Code:
25
26(require 'ert)
27(require 'bibtex)
28
29(ert-deftest bibtex-test-set-dialect ()
30 "Tests if `bibtex-set-dialect' is executed."
31 (with-temp-buffer
32 (insert "@article{someID,
33 author = {some author},
34 title = {some title},
35}")
36 (bibtex-mode)
37 (should-not (null bibtex-dialect))
38 (should-not (null bibtex-entry-type))
39 (should-not (null bibtex-entry-head))
40 (should-not (null bibtex-reference-key))
41 (should-not (null bibtex-entry-head))
42 (should-not (null bibtex-entry-maybe-empty-head))
43 (should-not (null bibtex-any-valid-entry-type))))
44
45(ert-deftest bibtex-test-parse-buffers-stealthily ()
46 "Tests if `bibtex-parse-buffers-stealthily' can be executed."
47 (with-temp-buffer
48 (insert "@article{someID,
49 author = {some author},
50 title = {some title},
51}")
52 (bibtex-mode)
53 (should (progn (bibtex-parse-buffers-stealthily) t))))
54
55(provide 'bibtex-tests)
56
57;;; bibtex-tests.el ends here
diff --git a/test/lisp/textmodes/paragraphs-tests.el b/test/lisp/textmodes/paragraphs-tests.el
index fc839fe7d95..0b264e7e184 100644
--- a/test/lisp/textmodes/paragraphs-tests.el
+++ b/test/lisp/textmodes/paragraphs-tests.el
@@ -50,8 +50,8 @@
50 (goto-char (point-min)) 50 (goto-char (point-min))
51 (mark-paragraph) 51 (mark-paragraph)
52 (should mark-active) 52 (should mark-active)
53 (should (equal (mark) 7))) 53 (should (equal (mark) 7))))
54 (should-error (mark-paragraph 0))) 54;;; (should-error (mark-paragraph 0)))
55 55
56(ert-deftest paragraphs-tests-kill-paragraph () 56(ert-deftest paragraphs-tests-kill-paragraph ()
57 (with-temp-buffer 57 (with-temp-buffer
diff --git a/test/lisp/url/url-expand-tests.el b/test/lisp/url/url-expand-tests.el
index 6e0ce869502..3b0b6fbd41a 100644
--- a/test/lisp/url/url-expand-tests.el
+++ b/test/lisp/url/url-expand-tests.el
@@ -100,6 +100,13 @@
100 (should (equal (url-expand-file-name "foo#bar" "http://host/foobar") "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"))) 101 (should (equal (url-expand-file-name "foo#bar" "http://host/foobar/") "http://host/foobar/foo#bar")))
102 102
103(ert-deftest url-expand-file-name/relative-resolution-file-url ()
104 "RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.1. Normal Examples"
105 (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/foo.html") "file:///a/b/c/bar.html"))
106 (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/") "file:///a/b/c/bar.html"))
107 (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/") "file:///a/b/d/bar.html"))
108 (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/foo.html") "file:///a/b/d/bar.html")))
109
103(provide 'url-expand-tests) 110(provide 'url-expand-tests)
104 111
105;;; url-expand-tests.el ends here 112;;; url-expand-tests.el ends here
diff --git a/test/manual/etags/c-src/abbrev.c b/test/manual/etags/c-src/abbrev.c
index 03b9f0e65b8..44563d6046a 100644
--- a/test/manual/etags/c-src/abbrev.c
+++ b/test/manual/etags/c-src/abbrev.c
@@ -78,9 +78,6 @@ Lisp_Object Vlast_abbrev_text;
78 78
79int last_abbrev_point; 79int last_abbrev_point;
80 80
81/* Hook to run before expanding any abbrev. */
82
83Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook;
84 81
85DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0, 82DEFUN ("make-abbrev-table", Fmake_abbrev_table, Smake_abbrev_table, 0, 0, 0,
86 "Create a new, empty abbrev table object.") 83 "Create a new, empty abbrev table object.")
@@ -232,9 +229,6 @@ Returns the abbrev symbol, if expansion took place.")
232 229
233 value = Qnil; 230 value = Qnil;
234 231
235 if (!NILP (Vrun_hooks))
236 call1 (Vrun_hooks, Qpre_abbrev_expand_hook);
237
238 wordstart = 0; 232 wordstart = 0;
239 if (!(BUFFERP (Vabbrev_start_location_buffer) 233 if (!(BUFFERP (Vabbrev_start_location_buffer)
240 && XBUFFER (Vabbrev_start_location_buffer) == current_buffer)) 234 && XBUFFER (Vabbrev_start_location_buffer) == current_buffer))
@@ -595,14 +589,6 @@ This causes `save-some-buffers' to offer to save the abbrevs.");
595 "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so."); 589 "*Set non-nil means expand multi-word abbrevs all caps if abbrev was so.");
596 abbrev_all_caps = 0; 590 abbrev_all_caps = 0;
597 591
598 DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook,
599 "Function or functions to be called before abbrev expansion is done.\n\
600This is the first thing that `expand-abbrev' does, and so this may change\n\
601the current abbrev table before abbrev lookup happens.");
602 Vpre_abbrev_expand_hook = Qnil;
603 Qpre_abbrev_expand_hook = intern ("pre-abbrev-expand-hook");
604 staticpro (&Qpre_abbrev_expand_hook);
605
606 defsubr (&Smake_abbrev_table); 592 defsubr (&Smake_abbrev_table);
607 defsubr (&Sclear_abbrev_table); 593 defsubr (&Sclear_abbrev_table);
608 defsubr (&Sdefine_abbrev); 594 defsubr (&Sdefine_abbrev);
diff --git a/test/manual/image-circular-tests.el b/test/manual/image-circular-tests.el
new file mode 100644
index 00000000000..33ea3ea9547
--- /dev/null
+++ b/test/manual/image-circular-tests.el
@@ -0,0 +1,144 @@
1;;; image-tests.el --- Test suite for image-related functions.
2
3;; Copyright (C) 2019 Free Software Foundation, Inc.
4
5;; Author: Pip Cet <pipcet@gmail.com>
6;; Keywords: internal
7;; Human-Keywords: internal
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;;; Code:
27
28(require 'ert)
29
30(ert-deftest image-test-duplicate-keywords ()
31 "Test that duplicate keywords in an image spec lead to rejection."
32 (should-error (image-size `(image :type xbm :type xbm :width 1 :height 1
33 :data ,(bool-vector t))
34 t)))
35
36(ert-deftest image-test-circular-plist ()
37 "Test that a circular image spec is rejected."
38 (should-error
39 (let ((l `(image :type xbm :width 1 :height 1 :data ,(bool-vector t))))
40 (setcdr (last l) '#1=(:invalid . #1#))
41 (image-size l t))))
42
43(ert-deftest image-test-:type-property-value ()
44 "Test that :type is allowed as a property value in an image spec."
45 (should (equal (image-size `(image :dummy :type :type xbm :width 1 :height 1
46 :data ,(bool-vector t))
47 t)
48 (cons 1 1))))
49
50(ert-deftest image-test-circular-specs ()
51 "Test that circular image spec property values do not cause infinite recursion."
52 (should
53 (let* ((circ1 (cons :dummy nil))
54 (circ2 (cons :dummy nil))
55 (spec1 `(image :type xbm :width 1 :height 1
56 :data ,(bool-vector 1) :ignored ,circ1))
57 (spec2 `(image :type xbm :width 1 :height 1
58 :data ,(bool-vector 1) :ignored ,circ2)))
59 (setcdr circ1 circ1)
60 (setcdr circ2 circ2)
61 (and (equal (image-size spec1 t) (cons 1 1))
62 (equal (image-size spec2 t) (cons 1 1))))))
63
64(provide 'image-tests)
65;;; image-tests.el ends here.
66;;; image-tests.el --- tests for image.el -*- lexical-binding: t -*-
67
68;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
69
70;; This file is part of GNU Emacs.
71
72;; GNU Emacs is free software: you can redistribute it and/or modify
73;; it under the terms of the GNU General Public License as published by
74;; the Free Software Foundation, either version 3 of the License, or
75;; (at your option) any later version.
76
77;; GNU Emacs is distributed in the hope that it will be useful,
78;; but WITHOUT ANY WARRANTY; without even the implied warranty of
79;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
80;; GNU General Public License for more details.
81
82;; You should have received a copy of the GNU General Public License
83;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
84
85;;; Code:
86
87(require 'ert)
88(require 'image)
89(eval-when-compile
90 (require 'cl-lib))
91
92(defconst image-tests--emacs-images-directory
93 (expand-file-name "../etc/images" (getenv "EMACS_TEST_DIRECTORY"))
94 "Directory containing Emacs images.")
95
96(ert-deftest image--set-property ()
97 "Test `image--set-property' behavior."
98 (let ((image (list 'image)))
99 ;; Add properties.
100 (setf (image-property image :scale) 1)
101 (should (equal image '(image :scale 1)))
102 (setf (image-property image :width) 8)
103 (should (equal image '(image :scale 1 :width 8)))
104 (setf (image-property image :height) 16)
105 (should (equal image '(image :scale 1 :width 8 :height 16)))
106 ;; Delete properties.
107 (setf (image-property image :type) nil)
108 (should (equal image '(image :scale 1 :width 8 :height 16)))
109 (setf (image-property image :scale) nil)
110 (should (equal image '(image :width 8 :height 16)))
111 (setf (image-property image :height) nil)
112 (should (equal image '(image :width 8)))
113 (setf (image-property image :width) nil)
114 (should (equal image '(image)))))
115
116(ert-deftest image-type-from-file-header-test ()
117 "Test image-type-from-file-header."
118 (should (eq (if (image-type-available-p 'svg) 'svg)
119 (image-type-from-file-header
120 (expand-file-name "splash.svg"
121 image-tests--emacs-images-directory)))))
122
123(ert-deftest image-rotate ()
124 "Test `image-rotate'."
125 (cl-letf* ((image (list 'image))
126 ((symbol-function 'image--get-imagemagick-and-warn)
127 (lambda () image)))
128 (let ((current-prefix-arg '(4)))
129 (call-interactively #'image-rotate))
130 (should (equal image '(image :rotation 270.0)))
131 (call-interactively #'image-rotate)
132 (should (equal image '(image :rotation 0.0)))
133 (image-rotate)
134 (should (equal image '(image :rotation 90.0)))
135 (image-rotate 0)
136 (should (equal image '(image :rotation 90.0)))
137 (image-rotate 1)
138 (should (equal image '(image :rotation 91.0)))
139 (image-rotate 1234.5)
140 (should (equal image '(image :rotation 245.5)))
141 (image-rotate -154.5)
142 (should (equal image '(image :rotation 91.0)))))
143
144;;; image-tests.el ends here
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 092504565a6..33b307b1c6e 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -54,7 +54,8 @@ Check that the resulting binaries do not differ."
54 (comp-debug 0)) 54 (comp-debug 0))
55 (copy-file comp-src comp1-src t) 55 (copy-file comp-src comp1-src t)
56 (copy-file comp-src comp2-src t) 56 (copy-file comp-src comp2-src t)
57 (load (concat comp-src "c") nil nil t t) 57 (let ((load-no-native t))
58 (load (concat comp-src "c") nil nil t t))
58 (should-not (subr-native-elisp-p (symbol-function #'native-compile))) 59 (should-not (subr-native-elisp-p (symbol-function #'native-compile)))
59 (message "Compiling stage1...") 60 (message "Compiling stage1...")
60 (let ((comp1-eln (native-compile comp1-src))) 61 (let ((comp1-eln (native-compile comp1-src)))
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index f1faf58659a..400e9126486 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -895,3 +895,9 @@
895 ;; This does not test randomness; it's merely a format check. 895 ;; This does not test randomness; it's merely a format check.
896 (should (string-match "\\`[0-9a-f]\\{128\\}\\'" 896 (should (string-match "\\`[0-9a-f]\\{128\\}\\'"
897 (secure-hash 'sha512 'iv-auto 100)))) 897 (secure-hash 'sha512 'iv-auto 100))))
898
899(ert-deftest test-vector-delete ()
900 (let ((v1 (make-vector 1000 1)))
901 (should (equal (delete t [nil t]) [nil]))
902 (should (equal (delete 1 v1) (vector)))
903 (should (equal (delete 2 v1) v1))))