diff options
Diffstat (limited to 'test')
32 files changed, 1105 insertions, 234 deletions
diff --git a/test/Makefile.in b/test/Makefile.in index 414eca90564..ba823ec7e32 100644 --- a/test/Makefile.in +++ b/test/Makefile.in | |||
| @@ -136,7 +136,8 @@ endif | |||
| 136 | $(AM_V_ELC)$(emacs) -f batch-byte-compile $< | 136 | $(AM_V_ELC)$(emacs) -f batch-byte-compile $< |
| 137 | 137 | ||
| 138 | ## Save logs, and show logs for failed tests. | 138 | ## Save logs, and show logs for failed tests. |
| 139 | WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } | 139 | WRITE_LOG = $(if $(and ${EMACS_HYDRA_CI}, $(findstring tramp, $@)), |& tee $@, > $@ 2>&1) \ |
| 140 | || { STAT=$$?; cat $@; exit $$STAT; } | ||
| 140 | 141 | ||
| 141 | ifeq ($(TEST_LOAD_EL), yes) | 142 | ifeq ($(TEST_LOAD_EL), yes) |
| 142 | testloadfile = $*.el | 143 | testloadfile = $*.el |
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index eee9466c5d6..42e1c2bd4ae 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c | |||
| @@ -235,6 +235,27 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args, | |||
| 235 | return invalid_stored_value; | 235 | return invalid_stored_value; |
| 236 | } | 236 | } |
| 237 | 237 | ||
| 238 | /* An invalid finalizer: Finalizers are run during garbage collection, | ||
| 239 | where Lisp code can’t be executed. -module-assertions tests for | ||
| 240 | this case. */ | ||
| 241 | |||
| 242 | static emacs_env *current_env; | ||
| 243 | |||
| 244 | static void | ||
| 245 | invalid_finalizer (void *ptr) | ||
| 246 | { | ||
| 247 | current_env->intern (current_env, "nil"); | ||
| 248 | } | ||
| 249 | |||
| 250 | static emacs_value | ||
| 251 | Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args, | ||
| 252 | void *data) | ||
| 253 | { | ||
| 254 | current_env = env; | ||
| 255 | env->make_user_ptr (env, invalid_finalizer, NULL); | ||
| 256 | return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL); | ||
| 257 | } | ||
| 258 | |||
| 238 | 259 | ||
| 239 | /* Lisp utilities for easier readability (simple wrappers). */ | 260 | /* Lisp utilities for easier readability (simple wrappers). */ |
| 240 | 261 | ||
| @@ -300,6 +321,8 @@ emacs_module_init (struct emacs_runtime *ert) | |||
| 300 | DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL); | 321 | DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL); |
| 301 | DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL); | 322 | DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL); |
| 302 | DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL); | 323 | DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL); |
| 324 | DEFUN ("mod-test-invalid-finalizer", Fmod_test_invalid_finalizer, 0, 0, | ||
| 325 | NULL, NULL); | ||
| 303 | 326 | ||
| 304 | #undef DEFUN | 327 | #undef DEFUN |
| 305 | 328 | ||
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 1b814baac58..69331457c0e 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el | |||
| @@ -21,7 +21,7 @@ | |||
| 21 | (require 'ert) | 21 | (require 'ert) |
| 22 | (require 'dired) | 22 | (require 'dired) |
| 23 | (require 'nadvice) | 23 | (require 'nadvice) |
| 24 | 24 | (require 'ls-lisp) | |
| 25 | 25 | ||
| 26 | (ert-deftest dired-autoload () | 26 | (ert-deftest dired-autoload () |
| 27 | "Tests to see whether dired-x has been autoloaded" | 27 | "Tests to see whether dired-x has been autoloaded" |
| @@ -38,19 +38,21 @@ | |||
| 38 | (file "test") | 38 | (file "test") |
| 39 | (full-name (expand-file-name file dir)) | 39 | (full-name (expand-file-name file dir)) |
| 40 | (regexp "bar") | 40 | (regexp "bar") |
| 41 | (dired-always-read-filesystem t)) | 41 | (dired-always-read-filesystem t) buffers) |
| 42 | (if (file-exists-p dir) | 42 | (if (file-exists-p dir) |
| 43 | (delete-directory dir 'recursive)) | 43 | (delete-directory dir 'recursive)) |
| 44 | (make-directory dir) | 44 | (make-directory dir) |
| 45 | (with-temp-file full-name (insert "foo")) | 45 | (with-temp-file full-name (insert "foo")) |
| 46 | (find-file-noselect full-name) | 46 | (push (find-file-noselect full-name) buffers) |
| 47 | (dired dir) | 47 | (push (dired dir) buffers) |
| 48 | (with-temp-file full-name (insert "bar")) | 48 | (with-temp-file full-name (insert "bar")) |
| 49 | (dired-mark-files-containing-regexp regexp) | 49 | (dired-mark-files-containing-regexp regexp) |
| 50 | (unwind-protect | 50 | (unwind-protect |
| 51 | (should (equal (dired-get-marked-files nil nil nil 'distinguish-1-mark) | 51 | (should (equal (dired-get-marked-files nil nil nil 'distinguish-1-mark) |
| 52 | `(t ,full-name))) | 52 | `(t ,full-name))) |
| 53 | ;; Clean up | 53 | ;; Clean up |
| 54 | (dolist (buf buffers) | ||
| 55 | (when (buffer-live-p buf) (kill-buffer buf))) | ||
| 54 | (delete-directory dir 'recursive)))) | 56 | (delete-directory dir 'recursive)))) |
| 55 | 57 | ||
| 56 | (ert-deftest dired-test-bug25609 () | 58 | (ert-deftest dired-test-bug25609 () |
| @@ -60,7 +62,8 @@ | |||
| 60 | (target (expand-file-name (file-name-nondirectory from) to)) | 62 | (target (expand-file-name (file-name-nondirectory from) to)) |
| 61 | (nested (expand-file-name (file-name-nondirectory from) target)) | 63 | (nested (expand-file-name (file-name-nondirectory from) target)) |
| 62 | (dired-dwim-target t) | 64 | (dired-dwim-target t) |
| 63 | (dired-recursive-copies 'always)) ; Don't prompt me. | 65 | (dired-recursive-copies 'always) ; Don't prompt me. |
| 66 | buffers) | ||
| 64 | (advice-add 'dired-query ; Don't ask confirmation to overwrite a file. | 67 | (advice-add 'dired-query ; Don't ask confirmation to overwrite a file. |
| 65 | :override | 68 | :override |
| 66 | (lambda (_sym _prompt &rest _args) (setq dired-query t)) | 69 | (lambda (_sym _prompt &rest _args) (setq dired-query t)) |
| @@ -70,8 +73,8 @@ | |||
| 70 | (lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap) | 73 | (lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap) |
| 71 | init) | 74 | init) |
| 72 | '((name . "advice-completing-read"))) | 75 | '((name . "advice-completing-read"))) |
| 73 | (dired to) | 76 | (push (dired to) buffers) |
| 74 | (dired-other-window temporary-file-directory) | 77 | (push (dired-other-window temporary-file-directory) buffers) |
| 75 | (dired-goto-file from) | 78 | (dired-goto-file from) |
| 76 | (dired-do-copy) | 79 | (dired-do-copy) |
| 77 | (dired-do-copy); Again. | 80 | (dired-do-copy); Again. |
| @@ -79,10 +82,98 @@ | |||
| 79 | (progn | 82 | (progn |
| 80 | (should (file-exists-p target)) | 83 | (should (file-exists-p target)) |
| 81 | (should-not (file-exists-p nested))) | 84 | (should-not (file-exists-p nested))) |
| 85 | (dolist (buf buffers) | ||
| 86 | (when (buffer-live-p buf) (kill-buffer buf))) | ||
| 82 | (delete-directory from 'recursive) | 87 | (delete-directory from 'recursive) |
| 83 | (delete-directory to 'recursive) | 88 | (delete-directory to 'recursive) |
| 84 | (advice-remove 'dired-query "advice-dired-query") | 89 | (advice-remove 'dired-query "advice-dired-query") |
| 85 | (advice-remove 'completing-read "advice-completing-read")))) | 90 | (advice-remove 'completing-read "advice-completing-read")))) |
| 86 | 91 | ||
| 92 | (ert-deftest dired-test-bug27243 () | ||
| 93 | "Test for http://debbugs.gnu.org/27243 ." | ||
| 94 | (let ((test-dir (make-temp-file "test-dir-" t)) | ||
| 95 | (dired-auto-revert-buffer t) buffers) | ||
| 96 | (with-current-buffer (find-file-noselect test-dir) | ||
| 97 | (make-directory "test-subdir")) | ||
| 98 | (push (dired test-dir) buffers) | ||
| 99 | (unwind-protect | ||
| 100 | (let ((buf (current-buffer)) | ||
| 101 | (pt1 (point)) | ||
| 102 | (test-file (concat (file-name-as-directory "test-subdir") | ||
| 103 | "test-file"))) | ||
| 104 | (write-region "Test" nil test-file nil 'silent nil 'excl) | ||
| 105 | ;; Sanity check: point should now be on the subdirectory. | ||
| 106 | (should (equal (dired-file-name-at-point) | ||
| 107 | (concat (file-name-as-directory test-dir) | ||
| 108 | (file-name-as-directory "test-subdir")))) | ||
| 109 | (push (dired-find-file) buffers) | ||
| 110 | (let ((pt2 (point))) ; Point is on test-file. | ||
| 111 | (switch-to-buffer buf) | ||
| 112 | ;; Sanity check: point should now be back on the subdirectory. | ||
| 113 | (should (eq (point) pt1)) | ||
| 114 | ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 | ||
| 115 | (push (dired-find-file) buffers) | ||
| 116 | (should (eq (point) pt2)) | ||
| 117 | ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 | ||
| 118 | (push (dired test-dir) buffers) | ||
| 119 | (should (eq (point) pt1)))) | ||
| 120 | (dolist (buf buffers) | ||
| 121 | (when (buffer-live-p buf) (kill-buffer buf))) | ||
| 122 | (delete-directory test-dir t)))) | ||
| 123 | |||
| 124 | (ert-deftest dired-test-bug27693 () | ||
| 125 | "Test for http://debbugs.gnu.org/27693 ." | ||
| 126 | (let ((dir (expand-file-name "lisp" source-directory)) | ||
| 127 | (size "") | ||
| 128 | ls-lisp-use-insert-directory-program buf) | ||
| 129 | (unwind-protect | ||
| 130 | (progn | ||
| 131 | (setq buf (dired (list dir "simple.el" "subr.el")) | ||
| 132 | size (number-to-string | ||
| 133 | (file-attribute-size | ||
| 134 | (file-attributes (dired-get-filename))))) | ||
| 135 | (search-backward-regexp size nil t) | ||
| 136 | (should (looking-back "[[:space:]]" (1- (point))))) | ||
| 137 | (when (buffer-live-p buf) (kill-buffer buf))))) | ||
| 138 | |||
| 139 | (ert-deftest dired-test-bug7131 () | ||
| 140 | "Test for http://debbugs.gnu.org/7131 ." | ||
| 141 | (let* ((dir (expand-file-name "lisp" source-directory)) | ||
| 142 | (buf (dired dir))) | ||
| 143 | (unwind-protect | ||
| 144 | (progn | ||
| 145 | (setq buf (dired (list dir "simple.el"))) | ||
| 146 | (dired-toggle-marks) | ||
| 147 | (should-not (cdr (dired-get-marked-files))) | ||
| 148 | (kill-buffer buf) | ||
| 149 | (setq buf (dired (list dir "simple.el")) | ||
| 150 | buf (dired dir)) | ||
| 151 | (dired-toggle-marks) | ||
| 152 | (should (cdr (dired-get-marked-files)))) | ||
| 153 | (when (buffer-live-p buf) (kill-buffer buf))))) | ||
| 154 | |||
| 155 | (ert-deftest dired-test-bug27762 () | ||
| 156 | "Test for http://debbugs.gnu.org/27762 ." | ||
| 157 | :expected-result :failed | ||
| 158 | (let* ((dir source-directory) | ||
| 159 | (default-directory dir) | ||
| 160 | (files (mapcar (lambda (f) (concat "src/" f)) | ||
| 161 | (directory-files | ||
| 162 | (expand-file-name "src") nil "\\.*\\.c\\'"))) | ||
| 163 | ls-lisp-use-insert-directory-program buf) | ||
| 164 | (unwind-protect | ||
| 165 | (let ((file1 "src/cygw32.c") | ||
| 166 | (file2 "src/atimer.c")) | ||
| 167 | (setq buf (dired (nconc (list dir) files))) | ||
| 168 | (dired-goto-file (expand-file-name file2 default-directory)) | ||
| 169 | (should-not (looking-at "^ -")) ; Must be 2 spaces not 3. | ||
| 170 | (setq files (cons file1 (delete file1 files))) | ||
| 171 | (kill-buffer buf) | ||
| 172 | (setq buf (dired (nconc (list dir) files))) | ||
| 173 | (should (looking-at "src")) | ||
| 174 | (next-line) ; File names must be aligned. | ||
| 175 | (should (looking-at "src"))) | ||
| 176 | (when (buffer-live-p buf) (kill-buffer buf))))) | ||
| 177 | |||
| 87 | (provide 'dired-tests) | 178 | (provide 'dired-tests) |
| 88 | ;; dired-tests.el ends here | 179 | ;; dired-tests.el ends here |
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index c4ccec7a0d8..c6ffccc0794 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el | |||
| @@ -694,6 +694,8 @@ baz\"\"" | |||
| 694 | :bindings '((electric-quote-context-sensitive . t)) | 694 | :bindings '((electric-quote-context-sensitive . t)) |
| 695 | :test-in-comments nil :test-in-strings nil) | 695 | :test-in-comments nil :test-in-strings nil) |
| 696 | 696 | ||
| 697 | ;; Simulate ‘markdown-mode’: it sets both ‘comment-start’ and | ||
| 698 | ;; ‘comment-use-syntax’, but derives from ‘text-mode’. | ||
| 697 | (define-electric-pair-test electric-quote-markdown-in-text | 699 | (define-electric-pair-test electric-quote-markdown-in-text |
| 698 | "" "'" :expected-string "’" :expected-point 2 | 700 | "" "'" :expected-string "’" :expected-point 2 |
| 699 | :modes '(text-mode) | 701 | :modes '(text-mode) |
| @@ -703,6 +705,7 @@ baz\"\"" | |||
| 703 | (lambda () | 705 | (lambda () |
| 704 | (save-excursion (search-backward "`" nil t))) | 706 | (save-excursion (search-backward "`" nil t))) |
| 705 | nil :local)) | 707 | nil :local)) |
| 708 | :bindings '((comment-start . "<!--") (comment-use-syntax . t)) | ||
| 706 | :test-in-comments nil :test-in-strings nil) | 709 | :test-in-comments nil :test-in-strings nil) |
| 707 | 710 | ||
| 708 | (define-electric-pair-test electric-quote-markdown-in-code | 711 | (define-electric-pair-test electric-quote-markdown-in-code |
| @@ -714,6 +717,7 @@ baz\"\"" | |||
| 714 | (lambda () | 717 | (lambda () |
| 715 | (save-excursion (search-backward "`" nil t))) | 718 | (save-excursion (search-backward "`" nil t))) |
| 716 | nil :local)) | 719 | nil :local)) |
| 720 | :bindings '((comment-start . "<!--") (comment-use-syntax . t)) | ||
| 717 | :test-in-comments nil :test-in-strings nil) | 721 | :test-in-comments nil :test-in-strings nil) |
| 718 | 722 | ||
| 719 | (provide 'electric-tests) | 723 | (provide 'electric-tests) |
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el index 241ca65122d..3df2157cc83 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el | |||
| @@ -192,7 +192,7 @@ | |||
| 192 | (ert-deftest eieio-test-method-order-list-6 () | 192 | (ert-deftest eieio-test-method-order-list-6 () |
| 193 | ;; FIXME repeated intermittent failures on hydra (bug#24503) | 193 | ;; FIXME repeated intermittent failures on hydra (bug#24503) |
| 194 | ;; ((:STATIC C) (:STATIC C-base1) (:STATIC C-base2)) != ((:STATIC C))") | 194 | ;; ((:STATIC C) (:STATIC C-base1) (:STATIC C-base2)) != ((:STATIC C))") |
| 195 | (skip-unless (not (getenv "NIX_STORE"))) | 195 | (skip-unless (not (getenv "EMACS_HYDRA_CI"))) |
| 196 | (let ((eieio-test-method-order-list nil) | 196 | (let ((eieio-test-method-order-list nil) |
| 197 | (ans '( | 197 | (ans '( |
| 198 | (:STATIC C) | 198 | (:STATIC C) |
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index c34560ab585..1a6ab9da085 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | |||
| @@ -894,7 +894,7 @@ Subclasses to override slot attributes.") | |||
| 894 | 894 | ||
| 895 | (ert-deftest eieio-test-37-obsolete-name-in-constructor () | 895 | (ert-deftest eieio-test-37-obsolete-name-in-constructor () |
| 896 | ;; FIXME repeated intermittent failures on hydra (bug#24503) | 896 | ;; FIXME repeated intermittent failures on hydra (bug#24503) |
| 897 | (skip-unless (not (getenv "NIX_STORE"))) | 897 | (skip-unless (not (getenv "EMACS_HYDRA_CI"))) |
| 898 | (should (equal (eieio--testing "toto") '("toto" 2)))) | 898 | (should (equal (eieio--testing "toto") '("toto" 2)))) |
| 899 | 899 | ||
| 900 | (ert-deftest eieio-autoload () | 900 | (ert-deftest eieio-autoload () |
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 07e85cc5391..15b0655040c 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el | |||
| @@ -63,6 +63,11 @@ Evaluate BODY for each created map. | |||
| 63 | (with-maps-do map | 63 | (with-maps-do map |
| 64 | (should (= 5 (map-elt map 7 5))))) | 64 | (should (= 5 (map-elt map 7 5))))) |
| 65 | 65 | ||
| 66 | (ert-deftest test-map-elt-testfn () | ||
| 67 | (let ((map (list (cons "a" 1) (cons "b" 2)))) | ||
| 68 | (should-not (map-elt map "a")) | ||
| 69 | (should (map-elt map "a" nil 'equal)))) | ||
| 70 | |||
| 66 | (ert-deftest test-map-elt-with-nil-value () | 71 | (ert-deftest test-map-elt-with-nil-value () |
| 67 | (should (null (map-elt '((a . 1) | 72 | (should (null (map-elt '((a . 1) |
| 68 | (b)) | 73 | (b)) |
| @@ -94,6 +99,13 @@ Evaluate BODY for each created map. | |||
| 94 | (should (eq (map-elt alist 2) | 99 | (should (eq (map-elt alist 2) |
| 95 | 'b)))) | 100 | 'b)))) |
| 96 | 101 | ||
| 102 | (ert-deftest test-map-put-testfn-alist () | ||
| 103 | (let ((alist (list (cons "a" 1) (cons "b" 2)))) | ||
| 104 | (map-put alist "a" 3 'equal) | ||
| 105 | (should-not (cddr alist)) | ||
| 106 | (map-put alist "a" 9) | ||
| 107 | (should (cddr alist)))) | ||
| 108 | |||
| 97 | (ert-deftest test-map-put-return-value () | 109 | (ert-deftest test-map-put-return-value () |
| 98 | (let ((ht (make-hash-table))) | 110 | (let ((ht (make-hash-table))) |
| 99 | (should (eq (map-put ht 'a 'hello) 'hello)))) | 111 | (should (eq (map-put ht 'a 'hello) 'hello)))) |
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 8b7945c9d27..8f353b7e863 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el | |||
| @@ -33,5 +33,15 @@ | |||
| 33 | (number-sequence ?< ?\]) | 33 | (number-sequence ?< ?\]) |
| 34 | (number-sequence ?- ?:)))))) | 34 | (number-sequence ?- ?:)))))) |
| 35 | 35 | ||
| 36 | (ert-deftest rx-pcase () | ||
| 37 | (should (equal (pcase "a 1 2 3 1 1 b" | ||
| 38 | ((rx (let u (+ digit)) space | ||
| 39 | (let v (+ digit)) space | ||
| 40 | (let v (+ digit)) space | ||
| 41 | (backref u) space | ||
| 42 | (backref 1)) | ||
| 43 | (list u v))) | ||
| 44 | '("1" "3")))) | ||
| 45 | |||
| 36 | (provide 'rx-tests) | 46 | (provide 'rx-tests) |
| 37 | ;; rx-tests.el ends here. | 47 | ;; rx-tests.el ends here. |
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 8d05ceacee2..3456d31fda9 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el | |||
| @@ -173,8 +173,8 @@ Return nil when any other file notification watch is still active." | |||
| 173 | tramp-verbose 0 | 173 | tramp-verbose 0 |
| 174 | tramp-message-show-message nil) | 174 | tramp-message-show-message nil) |
| 175 | 175 | ||
| 176 | ;; This shall happen on hydra only. | 176 | ;; This should happen on hydra only. |
| 177 | (when (getenv "NIX_STORE") | 177 | (when (getenv "EMACS_HYDRA_CI") |
| 178 | (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) | 178 | (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) |
| 179 | 179 | ||
| 180 | ;; We do not want to try and fail `file-notify-add-watch'. | 180 | ;; We do not want to try and fail `file-notify-add-watch'. |
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index b9f7fe7cde8..af75aa0ec7f 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el | |||
| @@ -32,7 +32,7 @@ | |||
| 32 | (declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier)) | 32 | (declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier)) |
| 33 | (declare-function ibuffer-unary-operand "ibuf-ext" (filter)) | 33 | (declare-function ibuffer-unary-operand "ibuf-ext" (filter)) |
| 34 | 34 | ||
| 35 | (ert-deftest ibuffer-autoload () | 35 | (ert-deftest ibuffer-0autoload () ; sort first |
| 36 | "Tests to see whether ibuffer has been autoloaded" | 36 | "Tests to see whether ibuffer has been autoloaded" |
| 37 | (skip-unless (not (featurep 'ibuf-ext))) | 37 | (skip-unless (not (featurep 'ibuf-ext))) |
| 38 | (should | 38 | (should |
| @@ -76,7 +76,7 @@ | |||
| 76 | 76 | ||
| 77 | (ert-deftest ibuffer-save-filters () | 77 | (ert-deftest ibuffer-save-filters () |
| 78 | "Tests that `ibuffer-save-filters' saves in the proper format." | 78 | "Tests that `ibuffer-save-filters' saves in the proper format." |
| 79 | (skip-unless (featurep 'ibuf-ext)) | 79 | (require 'ibuf-ext) |
| 80 | (let ((ibuffer-save-with-custom nil) | 80 | (let ((ibuffer-save-with-custom nil) |
| 81 | (ibuffer-saved-filters nil) | 81 | (ibuffer-saved-filters nil) |
| 82 | (test1 '((mode . org-mode) | 82 | (test1 '((mode . org-mode) |
| @@ -150,6 +150,7 @@ | |||
| 150 | 150 | ||
| 151 | ;; Test Filter Inclusion | 151 | ;; Test Filter Inclusion |
| 152 | (let* (test-buffer-list ; accumulated buffers to clean up | 152 | (let* (test-buffer-list ; accumulated buffers to clean up |
| 153 | test-file-list | ||
| 153 | ;; Utility functions without polluting the environment | 154 | ;; Utility functions without polluting the environment |
| 154 | (set-buffer-mode | 155 | (set-buffer-mode |
| 155 | (lambda (buffer mode) | 156 | (lambda (buffer mode) |
| @@ -192,6 +193,7 @@ | |||
| 192 | (file (make-temp-file prefix nil suffix)) | 193 | (file (make-temp-file prefix nil suffix)) |
| 193 | (buf (find-file-noselect file t))) | 194 | (buf (find-file-noselect file t))) |
| 194 | (push buf test-buffer-list) ; record for cleanup | 195 | (push buf test-buffer-list) ; record for cleanup |
| 196 | (push file test-file-list) | ||
| 195 | (funcall set-buffer-mode buf mode) | 197 | (funcall set-buffer-mode buf mode) |
| 196 | (funcall set-buffer-contents buf size include) | 198 | (funcall set-buffer-contents buf size include) |
| 197 | buf))) | 199 | buf))) |
| @@ -213,6 +215,8 @@ | |||
| 213 | (clean-up | 215 | (clean-up |
| 214 | (lambda () | 216 | (lambda () |
| 215 | "Restore all emacs state modified during the tests" | 217 | "Restore all emacs state modified during the tests" |
| 218 | (dolist (f test-file-list) | ||
| 219 | (and f (file-exists-p f) (delete-file f))) | ||
| 216 | (while test-buffer-list ; created temporary buffers | 220 | (while test-buffer-list ; created temporary buffers |
| 217 | (let ((buf (pop test-buffer-list))) | 221 | (let ((buf (pop test-buffer-list))) |
| 218 | (with-current-buffer buf (bury-buffer)) ; ensure not selected | 222 | (with-current-buffer buf (bury-buffer)) ; ensure not selected |
| @@ -220,7 +224,7 @@ | |||
| 220 | ;; Tests | 224 | ;; Tests |
| 221 | (ert-deftest ibuffer-filter-inclusion-1 () | 225 | (ert-deftest ibuffer-filter-inclusion-1 () |
| 222 | "Tests inclusion using basic filter combinators with a single buffer." | 226 | "Tests inclusion using basic filter combinators with a single buffer." |
| 223 | (skip-unless (featurep 'ibuf-ext)) | 227 | (require 'ibuf-ext) |
| 224 | (unwind-protect | 228 | (unwind-protect |
| 225 | (let ((buf | 229 | (let ((buf |
| 226 | (funcall create-file-buffer "ibuf-test-1" :size 100 | 230 | (funcall create-file-buffer "ibuf-test-1" :size 100 |
| @@ -263,7 +267,7 @@ | |||
| 263 | 267 | ||
| 264 | (ert-deftest ibuffer-filter-inclusion-2 () | 268 | (ert-deftest ibuffer-filter-inclusion-2 () |
| 265 | "Tests inclusion of basic filters in combination on a single buffer." | 269 | "Tests inclusion of basic filters in combination on a single buffer." |
| 266 | (skip-unless (featurep 'ibuf-ext)) | 270 | (require 'ibuf-ext) |
| 267 | (unwind-protect | 271 | (unwind-protect |
| 268 | (let ((buf | 272 | (let ((buf |
| 269 | (funcall create-file-buffer "ibuf-test-2" :size 200 | 273 | (funcall create-file-buffer "ibuf-test-2" :size 200 |
| @@ -298,7 +302,7 @@ | |||
| 298 | 302 | ||
| 299 | (ert-deftest ibuffer-filter-inclusion-3 () | 303 | (ert-deftest ibuffer-filter-inclusion-3 () |
| 300 | "Tests inclusion with filename filters on specified buffers." | 304 | "Tests inclusion with filename filters on specified buffers." |
| 301 | (skip-unless (featurep 'ibuf-ext)) | 305 | (require 'ibuf-ext) |
| 302 | (unwind-protect | 306 | (unwind-protect |
| 303 | (let* ((bufA | 307 | (let* ((bufA |
| 304 | (funcall create-file-buffer "ibuf-test-3.a" :size 50 | 308 | (funcall create-file-buffer "ibuf-test-3.a" :size 50 |
| @@ -332,7 +336,7 @@ | |||
| 332 | 336 | ||
| 333 | (ert-deftest ibuffer-filter-inclusion-4 () | 337 | (ert-deftest ibuffer-filter-inclusion-4 () |
| 334 | "Tests inclusion with various filters on a single buffer." | 338 | "Tests inclusion with various filters on a single buffer." |
| 335 | (skip-unless (featurep 'ibuf-ext)) | 339 | (require 'ibuf-ext) |
| 336 | (unwind-protect | 340 | (unwind-protect |
| 337 | (let ((buf | 341 | (let ((buf |
| 338 | (funcall create-file-buffer "ibuf-test-4" | 342 | (funcall create-file-buffer "ibuf-test-4" |
| @@ -366,7 +370,7 @@ | |||
| 366 | 370 | ||
| 367 | (ert-deftest ibuffer-filter-inclusion-5 () | 371 | (ert-deftest ibuffer-filter-inclusion-5 () |
| 368 | "Tests inclusion with various filters on a single buffer." | 372 | "Tests inclusion with various filters on a single buffer." |
| 369 | (skip-unless (featurep 'ibuf-ext)) | 373 | (require 'ibuf-ext) |
| 370 | (unwind-protect | 374 | (unwind-protect |
| 371 | (let ((buf | 375 | (let ((buf |
| 372 | (funcall create-non-file-buffer "ibuf-test-5.el" | 376 | (funcall create-non-file-buffer "ibuf-test-5.el" |
| @@ -392,7 +396,7 @@ | |||
| 392 | 396 | ||
| 393 | (ert-deftest ibuffer-filter-inclusion-6 () | 397 | (ert-deftest ibuffer-filter-inclusion-6 () |
| 394 | "Tests inclusion using saved filters and DeMorgan's laws." | 398 | "Tests inclusion using saved filters and DeMorgan's laws." |
| 395 | (skip-unless (featurep 'ibuf-ext)) | 399 | (require 'ibuf-ext) |
| 396 | (unwind-protect | 400 | (unwind-protect |
| 397 | (let ((buf | 401 | (let ((buf |
| 398 | (funcall create-non-file-buffer "*ibuf-test-6*" :size 65 | 402 | (funcall create-non-file-buffer "*ibuf-test-6*" :size 65 |
| @@ -425,7 +429,7 @@ | |||
| 425 | 429 | ||
| 426 | (ert-deftest ibuffer-filter-inclusion-7 () | 430 | (ert-deftest ibuffer-filter-inclusion-7 () |
| 427 | "Tests inclusion with various filters on a single buffer." | 431 | "Tests inclusion with various filters on a single buffer." |
| 428 | (skip-unless (featurep 'ibuf-ext)) | 432 | (require 'ibuf-ext) |
| 429 | (unwind-protect | 433 | (unwind-protect |
| 430 | (let ((buf | 434 | (let ((buf |
| 431 | (funcall create-non-file-buffer "ibuf-test-7" | 435 | (funcall create-non-file-buffer "ibuf-test-7" |
| @@ -446,7 +450,7 @@ | |||
| 446 | 450 | ||
| 447 | (ert-deftest ibuffer-filter-inclusion-8 () | 451 | (ert-deftest ibuffer-filter-inclusion-8 () |
| 448 | "Tests inclusion with various filters." | 452 | "Tests inclusion with various filters." |
| 449 | (skip-unless (featurep 'ibuf-ext)) | 453 | (require 'ibuf-ext) |
| 450 | (unwind-protect | 454 | (unwind-protect |
| 451 | (let ((bufA | 455 | (let ((bufA |
| 452 | (funcall create-non-file-buffer "ibuf-test-8a" | 456 | (funcall create-non-file-buffer "ibuf-test-8a" |
| @@ -534,7 +538,7 @@ | |||
| 534 | ;; Tests | 538 | ;; Tests |
| 535 | (ert-deftest ibuffer-decompose-filter () | 539 | (ert-deftest ibuffer-decompose-filter () |
| 536 | "Tests `ibuffer-decompose-filter' for and, or, not, and saved." | 540 | "Tests `ibuffer-decompose-filter' for and, or, not, and saved." |
| 537 | (skip-unless (featurep 'ibuf-ext)) | 541 | (require 'ibuf-ext) |
| 538 | (unwind-protect | 542 | (unwind-protect |
| 539 | (let ((ibuf (funcall get-test-ibuffer))) | 543 | (let ((ibuf (funcall get-test-ibuffer))) |
| 540 | (with-current-buffer ibuf | 544 | (with-current-buffer ibuf |
| @@ -583,7 +587,7 @@ | |||
| 583 | 587 | ||
| 584 | (ert-deftest ibuffer-and-filter () | 588 | (ert-deftest ibuffer-and-filter () |
| 585 | "Tests `ibuffer-and-filter' in an Ibuffer buffer." | 589 | "Tests `ibuffer-and-filter' in an Ibuffer buffer." |
| 586 | (skip-unless (featurep 'ibuf-ext)) | 590 | (require 'ibuf-ext) |
| 587 | (unwind-protect | 591 | (unwind-protect |
| 588 | (let ((ibuf (funcall get-test-ibuffer))) | 592 | (let ((ibuf (funcall get-test-ibuffer))) |
| 589 | (with-current-buffer ibuf | 593 | (with-current-buffer ibuf |
| @@ -660,7 +664,7 @@ | |||
| 660 | 664 | ||
| 661 | (ert-deftest ibuffer-or-filter () | 665 | (ert-deftest ibuffer-or-filter () |
| 662 | "Tests `ibuffer-or-filter' in an Ibuffer buffer." | 666 | "Tests `ibuffer-or-filter' in an Ibuffer buffer." |
| 663 | (skip-unless (featurep 'ibuf-ext)) | 667 | (require 'ibuf-ext) |
| 664 | (unwind-protect | 668 | (unwind-protect |
| 665 | (let ((ibuf (funcall get-test-ibuffer))) | 669 | (let ((ibuf (funcall get-test-ibuffer))) |
| 666 | (with-current-buffer ibuf | 670 | (with-current-buffer ibuf |
| @@ -737,7 +741,7 @@ | |||
| 737 | 741 | ||
| 738 | (ert-deftest ibuffer-format-qualifier () | 742 | (ert-deftest ibuffer-format-qualifier () |
| 739 | "Tests string recommendation of filter from `ibuffer-format-qualifier'." | 743 | "Tests string recommendation of filter from `ibuffer-format-qualifier'." |
| 740 | (skip-unless (featurep 'ibuf-ext)) | 744 | (require 'ibuf-ext) |
| 741 | (let ((test1 '(mode . org-mode)) | 745 | (let ((test1 '(mode . org-mode)) |
| 742 | (test2 '(size-lt . 100)) | 746 | (test2 '(size-lt . 100)) |
| 743 | (test3 '(derived-mode . prog-mode)) | 747 | (test3 '(derived-mode . prog-mode)) |
| @@ -802,7 +806,7 @@ | |||
| 802 | 806 | ||
| 803 | (ert-deftest ibuffer-unary-operand () | 807 | (ert-deftest ibuffer-unary-operand () |
| 804 | "Tests `ibuffer-unary-operand': (not cell) or (not . cell) -> cell." | 808 | "Tests `ibuffer-unary-operand': (not cell) or (not . cell) -> cell." |
| 805 | (skip-unless (featurep 'ibuf-ext)) | 809 | (require 'ibuf-ext) |
| 806 | (should (equal (ibuffer-unary-operand '(not . (mode "foo"))) | 810 | (should (equal (ibuffer-unary-operand '(not . (mode "foo"))) |
| 807 | '(mode "foo"))) | 811 | '(mode "foo"))) |
| 808 | (should (equal (ibuffer-unary-operand '(not (mode "foo"))) | 812 | (should (equal (ibuffer-unary-operand '(not (mode "foo"))) |
diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el index d85efe2d7bf..02a4bba7a5f 100644 --- a/test/lisp/international/ucs-normalize-tests.el +++ b/test/lisp/international/ucs-normalize-tests.el | |||
| @@ -26,15 +26,13 @@ | |||
| 26 | ;; If there are lines marked as failing (see | 26 | ;; If there are lines marked as failing (see |
| 27 | ;; `ucs-normalize-tests--failing-lines-part1' and | 27 | ;; `ucs-normalize-tests--failing-lines-part1' and |
| 28 | ;; `ucs-normalize-tests--failing-lines-part2'), they may need to be | 28 | ;; `ucs-normalize-tests--failing-lines-part2'), they may need to be |
| 29 | ;; adjusted when NormalizationTest.txt is updated. To get a list of | 29 | ;; adjusted when NormalizationTest.txt is updated. Run the function |
| 30 | ;; currently failing lines, set those 2 variables to nil, run the | 30 | ;; `ucs-normalize-check-failing-lines' to see what changes are needed. |
| 31 | ;; tests, and inspect the values of | ||
| 32 | ;; `ucs-normalize-tests--part1-rule1-failed-lines' and | ||
| 33 | ;; `ucs-normalize-tests--part1-rule2-failed-chars', respectively. | ||
| 34 | 31 | ||
| 35 | ;;; Code: | 32 | ;;; Code: |
| 36 | 33 | ||
| 37 | (eval-when-compile (require 'cl-lib)) | 34 | (eval-when-compile (require 'cl-lib)) |
| 35 | (require 'seq) | ||
| 38 | (require 'ert) | 36 | (require 'ert) |
| 39 | (require 'ucs-normalize) | 37 | (require 'ucs-normalize) |
| 40 | 38 | ||
| @@ -44,83 +42,98 @@ | |||
| 44 | (defun ucs-normalize-tests--parse-column () | 42 | (defun ucs-normalize-tests--parse-column () |
| 45 | (let ((chars nil) | 43 | (let ((chars nil) |
| 46 | (term nil)) | 44 | (term nil)) |
| 47 | (while (and (not (equal term ";")) | 45 | (while (and (not (eq term ?\;)) |
| 48 | (looking-at "\\([[:xdigit:]]\\{4,6\\}\\)\\([; ]\\)")) | 46 | (looking-at "\\([[:xdigit:]]\\{4,6\\}\\)\\([; ]\\)")) |
| 49 | (let ((code-point (match-string 1))) | 47 | (let ((code-point (match-string-no-properties 1))) |
| 50 | (setq term (match-string 2)) | 48 | (setq term (char-after (match-beginning 2))) |
| 51 | (goto-char (match-end 0)) | 49 | (goto-char (match-end 0)) |
| 52 | (push (string-to-number code-point 16) chars))) | 50 | (push (string-to-number code-point 16) chars))) |
| 53 | (nreverse chars))) | 51 | (apply #'string (nreverse chars)))) |
| 54 | 52 | ||
| 55 | (defmacro ucs-normalize-tests--normalize (norm str) | 53 | (defconst ucs-normalize-tests--norm-buf (generate-new-buffer " *ucs-normalizing-buffer*")) |
| 54 | |||
| 55 | (defmacro ucs-normalize-tests--normalization-equal-p (norm str equal-to) | ||
| 56 | "Like `ucs-normalize-string' but reuse current buffer for efficiency. | 56 | "Like `ucs-normalize-string' but reuse current buffer for efficiency. |
| 57 | And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD' for brevity." | 57 | And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD' for brevity." |
| 58 | (let ((norm-alist '((NFC . ucs-normalize-NFC-region) | 58 | (let ((norm-alist '((NFC . ucs-normalize-NFC-region) |
| 59 | (NFD . ucs-normalize-NFD-region) | 59 | (NFD . ucs-normalize-NFD-region) |
| 60 | (NFKC . ucs-normalize-NFKC-region) | 60 | (NFKC . ucs-normalize-NFKC-region) |
| 61 | (NFKD . ucs-normalize-NFKD-region)))) | 61 | (NFKD . ucs-normalize-NFKD-region)))) |
| 62 | `(save-restriction | 62 | `(with-current-buffer ucs-normalize-tests--norm-buf |
| 63 | (narrow-to-region (point) (point)) | 63 | (erase-buffer) |
| 64 | (insert ,str) | 64 | (insert ,str) |
| 65 | (funcall #',(cdr (assq norm norm-alist)) (point-min) (point-max)) | 65 | (,(cdr (assq norm norm-alist)) (point-min) (point-max)) |
| 66 | (delete-and-extract-region (point-min) (point-max))))) | 66 | (goto-char (point-min)) |
| 67 | (insert ,equal-to) | ||
| 68 | (eq (compare-buffer-substrings nil nil (point) nil (point) nil) 0)))) | ||
| 69 | |||
| 70 | (defmacro ucs-normalize-tests--normalization-chareq-p (norm char char-eq-to) | ||
| 71 | "Like `ucs-normalize-string' but reuse current buffer for efficiency. | ||
| 72 | And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD' for brevity." | ||
| 73 | (let ((norm-alist '((NFC . ucs-normalize-NFC-region) | ||
| 74 | (NFD . ucs-normalize-NFD-region) | ||
| 75 | (NFKC . ucs-normalize-NFKC-region) | ||
| 76 | (NFKD . ucs-normalize-NFKD-region)))) | ||
| 77 | `(with-current-buffer ucs-normalize-tests--norm-buf | ||
| 78 | (erase-buffer) | ||
| 79 | (insert ,char) | ||
| 80 | (,(cdr (assq norm norm-alist)) (point-min) (point-max)) | ||
| 81 | (and (eq (buffer-size) 1) | ||
| 82 | (eq (char-after (point-min)) ,char-eq-to))))) | ||
| 67 | 83 | ||
| 68 | (defvar ucs-normalize-tests--chars-part1 nil) | 84 | (defvar ucs-normalize-tests--chars-part1 nil) |
| 69 | 85 | ||
| 70 | (defun ucs-normalize-tests--invariants-hold-p (&rest columns) | 86 | (defsubst ucs-normalize-tests--rule1-holds-p (source nfc nfd nfkc nfkd) |
| 71 | "Check 1st conformance rule. | 87 | "Check 1st conformance rule. |
| 72 | The following invariants must be true for all conformant implementations..." | 88 | The following invariants must be true for all conformant implementations..." |
| 73 | (when ucs-normalize-tests--chars-part1 | 89 | (when ucs-normalize-tests--chars-part1 |
| 74 | ;; See `ucs-normalize-tests--invariants-rule2-hold-p'. | 90 | ;; See `ucs-normalize-tests--rule2-holds-p'. |
| 75 | (aset ucs-normalize-tests--chars-part1 | 91 | (aset ucs-normalize-tests--chars-part1 |
| 76 | (caar columns) 1)) | 92 | (aref source 0) 1)) |
| 77 | (cl-destructuring-bind (source nfc nfd nfkc nfkd) | 93 | (and |
| 78 | (mapcar (lambda (c) (apply #'string c)) columns) | 94 | ;; c2 == toNFC(c1) == toNFC(c2) == toNFC(c3) |
| 79 | (and | 95 | (ucs-normalize-tests--normalization-equal-p NFC source nfc) |
| 80 | ;; c2 == toNFC(c1) == toNFC(c2) == toNFC(c3) | 96 | (ucs-normalize-tests--normalization-equal-p NFC nfc nfc) |
| 81 | (equal nfc (ucs-normalize-tests--normalize NFC source)) | 97 | (ucs-normalize-tests--normalization-equal-p NFC nfd nfc) |
| 82 | (equal nfc (ucs-normalize-tests--normalize NFC nfc)) | 98 | ;; c4 == toNFC(c4) == toNFC(c5) |
| 83 | (equal nfc (ucs-normalize-tests--normalize NFC nfd)) | 99 | (ucs-normalize-tests--normalization-equal-p NFC nfkc nfkc) |
| 84 | ;; c4 == toNFC(c4) == toNFC(c5) | 100 | (ucs-normalize-tests--normalization-equal-p NFC nfkd nfkc) |
| 85 | (equal nfkc (ucs-normalize-tests--normalize NFC nfkc)) | 101 | |
| 86 | (equal nfkc (ucs-normalize-tests--normalize NFC nfkd)) | 102 | ;; c3 == toNFD(c1) == toNFD(c2) == toNFD(c3) |
| 87 | 103 | (ucs-normalize-tests--normalization-equal-p NFD source nfd) | |
| 88 | ;; c3 == toNFD(c1) == toNFD(c2) == toNFD(c3) | 104 | (ucs-normalize-tests--normalization-equal-p NFD nfc nfd) |
| 89 | (equal nfd (ucs-normalize-tests--normalize NFD source)) | 105 | (ucs-normalize-tests--normalization-equal-p NFD nfd nfd) |
| 90 | (equal nfd (ucs-normalize-tests--normalize NFD nfc)) | 106 | ;; c5 == toNFD(c4) == toNFD(c5) |
| 91 | (equal nfd (ucs-normalize-tests--normalize NFD nfd)) | 107 | (ucs-normalize-tests--normalization-equal-p NFD nfkc nfkd) |
| 92 | ;; c5 == toNFD(c4) == toNFD(c5) | 108 | (ucs-normalize-tests--normalization-equal-p NFD nfkd nfkd) |
| 93 | (equal nfkd (ucs-normalize-tests--normalize NFD nfkc)) | 109 | |
| 94 | (equal nfkd (ucs-normalize-tests--normalize NFD nfkd)) | 110 | ;; c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3) == toNFKC(c4) == toNFKC(c5) |
| 95 | 111 | (ucs-normalize-tests--normalization-equal-p NFKC source nfkc) | |
| 96 | ;; c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3) == toNFKC(c4) == toNFKC(c5) | 112 | (ucs-normalize-tests--normalization-equal-p NFKC nfc nfkc) |
| 97 | (equal nfkc (ucs-normalize-tests--normalize NFKC source)) | 113 | (ucs-normalize-tests--normalization-equal-p NFKC nfd nfkc) |
| 98 | (equal nfkc (ucs-normalize-tests--normalize NFKC nfc)) | 114 | (ucs-normalize-tests--normalization-equal-p NFKC nfkc nfkc) |
| 99 | (equal nfkc (ucs-normalize-tests--normalize NFKC nfd)) | 115 | (ucs-normalize-tests--normalization-equal-p NFKC nfkd nfkc) |
| 100 | (equal nfkc (ucs-normalize-tests--normalize NFKC nfkc)) | 116 | |
| 101 | (equal nfkc (ucs-normalize-tests--normalize NFKC nfkd)) | 117 | ;; c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3) == toNFKD(c4) == toNFKD(c5) |
| 102 | 118 | (ucs-normalize-tests--normalization-equal-p NFKD source nfkd) | |
| 103 | ;; c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3) == toNFKD(c4) == toNFKD(c5) | 119 | (ucs-normalize-tests--normalization-equal-p NFKD nfc nfkd) |
| 104 | (equal nfkd (ucs-normalize-tests--normalize NFKD source)) | 120 | (ucs-normalize-tests--normalization-equal-p NFKD nfd nfkd) |
| 105 | (equal nfkd (ucs-normalize-tests--normalize NFKD nfc)) | 121 | (ucs-normalize-tests--normalization-equal-p NFKD nfkc nfkd) |
| 106 | (equal nfkd (ucs-normalize-tests--normalize NFKD nfd)) | 122 | (ucs-normalize-tests--normalization-equal-p NFKD nfkd nfkd))) |
| 107 | (equal nfkd (ucs-normalize-tests--normalize NFKD nfkc)) | 123 | |
| 108 | (equal nfkd (ucs-normalize-tests--normalize NFKD nfkd))))) | 124 | (defsubst ucs-normalize-tests--rule2-holds-p (X) |
| 109 | |||
| 110 | (defun ucs-normalize-tests--invariants-rule2-hold-p (char) | ||
| 111 | "Check 2nd conformance rule. | 125 | "Check 2nd conformance rule. |
| 112 | For every code point X assigned in this version of Unicode that is not specifically | 126 | For every code point X assigned in this version of Unicode that is not specifically |
| 113 | listed in Part 1, the following invariants must be true for all conformant | 127 | listed in Part 1, the following invariants must be true for all conformant |
| 114 | implementations: | 128 | implementations: |
| 115 | 129 | ||
| 116 | X == toNFC(X) == toNFD(X) == toNFKC(X) == toNFKD(X)" | 130 | X == toNFC(X) == toNFD(X) == toNFKC(X) == toNFKD(X)" |
| 117 | (let ((X (string char))) | 131 | (and (ucs-normalize-tests--normalization-chareq-p NFC X X) |
| 118 | (and (equal X (ucs-normalize-tests--normalize NFC X)) | 132 | (ucs-normalize-tests--normalization-chareq-p NFD X X) |
| 119 | (equal X (ucs-normalize-tests--normalize NFD X)) | 133 | (ucs-normalize-tests--normalization-chareq-p NFKC X X) |
| 120 | (equal X (ucs-normalize-tests--normalize NFKC X)) | 134 | (ucs-normalize-tests--normalization-chareq-p NFKD X X))) |
| 121 | (equal X (ucs-normalize-tests--normalize NFKD X))))) | ||
| 122 | 135 | ||
| 123 | (cl-defun ucs-normalize-tests--invariants-failing-for-part (part &optional skip-lines &key progress-str) | 136 | (cl-defun ucs-normalize-tests--rule1-failing-for-partX (part &optional skip-lines &key progress-str) |
| 124 | "Returns a list of failed line numbers." | 137 | "Returns a list of failed line numbers." |
| 125 | (with-temp-buffer | 138 | (with-temp-buffer |
| 126 | (insert-file-contents ucs-normalize-test-data-file) | 139 | (insert-file-contents ucs-normalize-test-data-file) |
| @@ -136,8 +149,8 @@ implementations: | |||
| 136 | progress-str beg-line end-line | 149 | progress-str beg-line end-line |
| 137 | 0 nil 0.5)) | 150 | 0 nil 0.5)) |
| 138 | for line from beg-line to (1- end-line) | 151 | for line from beg-line to (1- end-line) |
| 139 | unless (or (= (following-char) ?#) | 152 | unless (or (eq (following-char) ?#) |
| 140 | (ucs-normalize-tests--invariants-hold-p | 153 | (ucs-normalize-tests--rule1-holds-p |
| 141 | (ucs-normalize-tests--parse-column) | 154 | (ucs-normalize-tests--parse-column) |
| 142 | (ucs-normalize-tests--parse-column) | 155 | (ucs-normalize-tests--parse-column) |
| 143 | (ucs-normalize-tests--parse-column) | 156 | (ucs-normalize-tests--parse-column) |
| @@ -148,7 +161,7 @@ implementations: | |||
| 148 | do (forward-line) | 161 | do (forward-line) |
| 149 | if reporter do (progress-reporter-update reporter line))))) | 162 | if reporter do (progress-reporter-update reporter line))))) |
| 150 | 163 | ||
| 151 | (defun ucs-normalize-tests--invariants-failing-for-lines (lines) | 164 | (defun ucs-normalize-tests--rule1-failing-for-lines (lines) |
| 152 | "Returns a list of failed line numbers." | 165 | "Returns a list of failed line numbers." |
| 153 | (with-temp-buffer | 166 | (with-temp-buffer |
| 154 | (insert-file-contents ucs-normalize-test-data-file) | 167 | (insert-file-contents ucs-normalize-test-data-file) |
| @@ -156,7 +169,7 @@ implementations: | |||
| 156 | (cl-loop for prev-line = 1 then line | 169 | (cl-loop for prev-line = 1 then line |
| 157 | for line in lines | 170 | for line in lines |
| 158 | do (forward-line (- line prev-line)) | 171 | do (forward-line (- line prev-line)) |
| 159 | unless (ucs-normalize-tests--invariants-hold-p | 172 | unless (ucs-normalize-tests--rule1-holds-p |
| 160 | (ucs-normalize-tests--parse-column) | 173 | (ucs-normalize-tests--parse-column) |
| 161 | (ucs-normalize-tests--parse-column) | 174 | (ucs-normalize-tests--parse-column) |
| 162 | (ucs-normalize-tests--parse-column) | 175 | (ucs-normalize-tests--parse-column) |
| @@ -165,7 +178,7 @@ implementations: | |||
| 165 | collect line))) | 178 | collect line))) |
| 166 | 179 | ||
| 167 | (ert-deftest ucs-normalize-part0 () | 180 | (ert-deftest ucs-normalize-part0 () |
| 168 | (should-not (ucs-normalize-tests--invariants-failing-for-part 0))) | 181 | (should-not (ucs-normalize-tests--rule1-failing-for-partX 0))) |
| 169 | 182 | ||
| 170 | (defconst ucs-normalize-tests--failing-lines-part1 | 183 | (defconst ucs-normalize-tests--failing-lines-part1 |
| 171 | (list 15131 15132 15133 15134 15135 15136 15137 15138 | 184 | (list 15131 15132 15133 15134 15135 15136 15137 15138 |
| @@ -195,6 +208,8 @@ implementations: | |||
| 195 | "A list of line numbers.") | 208 | "A list of line numbers.") |
| 196 | (defvar ucs-normalize-tests--part1-rule2-failed-chars nil | 209 | (defvar ucs-normalize-tests--part1-rule2-failed-chars nil |
| 197 | "A list of code points.") | 210 | "A list of code points.") |
| 211 | (defvar ucs-normalize-tests--part2-rule1-failed-lines nil | ||
| 212 | "A list of line numbers.") | ||
| 198 | 213 | ||
| 199 | (defun ucs-normalize-tests--part1-rule2 (chars-part1) | 214 | (defun ucs-normalize-tests--part1-rule2 (chars-part1) |
| 200 | (let ((reporter (make-progress-reporter "UCS Normalize Test Part1, rule 2" | 215 | (let ((reporter (make-progress-reporter "UCS Normalize Test Part1, rule 2" |
| @@ -204,11 +219,11 @@ implementations: | |||
| 204 | (lambda (char-range listed-in-part) | 219 | (lambda (char-range listed-in-part) |
| 205 | (unless (eq listed-in-part 1) | 220 | (unless (eq listed-in-part 1) |
| 206 | (if (characterp char-range) | 221 | (if (characterp char-range) |
| 207 | (progn (unless (ucs-normalize-tests--invariants-rule2-hold-p char-range) | 222 | (progn (unless (ucs-normalize-tests--rule2-holds-p char-range) |
| 208 | (push char-range failed-chars)) | 223 | (push char-range failed-chars)) |
| 209 | (progress-reporter-update reporter char-range)) | 224 | (progress-reporter-update reporter char-range)) |
| 210 | (cl-loop for char from (car char-range) to (cdr char-range) | 225 | (cl-loop for char from (car char-range) to (cdr char-range) |
| 211 | unless (ucs-normalize-tests--invariants-rule2-hold-p char) | 226 | unless (ucs-normalize-tests--rule2-holds-p char) |
| 212 | do (push char failed-chars) | 227 | do (push char failed-chars) |
| 213 | do (progress-reporter-update reporter char))))) | 228 | do (progress-reporter-update reporter char))))) |
| 214 | chars-part1) | 229 | chars-part1) |
| @@ -219,59 +234,103 @@ implementations: | |||
| 219 | :tags '(:expensive-test) | 234 | :tags '(:expensive-test) |
| 220 | ;; This takes a long time, so make sure we're compiled. | 235 | ;; This takes a long time, so make sure we're compiled. |
| 221 | (dolist (fun '(ucs-normalize-tests--part1-rule2 | 236 | (dolist (fun '(ucs-normalize-tests--part1-rule2 |
| 222 | ucs-normalize-tests--invariants-failing-for-part | 237 | ucs-normalize-tests--rule1-failing-for-partX |
| 223 | ucs-normalize-tests--invariants-hold-p | 238 | ucs-normalize-tests--rule1-holds-p |
| 224 | ucs-normalize-tests--invariants-rule2-hold-p)) | 239 | ucs-normalize-tests--rule2-holds-p)) |
| 225 | (or (byte-code-function-p (symbol-function fun)) | 240 | (or (byte-code-function-p (symbol-function fun)) |
| 226 | (byte-compile fun))) | 241 | (byte-compile fun))) |
| 227 | (let ((ucs-normalize-tests--chars-part1 (make-char-table 'ucs-normalize-tests t))) | 242 | (let ((ucs-normalize-tests--chars-part1 (make-char-table 'ucs-normalize-tests t))) |
| 228 | (should-not | 243 | (setq ucs-normalize-tests--part1-rule1-failed-lines |
| 229 | (setq ucs-normalize-tests--part1-rule1-failed-lines | 244 | (ucs-normalize-tests--rule1-failing-for-partX |
| 230 | (ucs-normalize-tests--invariants-failing-for-part | 245 | 1 ucs-normalize-tests--failing-lines-part1 |
| 231 | 1 ucs-normalize-tests--failing-lines-part1 | 246 | :progress-str "UCS Normalize Test Part1, rule 1")) |
| 232 | :progress-str "UCS Normalize Test Part1, rule 1"))) | 247 | (setq ucs-normalize-tests--part1-rule2-failed-chars |
| 233 | (should-not (setq ucs-normalize-tests--part1-rule2-failed-chars | 248 | (ucs-normalize-tests--part1-rule2 |
| 234 | (ucs-normalize-tests--part1-rule2 | 249 | ucs-normalize-tests--chars-part1)) |
| 235 | ucs-normalize-tests--chars-part1))))) | 250 | (should-not ucs-normalize-tests--part1-rule1-failed-lines) |
| 251 | (should-not ucs-normalize-tests--part1-rule2-failed-chars))) | ||
| 236 | 252 | ||
| 237 | (ert-deftest ucs-normalize-part1-failing () | 253 | (ert-deftest ucs-normalize-part1-failing () |
| 238 | :expected-result :failed | 254 | :expected-result :failed |
| 239 | (skip-unless ucs-normalize-tests--failing-lines-part1) | 255 | (skip-unless ucs-normalize-tests--failing-lines-part1) |
| 240 | (should-not | 256 | (should-not |
| 241 | (ucs-normalize-tests--invariants-failing-for-lines | 257 | (ucs-normalize-tests--rule1-failing-for-lines |
| 242 | ucs-normalize-tests--failing-lines-part1))) | 258 | ucs-normalize-tests--failing-lines-part1))) |
| 243 | 259 | ||
| 244 | (defconst ucs-normalize-tests--failing-lines-part2 | 260 | (defconst ucs-normalize-tests--failing-lines-part2 |
| 245 | (list 18328 18330 18332 18334 18336 18338 18340 18342 | 261 | (list 17656 17658 18006 18007 18008 18009 18010 18011 |
| 246 | 18344 18346 18348 18350 18352 18354 18356 18358 | 262 | 18012 18340 18342 18344 18346 18348 18350 18352 |
| 247 | 18360 18362 18364 18366 18368 18370 18372 18374 | 263 | 18354 18356 18358 18360 18362 18364 18366 18368 |
| 248 | 18376 18378 18380 18382 18384 18386 18388 18390 | 264 | 18370 18372 18374 18376 18378 18380 18382 18384 |
| 249 | 18392 18394 18396 18398 18400 18402 18404 18406 | 265 | 18386 18388 18390 18392 18394 18396 18398 18400 |
| 250 | 18408 18410 18412 18414 18416 18418 18420 18422 | 266 | 18402 18404 18406 18408 18410 18412 18414 18416 |
| 251 | 18424 18426 18494 18496 18498 18500 18502 18504 | 267 | 18418 18420 18422 18424 18426 18428 18430 18432 |
| 252 | 18506 18508 18510 18512 18514 18516 18518 18520 | 268 | 18434 18436 18438 18440 18442 18444 18446 18448 |
| 253 | 18522 18524 18526 18528 18530 18532 18534 18536 | 269 | 18450 18518 18520 18522 18524 18526 18528 18530 |
| 254 | 18538 18540 18542 18544 18546 18548 18550 18552 | 270 | 18532 18534 18536 18538 18540 18542 18544 18546 |
| 255 | 18554 18556 18558 18560 18562 18564 18566 18568 | 271 | 18548 18550 18552 18554 18556 18558 18560 18562 |
| 256 | 18570 18572 18574 18576 18578 18580 18582 18584 | 272 | 18564 18566 18568 18570 18572 18574 18576 18578 |
| 257 | 18586 18588 18590 18592 18594 18596)) | 273 | 18580 18582 18584 18586 18588 18590 18592 18594 |
| 274 | 18596 18598 18600 18602 18604 18606 18608 18610 | ||
| 275 | 18612 18614 18616 18618 18620)) | ||
| 258 | 276 | ||
| 259 | (ert-deftest ucs-normalize-part2 () | 277 | (ert-deftest ucs-normalize-part2 () |
| 260 | :tags '(:expensive-test) | 278 | :tags '(:expensive-test) |
| 261 | (should-not | 279 | (should-not |
| 262 | (ucs-normalize-tests--invariants-failing-for-part | 280 | (setq ucs-normalize-tests--part2-rule1-failed-lines |
| 263 | 2 ucs-normalize-tests--failing-lines-part2 | 281 | (ucs-normalize-tests--rule1-failing-for-partX |
| 264 | :progress-str "UCS Normalize Test Part2"))) | 282 | 2 ucs-normalize-tests--failing-lines-part2 |
| 283 | :progress-str "UCS Normalize Test Part2")))) | ||
| 265 | 284 | ||
| 266 | (ert-deftest ucs-normalize-part2-failing () | 285 | (ert-deftest ucs-normalize-part2-failing () |
| 267 | :expected-result :failed | 286 | :expected-result :failed |
| 268 | (skip-unless ucs-normalize-tests--failing-lines-part2) | 287 | (skip-unless ucs-normalize-tests--failing-lines-part2) |
| 269 | (should-not | 288 | (should-not |
| 270 | (ucs-normalize-tests--invariants-failing-for-lines | 289 | (ucs-normalize-tests--rule1-failing-for-lines |
| 271 | ucs-normalize-tests--failing-lines-part2))) | 290 | ucs-normalize-tests--failing-lines-part2))) |
| 272 | 291 | ||
| 273 | (ert-deftest ucs-normalize-part3 () | 292 | (ert-deftest ucs-normalize-part3 () |
| 274 | (should-not | 293 | (should-not |
| 275 | (ucs-normalize-tests--invariants-failing-for-part 3))) | 294 | (ucs-normalize-tests--rule1-failing-for-partX 3))) |
| 295 | |||
| 296 | (defun ucs-normalize-tests--insert-failing-lines (var newval) | ||
| 297 | (insert (format "`%s' should be updated to:\n | ||
| 298 | \(defconst %s | ||
| 299 | (list " var var)) | ||
| 300 | (dolist (linos (seq-partition newval 8)) | ||
| 301 | (insert (mapconcat #'number-to-string linos " ") "\n")) | ||
| 302 | (insert ")\)")) | ||
| 303 | |||
| 304 | (defun ucs-normalize-check-failing-lines () | ||
| 305 | (interactive) | ||
| 306 | (let ((ucs-normalize-tests--failing-lines-part1 nil) | ||
| 307 | (ucs-normalize-tests--failing-lines-part2 nil)) | ||
| 308 | (setq ucs-normalize-tests--part1-rule1-failed-lines nil) | ||
| 309 | (setq ucs-normalize-tests--part1-rule2-failed-chars nil) | ||
| 310 | (setq ucs-normalize-tests--part2-rule1-failed-lines nil) | ||
| 311 | (ert "\\`ucs-normalize")) | ||
| 312 | |||
| 313 | (with-current-buffer (get-buffer-create "*ucs normalize change bad lines*") | ||
| 314 | (erase-buffer) | ||
| 315 | (unless (equal ucs-normalize-tests--part1-rule1-failed-lines | ||
| 316 | ucs-normalize-tests--failing-lines-part1) | ||
| 317 | (ucs-normalize-tests--insert-failing-lines | ||
| 318 | 'ucs-normalize-tests--failing-lines-part1 | ||
| 319 | ucs-normalize-tests--part1-rule1-failed-lines)) | ||
| 320 | |||
| 321 | (when ucs-normalize-tests--part1-rule2-failed-chars | ||
| 322 | (insert (format "Some characters failed rule 2!\n\n%S" | ||
| 323 | `(list ,@ucs-normalize-tests--part1-rule2-failed-chars)))) | ||
| 324 | |||
| 325 | (unless (equal ucs-normalize-tests--part2-rule1-failed-lines | ||
| 326 | ucs-normalize-tests--failing-lines-part2) | ||
| 327 | (ucs-normalize-tests--insert-failing-lines | ||
| 328 | 'ucs-normalize-tests--failing-lines-part2 | ||
| 329 | ucs-normalize-tests--part2-rule1-failed-lines)) | ||
| 330 | (if (> (buffer-size) 0) | ||
| 331 | (if noninteractive | ||
| 332 | (princ (buffer-string) standard-output) | ||
| 333 | (display-buffer (current-buffer))) | ||
| 334 | (message "No changes to failing lines needed")))) | ||
| 276 | 335 | ||
| 277 | ;;; ucs-normalize-tests.el ends here | 336 | ;;; ucs-normalize-tests.el ends here |
diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el new file mode 100644 index 00000000000..9dbb6c05b9e --- /dev/null +++ b/test/lisp/net/gnutls-tests.el | |||
| @@ -0,0 +1,295 @@ | |||
| 1 | ;;; gnutls-tests.el --- Test suite for gnutls.el | ||
| 2 | |||
| 3 | ;; Copyright (C) 2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Ted Zlatanov <tzz@lifelogs.com> | ||
| 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 | ;; Run this with `GNUTLS_TEST_VERBOSE=1' to get verbose debugging. | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (require 'ert) | ||
| 29 | (require 'cl) | ||
| 30 | (require 'gnutls) | ||
| 31 | (require 'hex-util) | ||
| 32 | |||
| 33 | (defvar gnutls-tests-message-prefix "") | ||
| 34 | |||
| 35 | (defsubst gnutls-tests-message (format-string &rest args) | ||
| 36 | (when (getenv "GNUTLS_TEST_VERBOSE") | ||
| 37 | (apply #'message (concat "gnutls-tests: " gnutls-tests-message-prefix format-string) args))) | ||
| 38 | |||
| 39 | ;; Minor convenience to see strings more easily (without binary data). | ||
| 40 | (defsubst gnutls-tests-hexstring-equal (a b) | ||
| 41 | (and (stringp a) (stringp b) (string-equal (encode-hex-string a) (encode-hex-string b)))) | ||
| 42 | |||
| 43 | (defvar gnutls-tests-internal-macs-upcased | ||
| 44 | (mapcar (lambda (sym) (cons sym (intern (upcase (symbol-name sym))))) | ||
| 45 | (secure-hash-algorithms))) | ||
| 46 | |||
| 47 | (defvar gnutls-tests-tested-macs | ||
| 48 | (when (gnutls-available-p) | ||
| 49 | (remove-duplicates | ||
| 50 | (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) | ||
| 51 | (mapcar 'car (gnutls-macs)))))) | ||
| 52 | |||
| 53 | (defvar gnutls-tests-tested-digests | ||
| 54 | (when (gnutls-available-p) | ||
| 55 | (remove-duplicates | ||
| 56 | (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) | ||
| 57 | (mapcar 'car (gnutls-digests)))))) | ||
| 58 | |||
| 59 | (defvar gnutls-tests-tested-ciphers | ||
| 60 | (when (gnutls-available-p) | ||
| 61 | (remove-duplicates | ||
| 62 | ; these cause FPEs or SEGVs | ||
| 63 | (remove-if (lambda (e) (memq e '(ARCFOUR-128))) | ||
| 64 | (mapcar 'car (gnutls-ciphers)))))) | ||
| 65 | |||
| 66 | (defvar gnutls-tests-mondo-strings | ||
| 67 | (list | ||
| 68 | "" | ||
| 69 | "some data" | ||
| 70 | "lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data " | ||
| 71 | "data and more data to go over the block limit!" | ||
| 72 | "data and more data to go over the block limit" | ||
| 73 | (format "some random data %d%d" (random) (random)))) | ||
| 74 | |||
| 75 | (ert-deftest test-gnutls-000-availability () | ||
| 76 | "Test the GnuTLS hashes and ciphers availability." | ||
| 77 | (skip-unless (memq 'gnutls3 (gnutls-available-p))) | ||
| 78 | (setq gnutls-tests-message-prefix "availability: ") | ||
| 79 | (should (> (length gnutls-tests-internal-macs-upcased) 5)) | ||
| 80 | (let ((macs (gnutls-macs)) | ||
| 81 | (digests (gnutls-digests)) | ||
| 82 | (ciphers (gnutls-ciphers))) | ||
| 83 | (dolist (mac gnutls-tests-tested-macs) | ||
| 84 | (let ((plist (cdr (assq mac macs)))) | ||
| 85 | (gnutls-tests-message "MAC %s %S" mac plist) | ||
| 86 | (dolist (prop '(:mac-algorithm-id :mac-algorithm-length :mac-algorithm-keysize :mac-algorithm-noncesize)) | ||
| 87 | (should (plist-get plist prop))) | ||
| 88 | (should (eq 'gnutls-mac-algorithm (plist-get plist :type))))) | ||
| 89 | (dolist (digest gnutls-tests-tested-digests) | ||
| 90 | (let ((plist (cdr (assq digest digests)))) | ||
| 91 | (gnutls-tests-message "digest %s %S" digest plist) | ||
| 92 | (dolist (prop '(:digest-algorithm-id :digest-algorithm-length)) | ||
| 93 | (should (plist-get plist prop))) | ||
| 94 | (should (eq 'gnutls-digest-algorithm (plist-get plist :type))))) | ||
| 95 | (dolist (cipher gnutls-tests-tested-ciphers) | ||
| 96 | (let ((plist (cdr (assq cipher ciphers)))) | ||
| 97 | (gnutls-tests-message "cipher %s %S" cipher plist) | ||
| 98 | (dolist (prop '(:cipher-id :cipher-blocksize :cipher-keysize :cipher-ivsize)) | ||
| 99 | (should (plist-get plist prop))) | ||
| 100 | (should (eq 'gnutls-symmetric-cipher (plist-get plist :type))))))) | ||
| 101 | |||
| 102 | (ert-deftest test-gnutls-000-data-extractions () | ||
| 103 | "Test the GnuTLS data extractions against the built-in `secure-hash'." | ||
| 104 | (skip-unless (memq 'digests (gnutls-available-p))) | ||
| 105 | (setq gnutls-tests-message-prefix "data extraction: ") | ||
| 106 | (dolist (input gnutls-tests-mondo-strings) | ||
| 107 | ;; Test buffer extraction | ||
| 108 | (with-temp-buffer | ||
| 109 | (insert input) | ||
| 110 | (insert "not ASCII: не e английски") | ||
| 111 | (dolist (step '(0 1 2 3 4 5)) | ||
| 112 | (let ((spec (list (current-buffer) ; a buffer spec | ||
| 113 | (point-min) | ||
| 114 | (max (point-min) (- step (point-max))))) | ||
| 115 | (spec2 (list (buffer-string) ; a string spec | ||
| 116 | (point-min) | ||
| 117 | (max (point-min) (- step (point-max)))))) | ||
| 118 | (should (gnutls-tests-hexstring-equal | ||
| 119 | (gnutls-hash-digest 'MD5 spec) | ||
| 120 | (apply 'secure-hash 'md5 (append spec '(t))))) | ||
| 121 | (should (gnutls-tests-hexstring-equal | ||
| 122 | (gnutls-hash-digest 'MD5 spec2) | ||
| 123 | (apply 'secure-hash 'md5 (append spec2 '(t)))))))))) | ||
| 124 | |||
| 125 | (ert-deftest test-gnutls-001-hashes-internal-digests () | ||
| 126 | "Test the GnuTLS hash digests against the built-in `secure-hash'." | ||
| 127 | (skip-unless (memq 'digests (gnutls-available-p))) | ||
| 128 | (setq gnutls-tests-message-prefix "digest internal verification: ") | ||
| 129 | (let ((macs (gnutls-macs))) | ||
| 130 | (dolist (mcell gnutls-tests-internal-macs-upcased) | ||
| 131 | (let ((plist (cdr (assq (cdr mcell) macs)))) | ||
| 132 | (gnutls-tests-message "Checking digest MAC %S %S" mcell plist) | ||
| 133 | (dolist (input gnutls-tests-mondo-strings) | ||
| 134 | ;; Test buffer extraction | ||
| 135 | (with-temp-buffer | ||
| 136 | (insert input) | ||
| 137 | (should (gnutls-tests-hexstring-equal | ||
| 138 | (gnutls-hash-digest (cdr mcell) (current-buffer)) | ||
| 139 | (secure-hash (car mcell) (current-buffer) nil nil t)))) | ||
| 140 | (should (gnutls-tests-hexstring-equal | ||
| 141 | (gnutls-hash-digest (cdr mcell) input) | ||
| 142 | (secure-hash (car mcell) input nil nil t)))))))) | ||
| 143 | |||
| 144 | (ert-deftest test-gnutls-002-hashes-digests () | ||
| 145 | "Test some GnuTLS hash digests against pre-defined outputs." | ||
| 146 | (skip-unless (memq 'digests (gnutls-available-p))) | ||
| 147 | (setq gnutls-tests-message-prefix "digest external verification: ") | ||
| 148 | (let ((macs (gnutls-macs))) | ||
| 149 | (dolist (test '(("57edf4a22be3c955ac49da2e2107b67a" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" MD5) | ||
| 150 | ("d174ab98d277d9f5a5611c2c9f419d9f" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" MD5) | ||
| 151 | ("c3fcd3d76192e4007dfb496cca67e13b" "abcdefghijklmnopqrstuvwxyz" MD5) | ||
| 152 | ("f96b697d7cb7938d525a2f31aaf161d0" "message digest" MD5) | ||
| 153 | ("900150983cd24fb0d6963f7d28e17f72" "abc" MD5) | ||
| 154 | ("0cc175b9c0f1b6a831c399e269772661" "a" MD5) | ||
| 155 | ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" SHA1) | ||
| 156 | ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" "SHA1"))) ; check string ID for digest | ||
| 157 | (destructuring-bind (hash input mac) test | ||
| 158 | (let ((plist (cdr (assq mac macs))) | ||
| 159 | result resultb) | ||
| 160 | (gnutls-tests-message "%s %S" mac plist) | ||
| 161 | (setq result (encode-hex-string (gnutls-hash-digest mac input))) | ||
| 162 | (gnutls-tests-message "%S => result %S" test result) | ||
| 163 | (should (string-equal result hash)) | ||
| 164 | ;; Test buffer extraction | ||
| 165 | (with-temp-buffer | ||
| 166 | (insert input) | ||
| 167 | (setq resultb (encode-hex-string (gnutls-hash-digest mac (current-buffer)))) | ||
| 168 | (gnutls-tests-message "%S => result from buffer %S" test resultb) | ||
| 169 | (should (string-equal resultb hash)))))))) | ||
| 170 | |||
| 171 | (ert-deftest test-gnutls-003-hashes-hmacs () | ||
| 172 | "Test some predefined GnuTLS HMAC outputs for SHA256." | ||
| 173 | (skip-unless (memq 'macs (gnutls-available-p))) | ||
| 174 | (setq gnutls-tests-message-prefix "HMAC verification: ") | ||
| 175 | (let ((macs (gnutls-macs))) | ||
| 176 | (dolist (test '(("f5c5021e60d9686fef3bb0414275fe4163bece61d9a95fec7a273746a437b986" "hello\n" "test" SHA256) | ||
| 177 | ("46b75292b81002fd873e89c532a1b8545d6efc9822ee938feba6de2723161a67" "more and more data goes into a file to exceed the buffer size" "test" SHA256) | ||
| 178 | ("81568ba71fa2c5f33cc84bf362466988f98eba3735479100b4e8908acad87ac4" "more and more data goes into a file to exceed the buffer size" "very long key goes here to exceed the key size" SHA256) | ||
| 179 | ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" "SHA256") ; check string ID for HMAC | ||
| 180 | ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" SHA256))) | ||
| 181 | (destructuring-bind (hash input key mac) test | ||
| 182 | (let ((plist (cdr (assq mac macs))) | ||
| 183 | result) | ||
| 184 | (gnutls-tests-message "%s %S" mac plist) | ||
| 185 | (setq result (encode-hex-string (gnutls-hash-mac mac (copy-sequence key) input))) | ||
| 186 | (gnutls-tests-message "%S => result %S" test result) | ||
| 187 | (should (string-equal result hash))))))) | ||
| 188 | |||
| 189 | |||
| 190 | (defun gnutls-tests-pad-or-trim (s exact) | ||
| 191 | "Pad or trim string S to EXACT numeric size." | ||
| 192 | (if (and (consp s) (eq 'iv-auto (nth 0 s))) | ||
| 193 | s | ||
| 194 | (let ((e (number-to-string exact))) | ||
| 195 | (format (concat "%" e "." e "s") s)))) | ||
| 196 | |||
| 197 | (defun gnutls-tests-pad-to-multiple (s blocksize) | ||
| 198 | "Pad string S to BLOCKSIZE numeric size." | ||
| 199 | (let* ((e (if (string= s "") | ||
| 200 | blocksize | ||
| 201 | (* blocksize (ceiling (length s) blocksize)))) | ||
| 202 | (out (concat s (make-string (- e (length s)) ? )))) | ||
| 203 | ;; (gnutls-tests-message "padding %S to length %d for blocksize %d: => %S" s e blocksize out) | ||
| 204 | out)) | ||
| 205 | |||
| 206 | ;; ;;; Testing from the command line: | ||
| 207 | ;; ;;; echo e36a9d13c15a6df23a59a6337d6132b8f7cd5283cb4784b81141b52343a18e5f5e5ee8f5553c23167409dd222478bc30 | perl -lne 'print pack "H*", $_' | openssl enc -aes-128-ctr -d -nosalt -K 6d796b657932 -iv 696e697432 | od -x | ||
| 208 | (ert-deftest test-gnutls-004-symmetric-ciphers () | ||
| 209 | "Test the GnuTLS symmetric ciphers" | ||
| 210 | (skip-unless (memq 'ciphers (gnutls-available-p))) | ||
| 211 | (setq gnutls-tests-message-prefix "symmetric cipher verification: ") | ||
| 212 | ;; we expect at least 10 ciphers | ||
| 213 | (should (> (length (gnutls-ciphers)) 10)) | ||
| 214 | (let ((keys '("mykey" "mykey2")) | ||
| 215 | (inputs gnutls-tests-mondo-strings) | ||
| 216 | (ivs '("" "-abc123-" "init" "ini2")) | ||
| 217 | (ciphers (remove-if | ||
| 218 | (lambda (c) (plist-get (cdr (assq c (gnutls-ciphers))) | ||
| 219 | :cipher-aead-capable)) | ||
| 220 | gnutls-tests-tested-ciphers))) | ||
| 221 | |||
| 222 | (dolist (cipher ciphers) | ||
| 223 | (dolist (iv ivs) | ||
| 224 | (dolist (input inputs) | ||
| 225 | (dolist (key keys) | ||
| 226 | (gnutls-tests-message "%S, starting key %S IV %S input %S" (assq cipher (gnutls-ciphers)) key iv input) | ||
| 227 | (let* ((cplist (cdr (assq cipher (gnutls-ciphers)))) | ||
| 228 | (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize))) | ||
| 229 | (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize))) | ||
| 230 | (iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize))) | ||
| 231 | (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input)) | ||
| 232 | (data (nth 0 output)) | ||
| 233 | (actual-iv (nth 1 output)) | ||
| 234 | (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data)) | ||
| 235 | (reverse (nth 0 reverse-output))) | ||
| 236 | (gnutls-tests-message "%s %S" cipher cplist) | ||
| 237 | (gnutls-tests-message "key %S IV %S input %S => hexdata %S and reverse %S" key iv input (encode-hex-string data) reverse) | ||
| 238 | (should-not (gnutls-tests-hexstring-equal input data)) | ||
| 239 | (should-not (gnutls-tests-hexstring-equal data reverse)) | ||
| 240 | (should (gnutls-tests-hexstring-equal input reverse))))))))) | ||
| 241 | |||
| 242 | (ert-deftest test-gnutls-005-aead-ciphers () | ||
| 243 | "Test the GnuTLS AEAD ciphers" | ||
| 244 | (skip-unless (memq 'AEAD-ciphers (gnutls-available-p))) | ||
| 245 | (setq gnutls-tests-message-prefix "AEAD verification: ") | ||
| 246 | (let ((keys '("mykey" "mykey2")) | ||
| 247 | (inputs gnutls-tests-mondo-strings) | ||
| 248 | (ivs '("" "-abc123-" "init" "ini2")) | ||
| 249 | (auths '(nil | ||
| 250 | "" | ||
| 251 | "auth data" | ||
| 252 | "auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data " | ||
| 253 | "AUTH data and more data to go over the block limit!" | ||
| 254 | "AUTH data and more data to go over the block limit")) | ||
| 255 | (ciphers (remove-if | ||
| 256 | (lambda (c) (or (null (plist-get (cdr (assq c (gnutls-ciphers))) | ||
| 257 | :cipher-aead-capable)))) | ||
| 258 | gnutls-tests-tested-ciphers)) | ||
| 259 | actual-ivlist) | ||
| 260 | |||
| 261 | (dolist (cipher ciphers) | ||
| 262 | (dolist (input inputs) | ||
| 263 | (dolist (auth auths) | ||
| 264 | (dolist (key keys) | ||
| 265 | (let* ((cplist (cdr (assq cipher (gnutls-ciphers)))) | ||
| 266 | (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize))) | ||
| 267 | (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize))) | ||
| 268 | (ivsize (plist-get cplist :cipher-ivsize))) | ||
| 269 | (should (>= ivsize 12)) ; as per the RFC | ||
| 270 | (dolist (iv (append ivs (list (list 'iv-auto ivsize)))) | ||
| 271 | |||
| 272 | (gnutls-tests-message "%S, starting key %S IV %S input %S auth %S" (assq cipher (gnutls-ciphers)) key iv input auth) | ||
| 273 | (let* ((iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize))) | ||
| 274 | (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input (copy-sequence auth))) | ||
| 275 | (data (nth 0 output)) | ||
| 276 | (actual-iv (nth 1 output)) | ||
| 277 | (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data auth)) | ||
| 278 | (reverse (nth 0 reverse-output))) | ||
| 279 | ;; GNUTLS_RND_NONCE should be good enough to ensure this. | ||
| 280 | (should-not (member (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist)) | ||
| 281 | (cond | ||
| 282 | ((stringp iv) | ||
| 283 | (should (equal iv actual-iv))) | ||
| 284 | ((consp iv) | ||
| 285 | (push (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist) | ||
| 286 | (gnutls-tests-message "IV list length: %d" (length actual-ivlist)))) | ||
| 287 | |||
| 288 | (gnutls-tests-message "%s %S" cipher cplist) | ||
| 289 | (gnutls-tests-message "key %S IV %S input %S auth %S => hexdata %S and reverse %S" key iv input auth (encode-hex-string data) reverse) | ||
| 290 | (should-not (gnutls-tests-hexstring-equal input data)) | ||
| 291 | (should-not (gnutls-tests-hexstring-equal data reverse)) | ||
| 292 | (should (gnutls-tests-hexstring-equal input reverse))))))))))) | ||
| 293 | |||
| 294 | (provide 'gnutls-tests) | ||
| 295 | ;;; gnutls-tests.el ends here | ||
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index e7bb3e8ccf9..9ee3a281c3d 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el | |||
| @@ -280,8 +280,11 @@ | |||
| 280 | (< (setq times (1+ times)) 10)) | 280 | (< (setq times (1+ times)) 10)) |
| 281 | (sit-for 0.1)) | 281 | (sit-for 0.1)) |
| 282 | (should proc) | 282 | (should proc) |
| 283 | (while (eq (process-status proc) 'connect) | 283 | (setq times 0) |
| 284 | (sit-for 0.1))) | 284 | (while (and (eq (process-status proc) 'connect) |
| 285 | (< (setq times (1+ times)) 10)) | ||
| 286 | (sit-for 0.1)) | ||
| 287 | (skip-unless (not (eq (process-status proc) 'connect)))) | ||
| 285 | (if (process-live-p server) (delete-process server))) | 288 | (if (process-live-p server) (delete-process server))) |
| 286 | (setq status (gnutls-peer-status proc)) | 289 | (setq status (gnutls-peer-status proc)) |
| 287 | (should (consp status)) | 290 | (should (consp status)) |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 6c02daa6547..bb1bafa789f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -86,8 +86,8 @@ | |||
| 86 | tramp-message-show-message nil | 86 | tramp-message-show-message nil |
| 87 | tramp-persistency-file-name nil) | 87 | tramp-persistency-file-name nil) |
| 88 | 88 | ||
| 89 | ;; This shall happen on hydra only. | 89 | ;; This should happen on hydra only. |
| 90 | (when (getenv "NIX_STORE") | 90 | (when (getenv "EMACS_HYDRA_CI") |
| 91 | (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) | 91 | (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) |
| 92 | 92 | ||
| 93 | (defvar tramp--test-expensive-test | 93 | (defvar tramp--test-expensive-test |
| @@ -132,12 +132,12 @@ If QUOTED is non-nil, the local part of the file is quoted." | |||
| 132 | (make-temp-name "tramp-test") | 132 | (make-temp-name "tramp-test") |
| 133 | (if local temporary-file-directory tramp-test-temporary-file-directory)))) | 133 | (if local temporary-file-directory tramp-test-temporary-file-directory)))) |
| 134 | 134 | ||
| 135 | ;; Don't print messages in nested `tramp--instrument-test-case' calls. | 135 | ;; Don't print messages in nested `tramp--test-instrument-test-case' calls. |
| 136 | (defvar tramp--instrument-test-case-p nil | 136 | (defvar tramp--test-instrument-test-case-p nil |
| 137 | "Whether `tramp--instrument-test-case' run. | 137 | "Whether `tramp--test-instrument-test-case' run. |
| 138 | This shall used dynamically bound only.") | 138 | This shall used dynamically bound only.") |
| 139 | 139 | ||
| 140 | (defmacro tramp--instrument-test-case (verbose &rest body) | 140 | (defmacro tramp--test-instrument-test-case (verbose &rest body) |
| 141 | "Run BODY with `tramp-verbose' equal VERBOSE. | 141 | "Run BODY with `tramp-verbose' equal VERBOSE. |
| 142 | Print the the content of the Tramp debug buffer, if BODY does not | 142 | Print the the content of the Tramp debug buffer, if BODY does not |
| 143 | eval properly in `should' or `should-not'. `should-error' is not | 143 | eval properly in `should' or `should-not'. `should-error' is not |
| @@ -150,9 +150,9 @@ handled properly. BODY shall not contain a timeout." | |||
| 150 | (cons "^make-symbolic-link not supported$" debug-ignored-errors)) | 150 | (cons "^make-symbolic-link not supported$" debug-ignored-errors)) |
| 151 | inhibit-message) | 151 | inhibit-message) |
| 152 | (unwind-protect | 152 | (unwind-protect |
| 153 | (let ((tramp--instrument-test-case-p t)) ,@body) | 153 | (let ((tramp--test-instrument-test-case-p t)) ,@body) |
| 154 | ;; Unwind forms. | 154 | ;; Unwind forms. |
| 155 | (when (and (null tramp--instrument-test-case-p) (> tramp-verbose 3)) | 155 | (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3)) |
| 156 | (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil | 156 | (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil |
| 157 | (with-current-buffer (tramp-get-connection-buffer v) | 157 | (with-current-buffer (tramp-get-connection-buffer v) |
| 158 | (message "%s" (buffer-string))) | 158 | (message "%s" (buffer-string))) |
| @@ -161,7 +161,7 @@ handled properly. BODY shall not contain a timeout." | |||
| 161 | 161 | ||
| 162 | (defsubst tramp--test-message (fmt-string &rest arguments) | 162 | (defsubst tramp--test-message (fmt-string &rest arguments) |
| 163 | "Emit a message into ERT *Messages*." | 163 | "Emit a message into ERT *Messages*." |
| 164 | (tramp--instrument-test-case 0 | 164 | (tramp--test-instrument-test-case 0 |
| 165 | (apply | 165 | (apply |
| 166 | 'tramp-message | 166 | 'tramp-message |
| 167 | (tramp-dissect-file-name tramp-test-temporary-file-directory) 0 | 167 | (tramp-dissect-file-name tramp-test-temporary-file-directory) 0 |
| @@ -169,7 +169,7 @@ handled properly. BODY shall not contain a timeout." | |||
| 169 | 169 | ||
| 170 | (defsubst tramp--test-backtrace () | 170 | (defsubst tramp--test-backtrace () |
| 171 | "Dump a backtrace into ERT *Messages*." | 171 | "Dump a backtrace into ERT *Messages*." |
| 172 | (tramp--instrument-test-case 10 | 172 | (tramp--test-instrument-test-case 10 |
| 173 | (tramp-backtrace | 173 | (tramp-backtrace |
| 174 | (tramp-dissect-file-name tramp-test-temporary-file-directory)))) | 174 | (tramp-dissect-file-name tramp-test-temporary-file-directory)))) |
| 175 | 175 | ||
| @@ -3699,11 +3699,14 @@ process sentinels. They shall not disturb each other." | |||
| 3699 | (process-file-side-effects t) | 3699 | (process-file-side-effects t) |
| 3700 | ;; Suppress nasty messages. | 3700 | ;; Suppress nasty messages. |
| 3701 | (inhibit-message t) | 3701 | (inhibit-message t) |
| 3702 | ;; Do not run delayed timers. | ||
| 3703 | (timer-max-repeats 0) | ||
| 3704 | ;; Number of asynchronous processes for test. | ||
| 3702 | (number-proc 10) | 3705 | (number-proc 10) |
| 3703 | ;; On hydra, timings are bad. | 3706 | ;; On hydra, timings are bad. |
| 3704 | (timer-repeat | 3707 | (timer-repeat |
| 3705 | (cond | 3708 | (cond |
| 3706 | ((getenv "NIX_STORE") 10) | 3709 | ((getenv "EMACS_HYDRA_CI") 10) |
| 3707 | (t 1))) | 3710 | (t 1))) |
| 3708 | ;; We must distinguish due to performance reasons. | 3711 | ;; We must distinguish due to performance reasons. |
| 3709 | (timer-operation | 3712 | (timer-operation |
| @@ -3726,16 +3729,26 @@ process sentinels. They shall not disturb each other." | |||
| 3726 | 0 timer-repeat | 3729 | 0 timer-repeat |
| 3727 | (lambda () | 3730 | (lambda () |
| 3728 | (when buffers | 3731 | (when buffers |
| 3729 | (let ((default-directory tmp-name) | 3732 | (let ((time (float-time)) |
| 3733 | (default-directory tmp-name) | ||
| 3730 | (file | 3734 | (file |
| 3731 | (buffer-name (nth (random (length buffers)) buffers)))) | 3735 | (buffer-name (nth (random (length buffers)) buffers)))) |
| 3732 | (funcall timer-operation file)))))) | 3736 | (tramp--test-message |
| 3737 | "Start timer %s %s" file (current-time-string)) | ||
| 3738 | (funcall timer-operation file) | ||
| 3739 | ;; Adjust timer if it takes too much time. | ||
| 3740 | (when (> (- (float-time) time) timer-repeat) | ||
| 3741 | (setq timer-repeat (* 1.5 timer-repeat)) | ||
| 3742 | (setf (timer--repeat-delay timer) timer-repeat) | ||
| 3743 | (tramp--test-message "Increase timer %s" timer-repeat)) | ||
| 3744 | (tramp--test-message | ||
| 3745 | "Stop timer %s %s" file (current-time-string))))))) | ||
| 3733 | 3746 | ||
| 3734 | ;; Create temporary buffers. The number of buffers | 3747 | ;; Create temporary buffers. The number of buffers |
| 3735 | ;; corresponds to the number of processes; it could be | 3748 | ;; corresponds to the number of processes; it could be |
| 3736 | ;; increased in order to make pressure on Tramp. | 3749 | ;; increased in order to make pressure on Tramp. |
| 3737 | (dotimes (_i number-proc) | 3750 | (dotimes (_i number-proc) |
| 3738 | (add-to-list 'buffers (generate-new-buffer "foo"))) | 3751 | (setq buffers (cons (generate-new-buffer "foo") buffers))) |
| 3739 | 3752 | ||
| 3740 | ;; Open asynchronous processes. Set process filter and sentinel. | 3753 | ;; Open asynchronous processes. Set process filter and sentinel. |
| 3741 | (dolist (buf buffers) | 3754 | (dolist (buf buffers) |
| @@ -3776,17 +3789,30 @@ process sentinels. They shall not disturb each other." | |||
| 3776 | (proc (get-buffer-process buf)) | 3789 | (proc (get-buffer-process buf)) |
| 3777 | (file (process-get proc 'foo)) | 3790 | (file (process-get proc 'foo)) |
| 3778 | (count (process-get proc 'bar))) | 3791 | (count (process-get proc 'bar))) |
| 3792 | (tramp--test-message | ||
| 3793 | "Start action %d %s %s" count buf (current-time-string)) | ||
| 3779 | ;; Regular operation. | 3794 | ;; Regular operation. |
| 3780 | (if (= count 0) | 3795 | (if (= count 0) |
| 3781 | (should-not (file-attributes file)) | 3796 | (should-not (file-attributes file)) |
| 3782 | (should (file-attributes file))) | 3797 | (should (file-attributes file))) |
| 3783 | ;; Send string to process. | 3798 | ;; Send string to process. |
| 3799 | (tramp--test-message | ||
| 3800 | "Trace 1 action %d %s %s" count buf (current-time-string)) | ||
| 3784 | (process-send-string proc (format "%s\n" (buffer-name buf))) | 3801 | (process-send-string proc (format "%s\n" (buffer-name buf))) |
| 3802 | (tramp--test-message | ||
| 3803 | "Trace 2 action %d %s %s" count buf (current-time-string)) | ||
| 3785 | (accept-process-output proc 0.1 nil 0) | 3804 | (accept-process-output proc 0.1 nil 0) |
| 3786 | ;; Regular operation. | 3805 | ;; Regular operation. |
| 3806 | (tramp--test-message | ||
| 3807 | "Trace 3 action %d %s %s" count buf (current-time-string)) | ||
| 3787 | (if (= count 2) | 3808 | (if (= count 2) |
| 3788 | (should-not (file-attributes file)) | 3809 | (if (= (length buffers) 1) |
| 3810 | (tramp--test-instrument-test-case 10 | ||
| 3811 | (should-not (file-attributes file))) | ||
| 3812 | (should-not (file-attributes file))) | ||
| 3789 | (should (file-attributes file))) | 3813 | (should (file-attributes file))) |
| 3814 | (tramp--test-message | ||
| 3815 | "Stop action %d %s %s" count buf (current-time-string)) | ||
| 3790 | (process-put proc 'bar (1+ count)) | 3816 | (process-put proc 'bar (1+ count)) |
| 3791 | (unless (process-live-p proc) | 3817 | (unless (process-live-p proc) |
| 3792 | (setq buffers (delq buf buffers)))))) | 3818 | (setq buffers (delq buf buffers)))))) |
| @@ -3794,6 +3820,8 @@ process sentinels. They shall not disturb each other." | |||
| 3794 | ;; Checks. All process output shall exists in the | 3820 | ;; Checks. All process output shall exists in the |
| 3795 | ;; respective buffers. All created files shall be | 3821 | ;; respective buffers. All created files shall be |
| 3796 | ;; deleted. | 3822 | ;; deleted. |
| 3823 | (tramp--test-message | ||
| 3824 | "Check %s" (current-time-string)) | ||
| 3797 | (dolist (buf buffers) | 3825 | (dolist (buf buffers) |
| 3798 | (with-current-buffer buf | 3826 | (with-current-buffer buf |
| 3799 | (should (string-equal (format "%s\n" buf) (buffer-string))))) | 3827 | (should (string-equal (format "%s\n" buf) (buffer-string))))) |
| @@ -3857,8 +3885,6 @@ process sentinels. They shall not disturb each other." | |||
| 3857 | (ert-deftest tramp-test39-unload () | 3885 | (ert-deftest tramp-test39-unload () |
| 3858 | "Check that Tramp and its subpackages unload completely. | 3886 | "Check that Tramp and its subpackages unload completely. |
| 3859 | Since it unloads Tramp, it shall be the last test to run." | 3887 | Since it unloads Tramp, it shall be the last test to run." |
| 3860 | ;; Mark as failed until all symbols are unbound. | ||
| 3861 | :expected-result (if (featurep 'tramp) :failed :passed) | ||
| 3862 | :tags '(:expensive-test) | 3888 | :tags '(:expensive-test) |
| 3863 | (skip-unless noninteractive) | 3889 | (skip-unless noninteractive) |
| 3864 | 3890 | ||
| @@ -3869,21 +3895,31 @@ Since it unloads Tramp, it shall be the last test to run." | |||
| 3869 | (should-not (all-completions "tramp" (delq 'tramp-tests features))) | 3895 | (should-not (all-completions "tramp" (delq 'tramp-tests features))) |
| 3870 | ;; `file-name-handler-alist' must be clean. | 3896 | ;; `file-name-handler-alist' must be clean. |
| 3871 | (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) | 3897 | (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) |
| 3872 | ;; There shouldn't be left a bound symbol. We do not regard our | 3898 | ;; There shouldn't be left a bound symbol, except buffer-local |
| 3873 | ;; test symbols, and the Tramp unload hooks. | 3899 | ;; variables, and autoload functions. We do not regard our test |
| 3900 | ;; symbols, and the Tramp unload hooks. | ||
| 3874 | (mapatoms | 3901 | (mapatoms |
| 3875 | (lambda (x) | 3902 | (lambda (x) |
| 3876 | (and (or (boundp x) (functionp x)) | 3903 | (and (or (and (boundp x) (null (local-variable-if-set-p x))) |
| 3904 | (and (functionp x) (null (autoloadp (symbol-function x))))) | ||
| 3877 | (string-match "^tramp" (symbol-name x)) | 3905 | (string-match "^tramp" (symbol-name x)) |
| 3878 | (not (string-match "^tramp--?test" (symbol-name x))) | 3906 | (not (string-match "^tramp--?test" (symbol-name x))) |
| 3879 | (not (string-match "unload-hook$" (symbol-name x))) | 3907 | (not (string-match "unload-hook$" (symbol-name x))) |
| 3880 | (ert-fail (format "`%s' still bound" x))))) | 3908 | (ert-fail (format "`%s' still bound" x))))) |
| 3909 | ;; The defstruct `tramp-file-name' and all its internal functions | ||
| 3910 | ;; shall be purged. | ||
| 3911 | (should-not (cl--find-class 'tramp-file-name)) | ||
| 3912 | (mapatoms | ||
| 3913 | (lambda (x) | ||
| 3914 | (and (string-match "tramp-file-name" (symbol-name x)) | ||
| 3915 | (functionp x) | ||
| 3916 | (ert-fail (format "Structure function `%s' still exists" x))))) | ||
| 3881 | ;; There shouldn't be left a hook function containing a Tramp | 3917 | ;; There shouldn't be left a hook function containing a Tramp |
| 3882 | ;; function. We do not regard the Tramp unload hooks. | 3918 | ;; function. We do not regard the Tramp unload hooks. |
| 3883 | (mapatoms | 3919 | (mapatoms |
| 3884 | (lambda (x) | 3920 | (lambda (x) |
| 3885 | (and (boundp x) | 3921 | (and (boundp x) |
| 3886 | (string-match "-hooks?$" (symbol-name x)) | 3922 | (string-match "-\\(hook\\|function\\)s?$" (symbol-name x)) |
| 3887 | (not (string-match "unload-hook$" (symbol-name x))) | 3923 | (not (string-match "unload-hook$" (symbol-name x))) |
| 3888 | (consp (symbol-value x)) | 3924 | (consp (symbol-value x)) |
| 3889 | (ignore-errors (all-completions "tramp" (symbol-value x))) | 3925 | (ignore-errors (all-completions "tramp" (symbol-value x))) |
| @@ -3904,11 +3940,7 @@ Since it unloads Tramp, it shall be the last test to run." | |||
| 3904 | ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. | 3940 | ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. |
| 3905 | ;; * Fix `tramp-test06-directory-file-name' for `ftp'. | 3941 | ;; * Fix `tramp-test06-directory-file-name' for `ftp'. |
| 3906 | ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). | 3942 | ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). |
| 3907 | ;; * Fix Bug#27009. Set expected error of | ||
| 3908 | ;; `tramp-test29-environment-variables-and-port-numbers'. | ||
| 3909 | ;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'. | 3943 | ;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'. |
| 3910 | ;; * Fix `tramp-test39-unload' (Not all symbols are unbound). Set | ||
| 3911 | ;; expected error. | ||
| 3912 | 3944 | ||
| 3913 | (defun tramp-test-all (&optional interactive) | 3945 | (defun tramp-test-all (&optional interactive) |
| 3914 | "Run all tests for \\[tramp]." | 3946 | "Run all tests for \\[tramp]." |
diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el new file mode 100644 index 00000000000..8fff6f73520 --- /dev/null +++ b/test/lisp/ses-tests.el | |||
| @@ -0,0 +1,175 @@ | |||
| 1 | ;;; ses-tests.el --- Tests for ses.el -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2015-2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Vincent Belaïche <vincentb1@users.sourceforge.net> | ||
| 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 | ;;; Code: | ||
| 23 | |||
| 24 | (require 'ert) | ||
| 25 | (require 'ses) | ||
| 26 | |||
| 27 | |||
| 28 | ;; PLAIN FORMULA TESTS | ||
| 29 | ;; ====================================================================== | ||
| 30 | |||
| 31 | (ert-deftest ses-tests-lowlevel-plain-formula () | ||
| 32 | "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value | ||
| 33 | equal to 2. This is done with low level functions calls, not like | ||
| 34 | interactively." | ||
| 35 | (let ((ses-initial-size '(2 . 1))) | ||
| 36 | (with-temp-buffer | ||
| 37 | (ses-mode) | ||
| 38 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) | ||
| 39 | (apply 'ses-cell-set-formula c) | ||
| 40 | (apply 'ses-calculate-cell (list (car c) (cadr c) nil))) | ||
| 41 | (should (eq A2 2))))) | ||
| 42 | |||
| 43 | (ert-deftest ses-tests-plain-formula () | ||
| 44 | "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value | ||
| 45 | equal to 2. This is done using interactive calls." | ||
| 46 | (let ((ses-initial-size '(2 . 1))) | ||
| 47 | (with-temp-buffer | ||
| 48 | (ses-mode) | ||
| 49 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) | ||
| 50 | (apply 'funcall-interactively 'ses-edit-cell c)) | ||
| 51 | (ses-command-hook) | ||
| 52 | (should (eq A2 2))))) | ||
| 53 | |||
| 54 | ;; PLAIN CELL RENAMING TESTS | ||
| 55 | ;; ====================================================================== | ||
| 56 | |||
| 57 | (ert-deftest ses-tests-lowlevel-renamed-cell () | ||
| 58 | "Check that renaming A1 to `foo' and setting `foo' to 1 and A2 to (1+ foo), makes A2 value equal to 2. | ||
| 59 | This is done using low level functions, `ses-rename-cell' is not | ||
| 60 | called but instead we use text replacement in the buffer | ||
| 61 | previously passed in text mode." | ||
| 62 | (let ((ses-initial-size '(2 . 1))) | ||
| 63 | (with-temp-buffer | ||
| 64 | (ses-mode) | ||
| 65 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) | ||
| 66 | (apply 'ses-cell-set-formula c) | ||
| 67 | (apply 'ses-calculate-cell (list (car c) (cadr c) nil))) | ||
| 68 | (ses-write-cells) | ||
| 69 | (text-mode) | ||
| 70 | (goto-char (point-min)) | ||
| 71 | (while (re-search-forward "\\<A1\\>" nil t) | ||
| 72 | (replace-match "foo" t t)) | ||
| 73 | (ses-mode) | ||
| 74 | (should-not (local-variable-p 'A1)) | ||
| 75 | (should (eq foo 1)) | ||
| 76 | (should (equal (ses-cell-formula 1 0) '(ses-safe-formula (1+ foo)))) | ||
| 77 | (should (eq A2 2))))) | ||
| 78 | |||
| 79 | (ert-deftest ses-tests-renamed-cell () | ||
| 80 | "Check that renaming A1 to `foo' and setting `foo' to 1 and A2 | ||
| 81 | to (1+ foo), makes A2 value equal to 2." | ||
| 82 | (let ((ses-initial-size '(2 . 1))) | ||
| 83 | (with-temp-buffer | ||
| 84 | (ses-mode) | ||
| 85 | (ses-rename-cell 'foo (ses-get-cell 0 0)) | ||
| 86 | (dolist (c '((0 0 1) (1 0 (1+ foo)))) | ||
| 87 | (apply 'funcall-interactively 'ses-edit-cell c)) | ||
| 88 | (ses-command-hook) | ||
| 89 | (should-not (local-variable-p 'A1)) | ||
| 90 | (should (eq foo 1)) | ||
| 91 | (should (equal (ses-cell-formula 1 0) '(1+ foo))) | ||
| 92 | (should (eq A2 2))))) | ||
| 93 | |||
| 94 | (ert-deftest ses-tests-renamed-cell-after-setting () | ||
| 95 | "Check that setting A1 to 1 and A2 to (1+ A1), and then | ||
| 96 | renaming A1 to `foo' makes `foo' value equal to 2." | ||
| 97 | (let ((ses-initial-size '(2 . 1))) | ||
| 98 | (with-temp-buffer | ||
| 99 | (ses-mode) | ||
| 100 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) | ||
| 101 | (apply 'funcall-interactively 'ses-edit-cell c)) | ||
| 102 | (ses-command-hook); deferred recalc | ||
| 103 | (ses-rename-cell 'foo (ses-get-cell 0 0)) | ||
| 104 | (should-not (local-variable-p 'A1)) | ||
| 105 | (should (eq foo 1)) | ||
| 106 | (should (equal (ses-cell-formula 1 0) '(1+ foo))) | ||
| 107 | (should (eq A2 2))))) | ||
| 108 | |||
| 109 | (ert-deftest ses-tests-renaming-cell-with-one-symbol-formula () | ||
| 110 | "Check that setting A1 to 1 and A2 to A1, and then renaming A1 | ||
| 111 | to `foo' makes `foo' value equal to 1. Then set A1 to 2 and check | ||
| 112 | that `foo' becomes 2." | ||
| 113 | (let ((ses-initial-size '(3 . 1))) | ||
| 114 | (with-temp-buffer | ||
| 115 | (ses-mode) | ||
| 116 | (dolist (c '((0 0 1) (1 0 A1))) | ||
| 117 | (apply 'funcall-interactively 'ses-edit-cell c)) | ||
| 118 | (ses-command-hook); deferred recalc | ||
| 119 | (ses-rename-cell 'foo (ses-get-cell 0 0)) | ||
| 120 | (ses-command-hook); deferred recalc | ||
| 121 | (should-not (local-variable-p 'A1)) | ||
| 122 | (should (eq foo 1)) | ||
| 123 | (should (equal (ses-cell-formula 1 0) 'foo)) | ||
| 124 | (should (eq A2 1)) | ||
| 125 | (funcall-interactively 'ses-edit-cell 0 0 2) | ||
| 126 | (ses-command-hook); deferred recalc | ||
| 127 | (should (eq A2 2)) | ||
| 128 | (should (eq foo 2))))) | ||
| 129 | |||
| 130 | |||
| 131 | ;; ROW INSERTION TESTS | ||
| 132 | ;; ====================================================================== | ||
| 133 | |||
| 134 | (ert-deftest ses-tests-plain-row-insertion () | ||
| 135 | "Check that setting A1 to 1 and A2 to (1+ A1), and then jumping | ||
| 136 | to A2 and inserting a row, makes A2 value empty, and A3 equal to | ||
| 137 | 2." | ||
| 138 | (let ((ses-initial-size '(2 . 1))) | ||
| 139 | (with-temp-buffer | ||
| 140 | (ses-mode) | ||
| 141 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) | ||
| 142 | (apply 'funcall-interactively 'ses-edit-cell c)) | ||
| 143 | (ses-command-hook) | ||
| 144 | (ses-jump 'A2) | ||
| 145 | (ses-insert-row 1) | ||
| 146 | (ses-command-hook) | ||
| 147 | (should-not A2) | ||
| 148 | (should (eq A3 2))))) | ||
| 149 | |||
| 150 | ; (defvar ses-tests-trigger nil) | ||
| 151 | |||
| 152 | (ert-deftest ses-tests-renamed-cells-row-insertion () | ||
| 153 | "Check that setting A1 to 1 and A2 to (1+ A1), and then renaming A1 to `foo' and A2 to `bar' jumping | ||
| 154 | to `bar' and inserting a row, makes A2 value empty, and `bar' equal to | ||
| 155 | 2." | ||
| 156 | (setq ses-tests-trigger nil) | ||
| 157 | (let ((ses-initial-size '(2 . 1))) | ||
| 158 | (with-temp-buffer | ||
| 159 | (ses-mode) | ||
| 160 | (dolist (c '((0 0 1) (1 0 (1+ A1)))) | ||
| 161 | (apply 'funcall-interactively 'ses-edit-cell c)) | ||
| 162 | (ses-command-hook) | ||
| 163 | (ses-rename-cell 'foo (ses-get-cell 0 0)) | ||
| 164 | (ses-command-hook) | ||
| 165 | (ses-rename-cell 'bar (ses-get-cell 1 0)) | ||
| 166 | (ses-command-hook) | ||
| 167 | (should (eq bar 2)) | ||
| 168 | (ses-jump 'bar) | ||
| 169 | (ses-insert-row 1) | ||
| 170 | (ses-command-hook) | ||
| 171 | (should-not A2) | ||
| 172 | (should (eq bar 2))))) | ||
| 173 | |||
| 174 | |||
| 175 | (provide 'ses-tests) | ||
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 54f4ab5d1b2..7e50429a5bf 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el | |||
| @@ -258,9 +258,9 @@ This exercises `backtrace-frame', and indirectly `mapbacktrace'." | |||
| 258 | (should (equal (mapbacktrace #'error unbound) nil))) | 258 | (should (equal (mapbacktrace #'error unbound) nil))) |
| 259 | ;; First frame is backtrace-related function | 259 | ;; First frame is backtrace-related function |
| 260 | (should (equal (backtrace-frame 0) '(t backtrace-frame 0))) | 260 | (should (equal (backtrace-frame 0) '(t backtrace-frame 0))) |
| 261 | (should (equal (catch 'ret | 261 | (let ((throw-args (lambda (&rest args) (throw 'ret args)))) |
| 262 | (mapbacktrace (lambda (&rest args) (throw 'ret args)))) | 262 | (should (equal (catch 'ret (mapbacktrace throw-args)) |
| 263 | '(t mapbacktrace ((lambda (&rest args) (throw 'ret args))) nil))) | 263 | `(t mapbacktrace (,throw-args) nil)))) |
| 264 | ;; Past-end NFRAMES is silently ignored | 264 | ;; Past-end NFRAMES is silently ignored |
| 265 | (should (equal (backtrace-frame most-positive-fixnum) nil))) | 265 | (should (equal (backtrace-frame most-positive-fixnum) nil))) |
| 266 | 266 | ||
diff --git a/test/manual/BidiCharacterTest.txt b/test/manual/BidiCharacterTest.txt index 7e04d6cb3c0..a3d2b46cc40 100644 --- a/test/manual/BidiCharacterTest.txt +++ b/test/manual/BidiCharacterTest.txt | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | # BidiCharacterTest-9.0.0.txt | 1 | # BidiCharacterTest-10.0.0.txt |
| 2 | # Date: 2016-01-15, 22:30:00 GMT [LI] | 2 | # Date: 2017-03-09, 00:30:00 GMT [LI] |
| 3 | # © 2016 Unicode®, Inc. | 3 | # © 2017 Unicode®, Inc. |
| 4 | # For terms of use, see http://www.unicode.org/terms_of_use.html | 4 | # For terms of use, see http://www.unicode.org/terms_of_use.html |
| 5 | # | 5 | # |
| 6 | # Unicode Character Database | 6 | # Unicode Character Database |
diff --git a/test/manual/etags/CTAGS.good b/test/manual/etags/CTAGS.good index 13bb37c2e6a..519315c6fdd 100644 --- a/test/manual/etags/CTAGS.good +++ b/test/manual/etags/CTAGS.good | |||
| @@ -202,6 +202,7 @@ ${CHECKOBJS} make-src/Makefile /^${CHECKOBJS}: CFLAGS=-g3 -DNULLFREECHECK=0$/ | |||
| 202 | =\relax tex-src/texinfo.tex /^\\let\\subsubsection=\\relax$/ | 202 | =\relax tex-src/texinfo.tex /^\\let\\subsubsection=\\relax$/ |
| 203 | =\relax tex-src/texinfo.tex /^\\let\\appendix=\\relax$/ | 203 | =\relax tex-src/texinfo.tex /^\\let\\appendix=\\relax$/ |
| 204 | =\smartitalic tex-src/texinfo.tex /^\\let\\cite=\\smartitalic$/ | 204 | =\smartitalic tex-src/texinfo.tex /^\\let\\cite=\\smartitalic$/ |
| 205 | =starts-with-equals! scm-src/test.scm /^(define =starts-with-equals! #t)$/ | ||
| 205 | > tex-src/texinfo.tex /^\\def>{{\\tt \\gtr}}$/ | 206 | > tex-src/texinfo.tex /^\\def>{{\\tt \\gtr}}$/ |
| 206 | >field1 forth-src/test-forth.fth /^ 9 field >field1$/ | 207 | >field1 forth-src/test-forth.fth /^ 9 field >field1$/ |
| 207 | >field2 forth-src/test-forth.fth /^ 5 field >field2$/ | 208 | >field2 forth-src/test-forth.fth /^ 5 field >field2$/ |
| @@ -2750,6 +2751,7 @@ current-idle-time c-src/emacs/src/keyboard.c /^DEFUN ("current-idle-time", Fcurr | |||
| 2750 | current-input-mode c-src/emacs/src/keyboard.c /^DEFUN ("current-input-mode", Fcurrent_input_mode, / | 2751 | current-input-mode c-src/emacs/src/keyboard.c /^DEFUN ("current-input-mode", Fcurrent_input_mode, / |
| 2751 | current_kboard c-src/emacs/src/keyboard.c 85 | 2752 | current_kboard c-src/emacs/src/keyboard.c 85 |
| 2752 | current_lb_is_new c-src/etags.c 2926 | 2753 | current_lb_is_new c-src/etags.c 2926 |
| 2754 | curry-test scm-src/test.scm /^(define (((((curry-test a) b) c) d) e)$/ | ||
| 2753 | cursor_position cp-src/screen.cpp /^void cursor_position(void)$/ | 2755 | cursor_position cp-src/screen.cpp /^void cursor_position(void)$/ |
| 2754 | cursor_x cp-src/screen.cpp 15 | 2756 | cursor_x cp-src/screen.cpp 15 |
| 2755 | cursor_y cp-src/screen.cpp 15 | 2757 | cursor_y cp-src/screen.cpp 15 |
| @@ -3037,6 +3039,7 @@ foo ruby-src/test1.ru /^ attr_reader :foo$/ | |||
| 3037 | foo! ruby-src/test1.ru /^ def foo!$/ | 3039 | foo! ruby-src/test1.ru /^ def foo!$/ |
| 3038 | foo1 ruby-src/test1.ru /^ attr_reader(:foo1, :bar1, # comment$/ | 3040 | foo1 ruby-src/test1.ru /^ attr_reader(:foo1, :bar1, # comment$/ |
| 3039 | foo2 ruby-src/test1.ru /^ alias_method ( :foo2, #cmmt$/ | 3041 | foo2 ruby-src/test1.ru /^ alias_method ( :foo2, #cmmt$/ |
| 3042 | foo==bar el-src/TAGTEST.EL /^(defun foo==bar () (message "hi")) ; Bug#5624$/ | ||
| 3040 | foobar c-src/c.c /^int foobar() {;}$/ | 3043 | foobar c-src/c.c /^int foobar() {;}$/ |
| 3041 | foobar c.c /^extern void foobar (void) __attribute__ ((section / | 3044 | foobar c.c /^extern void foobar (void) __attribute__ ((section / |
| 3042 | foobar2 c-src/h.h 20 | 3045 | foobar2 c-src/h.h 20 |
| @@ -3161,6 +3164,9 @@ header c-src/emacs/src/lisp.h 1672 | |||
| 3161 | header c-src/emacs/src/lisp.h 1826 | 3164 | header c-src/emacs/src/lisp.h 1826 |
| 3162 | header_size c-src/emacs/src/lisp.h 1471 | 3165 | header_size c-src/emacs/src/lisp.h 1471 |
| 3163 | heapsize c-src/emacs/src/gmalloc.c 361 | 3166 | heapsize c-src/emacs/src/gmalloc.c 361 |
| 3167 | hello scm-src/test.scm /^(define hello "Hello, Emacs!")$/ | ||
| 3168 | hello scm-src/test.scm /^(set! hello "Hello, world!")$/ | ||
| 3169 | hello-world scm-src/test.scm /^(define (hello-world)$/ | ||
| 3164 | help c-src/etags.c 193 | 3170 | help c-src/etags.c 193 |
| 3165 | helpPanel objcpp-src/SimpleCalc.M /^- helpPanel:sender$/ | 3171 | helpPanel objcpp-src/SimpleCalc.M /^- helpPanel:sender$/ |
| 3166 | help_char_p c-src/emacs/src/keyboard.c /^help_char_p (Lisp_Object c)$/ | 3172 | help_char_p c-src/emacs/src/keyboard.c /^help_char_p (Lisp_Object c)$/ |
| @@ -4317,10 +4323,12 @@ test erl-src/gs_dialog.erl /^test() ->$/ | |||
| 4317 | test go-src/test1.go /^func test(p plus) {$/ | 4323 | test go-src/test1.go /^func test(p plus) {$/ |
| 4318 | test make-src/Makefile /^test:$/ | 4324 | test make-src/Makefile /^test:$/ |
| 4319 | test php-src/ptest.php /^test $/ | 4325 | test php-src/ptest.php /^test $/ |
| 4326 | test-begin scm-src/test.scm /^(define-syntax test-begin$/ | ||
| 4320 | test.me22b lua-src/test.lua /^ local function test.me22b (one)$/ | 4327 | test.me22b lua-src/test.lua /^ local function test.me22b (one)$/ |
| 4321 | test.me_22a lua-src/test.lua /^ function test.me_22a(one, two)$/ | 4328 | test.me_22a lua-src/test.lua /^ function test.me_22a(one, two)$/ |
| 4322 | test_undefined c-src/emacs/src/keyboard.c /^test_undefined (Lisp_Object binding)$/ | 4329 | test_undefined c-src/emacs/src/keyboard.c /^test_undefined (Lisp_Object binding)$/ |
| 4323 | texttreelist prol-src/natded.prolog /^texttreelist([]).$/ | 4330 | texttreelist prol-src/natded.prolog /^texttreelist([]).$/ |
| 4331 | there-is-a-=-in-the-middle! scm-src/test.scm /^(define (there-is-a-=-in-the-middle!) #t)$/ | ||
| 4324 | this c-src/a/b/b.c 1 | 4332 | this c-src/a/b/b.c 1 |
| 4325 | this-command-keys c-src/emacs/src/keyboard.c /^DEFUN ("this-command-keys", Fthis_command_keys, St/ | 4333 | this-command-keys c-src/emacs/src/keyboard.c /^DEFUN ("this-command-keys", Fthis_command_keys, St/ |
| 4326 | this-command-keys-vector c-src/emacs/src/keyboard.c /^DEFUN ("this-command-keys-vector", Fthis_command_k/ | 4334 | this-command-keys-vector c-src/emacs/src/keyboard.c /^DEFUN ("this-command-keys-vector", Fthis_command_k/ |
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1 index 6c4a02ae1c1..cd9cd4a8450 100644 --- a/test/manual/etags/ETAGS.good_1 +++ b/test/manual/etags/ETAGS.good_1 | |||
| @@ -2143,10 +2143,11 @@ main(37,571 | |||
| 2143 | class D 41,622 | 2143 | class D 41,622 |
| 2144 | D(43,659 | 2144 | D(43,659 |
| 2145 | 2145 | ||
| 2146 | el-src/TAGTEST.EL,148 | 2146 | el-src/TAGTEST.EL,179 |
| 2147 | (foo::defmumble bletch 1,0 | 2147 | (foo::defmumble bletch 1,0 |
| 2148 | (defalias 'pending-delete-mode pending-delete-mode5,102 | 2148 | (defun foo==bar foo==bar2,33 |
| 2149 | (defalias (quote explicitly-quoted-pending-delete-mode)8,175 | 2149 | (defalias 'pending-delete-mode pending-delete-mode6,149 |
| 2150 | (defalias (quote explicitly-quoted-pending-delete-mode)9,222 | ||
| 2150 | 2151 | ||
| 2151 | el-src/emacs/lisp/progmodes/etags.el,5069 | 2152 | el-src/emacs/lisp/progmodes/etags.el,5069 |
| 2152 | (defvar tags-file-name 34,1034 | 2153 | (defvar tags-file-name 34,1034 |
| @@ -3135,6 +3136,15 @@ module A9,57 | |||
| 3135 | alias_method ( :foo2,foo237,586 | 3136 | alias_method ( :foo2,foo237,586 |
| 3136 | A::Constant Constant42,655 | 3137 | A::Constant Constant42,655 |
| 3137 | 3138 | ||
| 3139 | scm-src/test.scm,260 | ||
| 3140 | (define hello 1,0 | ||
| 3141 | (set! hello 3,32 | ||
| 3142 | (define (hello-world)5,62 | ||
| 3143 | (define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128 | ||
| 3144 | (define =starts-with-equals! =starts-with-equals!12,171 | ||
| 3145 | (define (((((curry-test 14,205 | ||
| 3146 | (define-syntax test-begin17,265 | ||
| 3147 | |||
| 3138 | tex-src/testenv.tex,52 | 3148 | tex-src/testenv.tex,52 |
| 3139 | \newcommand{\nm}\nm4,77 | 3149 | \newcommand{\nm}\nm4,77 |
| 3140 | \section{blah}blah8,139 | 3150 | \section{blah}blah8,139 |
| @@ -3145,11 +3155,11 @@ tex-src/gzip.texi,303 | |||
| 3145 | @node Overview,83,2705 | 3155 | @node Overview,83,2705 |
| 3146 | @node Sample,166,7272 | 3156 | @node Sample,166,7272 |
| 3147 | @node Invoking gzip,Invoking gzip210,8828 | 3157 | @node Invoking gzip,Invoking gzip210,8828 |
| 3148 | @node Advanced usage,Advanced usage357,13495 | 3158 | @node Advanced usage,Advanced usage357,13496 |
| 3149 | @node Environment,420,15207 | 3159 | @node Environment,420,15208 |
| 3150 | @node Tapes,437,15768 | 3160 | @node Tapes,437,15769 |
| 3151 | @node Problems,460,16767 | 3161 | @node Problems,460,16768 |
| 3152 | @node Concept Index,Concept Index473,17287 | 3162 | @node Concept Index,Concept Index473,17288 |
| 3153 | 3163 | ||
| 3154 | tex-src/texinfo.tex,30627 | 3164 | tex-src/texinfo.tex,30627 |
| 3155 | \def\texinfoversion{\texinfoversion26,1032 | 3165 | \def\texinfoversion{\texinfoversion26,1032 |
diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2 index fa784d2e7b5..54fd00e95da 100644 --- a/test/manual/etags/ETAGS.good_2 +++ b/test/manual/etags/ETAGS.good_2 | |||
| @@ -2712,10 +2712,11 @@ main(37,571 | |||
| 2712 | class D 41,622 | 2712 | class D 41,622 |
| 2713 | D(43,659 | 2713 | D(43,659 |
| 2714 | 2714 | ||
| 2715 | el-src/TAGTEST.EL,148 | 2715 | el-src/TAGTEST.EL,179 |
| 2716 | (foo::defmumble bletch 1,0 | 2716 | (foo::defmumble bletch 1,0 |
| 2717 | (defalias 'pending-delete-mode pending-delete-mode5,102 | 2717 | (defun foo==bar foo==bar2,33 |
| 2718 | (defalias (quote explicitly-quoted-pending-delete-mode)8,175 | 2718 | (defalias 'pending-delete-mode pending-delete-mode6,149 |
| 2719 | (defalias (quote explicitly-quoted-pending-delete-mode)9,222 | ||
| 2719 | 2720 | ||
| 2720 | el-src/emacs/lisp/progmodes/etags.el,5188 | 2721 | el-src/emacs/lisp/progmodes/etags.el,5188 |
| 2721 | (defvar tags-file-name 34,1034 | 2722 | (defvar tags-file-name 34,1034 |
| @@ -3708,6 +3709,15 @@ module A9,57 | |||
| 3708 | alias_method ( :foo2,foo237,586 | 3709 | alias_method ( :foo2,foo237,586 |
| 3709 | A::Constant Constant42,655 | 3710 | A::Constant Constant42,655 |
| 3710 | 3711 | ||
| 3712 | scm-src/test.scm,260 | ||
| 3713 | (define hello 1,0 | ||
| 3714 | (set! hello 3,32 | ||
| 3715 | (define (hello-world)5,62 | ||
| 3716 | (define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128 | ||
| 3717 | (define =starts-with-equals! =starts-with-equals!12,171 | ||
| 3718 | (define (((((curry-test 14,205 | ||
| 3719 | (define-syntax test-begin17,265 | ||
| 3720 | |||
| 3711 | tex-src/testenv.tex,52 | 3721 | tex-src/testenv.tex,52 |
| 3712 | \newcommand{\nm}\nm4,77 | 3722 | \newcommand{\nm}\nm4,77 |
| 3713 | \section{blah}blah8,139 | 3723 | \section{blah}blah8,139 |
| @@ -3718,11 +3728,11 @@ tex-src/gzip.texi,303 | |||
| 3718 | @node Overview,83,2705 | 3728 | @node Overview,83,2705 |
| 3719 | @node Sample,166,7272 | 3729 | @node Sample,166,7272 |
| 3720 | @node Invoking gzip,Invoking gzip210,8828 | 3730 | @node Invoking gzip,Invoking gzip210,8828 |
| 3721 | @node Advanced usage,Advanced usage357,13495 | 3731 | @node Advanced usage,Advanced usage357,13496 |
| 3722 | @node Environment,420,15207 | 3732 | @node Environment,420,15208 |
| 3723 | @node Tapes,437,15768 | 3733 | @node Tapes,437,15769 |
| 3724 | @node Problems,460,16767 | 3734 | @node Problems,460,16768 |
| 3725 | @node Concept Index,Concept Index473,17287 | 3735 | @node Concept Index,Concept Index473,17288 |
| 3726 | 3736 | ||
| 3727 | tex-src/texinfo.tex,30627 | 3737 | tex-src/texinfo.tex,30627 |
| 3728 | \def\texinfoversion{\texinfoversion26,1032 | 3738 | \def\texinfoversion{\texinfoversion26,1032 |
diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3 index 547dee2d43c..508427c501c 100644 --- a/test/manual/etags/ETAGS.good_3 +++ b/test/manual/etags/ETAGS.good_3 | |||
| @@ -2520,10 +2520,11 @@ main(37,571 | |||
| 2520 | D(43,659 | 2520 | D(43,659 |
| 2521 | int x;44,694 | 2521 | int x;44,694 |
| 2522 | 2522 | ||
| 2523 | el-src/TAGTEST.EL,148 | 2523 | el-src/TAGTEST.EL,179 |
| 2524 | (foo::defmumble bletch 1,0 | 2524 | (foo::defmumble bletch 1,0 |
| 2525 | (defalias 'pending-delete-mode pending-delete-mode5,102 | 2525 | (defun foo==bar foo==bar2,33 |
| 2526 | (defalias (quote explicitly-quoted-pending-delete-mode)8,175 | 2526 | (defalias 'pending-delete-mode pending-delete-mode6,149 |
| 2527 | (defalias (quote explicitly-quoted-pending-delete-mode)9,222 | ||
| 2527 | 2528 | ||
| 2528 | el-src/emacs/lisp/progmodes/etags.el,5069 | 2529 | el-src/emacs/lisp/progmodes/etags.el,5069 |
| 2529 | (defvar tags-file-name 34,1034 | 2530 | (defvar tags-file-name 34,1034 |
| @@ -3542,6 +3543,15 @@ module A9,57 | |||
| 3542 | alias_method ( :foo2,foo237,586 | 3543 | alias_method ( :foo2,foo237,586 |
| 3543 | A::Constant Constant42,655 | 3544 | A::Constant Constant42,655 |
| 3544 | 3545 | ||
| 3546 | scm-src/test.scm,260 | ||
| 3547 | (define hello 1,0 | ||
| 3548 | (set! hello 3,32 | ||
| 3549 | (define (hello-world)5,62 | ||
| 3550 | (define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128 | ||
| 3551 | (define =starts-with-equals! =starts-with-equals!12,171 | ||
| 3552 | (define (((((curry-test 14,205 | ||
| 3553 | (define-syntax test-begin17,265 | ||
| 3554 | |||
| 3545 | tex-src/testenv.tex,52 | 3555 | tex-src/testenv.tex,52 |
| 3546 | \newcommand{\nm}\nm4,77 | 3556 | \newcommand{\nm}\nm4,77 |
| 3547 | \section{blah}blah8,139 | 3557 | \section{blah}blah8,139 |
| @@ -3552,11 +3562,11 @@ tex-src/gzip.texi,303 | |||
| 3552 | @node Overview,83,2705 | 3562 | @node Overview,83,2705 |
| 3553 | @node Sample,166,7272 | 3563 | @node Sample,166,7272 |
| 3554 | @node Invoking gzip,Invoking gzip210,8828 | 3564 | @node Invoking gzip,Invoking gzip210,8828 |
| 3555 | @node Advanced usage,Advanced usage357,13495 | 3565 | @node Advanced usage,Advanced usage357,13496 |
| 3556 | @node Environment,420,15207 | 3566 | @node Environment,420,15208 |
| 3557 | @node Tapes,437,15768 | 3567 | @node Tapes,437,15769 |
| 3558 | @node Problems,460,16767 | 3568 | @node Problems,460,16768 |
| 3559 | @node Concept Index,Concept Index473,17287 | 3569 | @node Concept Index,Concept Index473,17288 |
| 3560 | 3570 | ||
| 3561 | tex-src/texinfo.tex,30627 | 3571 | tex-src/texinfo.tex,30627 |
| 3562 | \def\texinfoversion{\texinfoversion26,1032 | 3572 | \def\texinfoversion{\texinfoversion26,1032 |
diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4 index 2c50ec1a742..460e31b5d96 100644 --- a/test/manual/etags/ETAGS.good_4 +++ b/test/manual/etags/ETAGS.good_4 | |||
| @@ -2307,10 +2307,11 @@ main(37,571 | |||
| 2307 | class D 41,622 | 2307 | class D 41,622 |
| 2308 | D(43,659 | 2308 | D(43,659 |
| 2309 | 2309 | ||
| 2310 | el-src/TAGTEST.EL,148 | 2310 | el-src/TAGTEST.EL,179 |
| 2311 | (foo::defmumble bletch 1,0 | 2311 | (foo::defmumble bletch 1,0 |
| 2312 | (defalias 'pending-delete-mode pending-delete-mode5,102 | 2312 | (defun foo==bar foo==bar2,33 |
| 2313 | (defalias (quote explicitly-quoted-pending-delete-mode)8,175 | 2313 | (defalias 'pending-delete-mode pending-delete-mode6,149 |
| 2314 | (defalias (quote explicitly-quoted-pending-delete-mode)9,222 | ||
| 2314 | 2315 | ||
| 2315 | el-src/emacs/lisp/progmodes/etags.el,5069 | 2316 | el-src/emacs/lisp/progmodes/etags.el,5069 |
| 2316 | (defvar tags-file-name 34,1034 | 2317 | (defvar tags-file-name 34,1034 |
| @@ -3299,6 +3300,15 @@ module A9,57 | |||
| 3299 | alias_method ( :foo2,foo237,586 | 3300 | alias_method ( :foo2,foo237,586 |
| 3300 | A::Constant Constant42,655 | 3301 | A::Constant Constant42,655 |
| 3301 | 3302 | ||
| 3303 | scm-src/test.scm,260 | ||
| 3304 | (define hello 1,0 | ||
| 3305 | (set! hello 3,32 | ||
| 3306 | (define (hello-world)5,62 | ||
| 3307 | (define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128 | ||
| 3308 | (define =starts-with-equals! =starts-with-equals!12,171 | ||
| 3309 | (define (((((curry-test 14,205 | ||
| 3310 | (define-syntax test-begin17,265 | ||
| 3311 | |||
| 3302 | tex-src/testenv.tex,52 | 3312 | tex-src/testenv.tex,52 |
| 3303 | \newcommand{\nm}\nm4,77 | 3313 | \newcommand{\nm}\nm4,77 |
| 3304 | \section{blah}blah8,139 | 3314 | \section{blah}blah8,139 |
| @@ -3309,11 +3319,11 @@ tex-src/gzip.texi,303 | |||
| 3309 | @node Overview,83,2705 | 3319 | @node Overview,83,2705 |
| 3310 | @node Sample,166,7272 | 3320 | @node Sample,166,7272 |
| 3311 | @node Invoking gzip,Invoking gzip210,8828 | 3321 | @node Invoking gzip,Invoking gzip210,8828 |
| 3312 | @node Advanced usage,Advanced usage357,13495 | 3322 | @node Advanced usage,Advanced usage357,13496 |
| 3313 | @node Environment,420,15207 | 3323 | @node Environment,420,15208 |
| 3314 | @node Tapes,437,15768 | 3324 | @node Tapes,437,15769 |
| 3315 | @node Problems,460,16767 | 3325 | @node Problems,460,16768 |
| 3316 | @node Concept Index,Concept Index473,17287 | 3326 | @node Concept Index,Concept Index473,17288 |
| 3317 | 3327 | ||
| 3318 | tex-src/texinfo.tex,30627 | 3328 | tex-src/texinfo.tex,30627 |
| 3319 | \def\texinfoversion{\texinfoversion26,1032 | 3329 | \def\texinfoversion{\texinfoversion26,1032 |
diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5 index 2b431034f44..b7a31602f51 100644 --- a/test/manual/etags/ETAGS.good_5 +++ b/test/manual/etags/ETAGS.good_5 | |||
| @@ -3253,10 +3253,11 @@ main(37,571 | |||
| 3253 | D(43,659 | 3253 | D(43,659 |
| 3254 | int x;44,694 | 3254 | int x;44,694 |
| 3255 | 3255 | ||
| 3256 | el-src/TAGTEST.EL,148 | 3256 | el-src/TAGTEST.EL,179 |
| 3257 | (foo::defmumble bletch 1,0 | 3257 | (foo::defmumble bletch 1,0 |
| 3258 | (defalias 'pending-delete-mode pending-delete-mode5,102 | 3258 | (defun foo==bar foo==bar2,33 |
| 3259 | (defalias (quote explicitly-quoted-pending-delete-mode)8,175 | 3259 | (defalias 'pending-delete-mode pending-delete-mode6,149 |
| 3260 | (defalias (quote explicitly-quoted-pending-delete-mode)9,222 | ||
| 3260 | 3261 | ||
| 3261 | el-src/emacs/lisp/progmodes/etags.el,5188 | 3262 | el-src/emacs/lisp/progmodes/etags.el,5188 |
| 3262 | (defvar tags-file-name 34,1034 | 3263 | (defvar tags-file-name 34,1034 |
| @@ -4279,6 +4280,15 @@ module A9,57 | |||
| 4279 | alias_method ( :foo2,foo237,586 | 4280 | alias_method ( :foo2,foo237,586 |
| 4280 | A::Constant Constant42,655 | 4281 | A::Constant Constant42,655 |
| 4281 | 4282 | ||
| 4283 | scm-src/test.scm,260 | ||
| 4284 | (define hello 1,0 | ||
| 4285 | (set! hello 3,32 | ||
| 4286 | (define (hello-world)5,62 | ||
| 4287 | (define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128 | ||
| 4288 | (define =starts-with-equals! =starts-with-equals!12,171 | ||
| 4289 | (define (((((curry-test 14,205 | ||
| 4290 | (define-syntax test-begin17,265 | ||
| 4291 | |||
| 4282 | tex-src/testenv.tex,52 | 4292 | tex-src/testenv.tex,52 |
| 4283 | \newcommand{\nm}\nm4,77 | 4293 | \newcommand{\nm}\nm4,77 |
| 4284 | \section{blah}blah8,139 | 4294 | \section{blah}blah8,139 |
| @@ -4289,11 +4299,11 @@ tex-src/gzip.texi,303 | |||
| 4289 | @node Overview,83,2705 | 4299 | @node Overview,83,2705 |
| 4290 | @node Sample,166,7272 | 4300 | @node Sample,166,7272 |
| 4291 | @node Invoking gzip,Invoking gzip210,8828 | 4301 | @node Invoking gzip,Invoking gzip210,8828 |
| 4292 | @node Advanced usage,Advanced usage357,13495 | 4302 | @node Advanced usage,Advanced usage357,13496 |
| 4293 | @node Environment,420,15207 | 4303 | @node Environment,420,15208 |
| 4294 | @node Tapes,437,15768 | 4304 | @node Tapes,437,15769 |
| 4295 | @node Problems,460,16767 | 4305 | @node Problems,460,16768 |
| 4296 | @node Concept Index,Concept Index473,17287 | 4306 | @node Concept Index,Concept Index473,17288 |
| 4297 | 4307 | ||
| 4298 | tex-src/texinfo.tex,30627 | 4308 | tex-src/texinfo.tex,30627 |
| 4299 | \def\texinfoversion{\texinfoversion26,1032 | 4309 | \def\texinfoversion{\texinfoversion26,1032 |
diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6 index 2cb0d05e72a..a75fd806968 100644 --- a/test/manual/etags/ETAGS.good_6 +++ b/test/manual/etags/ETAGS.good_6 | |||
| @@ -3253,10 +3253,11 @@ main(37,571 | |||
| 3253 | D(D::D43,659 | 3253 | D(D::D43,659 |
| 3254 | int x;D::x44,694 | 3254 | int x;D::x44,694 |
| 3255 | 3255 | ||
| 3256 | el-src/TAGTEST.EL,148 | 3256 | el-src/TAGTEST.EL,179 |
| 3257 | (foo::defmumble bletch 1,0 | 3257 | (foo::defmumble bletch 1,0 |
| 3258 | (defalias 'pending-delete-mode pending-delete-mode5,102 | 3258 | (defun foo==bar foo==bar2,33 |
| 3259 | (defalias (quote explicitly-quoted-pending-delete-mode)8,175 | 3259 | (defalias 'pending-delete-mode pending-delete-mode6,149 |
| 3260 | (defalias (quote explicitly-quoted-pending-delete-mode)9,222 | ||
| 3260 | 3261 | ||
| 3261 | el-src/emacs/lisp/progmodes/etags.el,5188 | 3262 | el-src/emacs/lisp/progmodes/etags.el,5188 |
| 3262 | (defvar tags-file-name 34,1034 | 3263 | (defvar tags-file-name 34,1034 |
| @@ -4279,6 +4280,15 @@ module A9,57 | |||
| 4279 | alias_method ( :foo2,foo237,586 | 4280 | alias_method ( :foo2,foo237,586 |
| 4280 | A::Constant Constant42,655 | 4281 | A::Constant Constant42,655 |
| 4281 | 4282 | ||
| 4283 | scm-src/test.scm,260 | ||
| 4284 | (define hello 1,0 | ||
| 4285 | (set! hello 3,32 | ||
| 4286 | (define (hello-world)5,62 | ||
| 4287 | (define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128 | ||
| 4288 | (define =starts-with-equals! =starts-with-equals!12,171 | ||
| 4289 | (define (((((curry-test 14,205 | ||
| 4290 | (define-syntax test-begin17,265 | ||
| 4291 | |||
| 4282 | tex-src/testenv.tex,52 | 4292 | tex-src/testenv.tex,52 |
| 4283 | \newcommand{\nm}\nm4,77 | 4293 | \newcommand{\nm}\nm4,77 |
| 4284 | \section{blah}blah8,139 | 4294 | \section{blah}blah8,139 |
| @@ -4289,11 +4299,11 @@ tex-src/gzip.texi,303 | |||
| 4289 | @node Overview,83,2705 | 4299 | @node Overview,83,2705 |
| 4290 | @node Sample,166,7272 | 4300 | @node Sample,166,7272 |
| 4291 | @node Invoking gzip,Invoking gzip210,8828 | 4301 | @node Invoking gzip,Invoking gzip210,8828 |
| 4292 | @node Advanced usage,Advanced usage357,13495 | 4302 | @node Advanced usage,Advanced usage357,13496 |
| 4293 | @node Environment,420,15207 | 4303 | @node Environment,420,15208 |
| 4294 | @node Tapes,437,15768 | 4304 | @node Tapes,437,15769 |
| 4295 | @node Problems,460,16767 | 4305 | @node Problems,460,16768 |
| 4296 | @node Concept Index,Concept Index473,17287 | 4306 | @node Concept Index,Concept Index473,17288 |
| 4297 | 4307 | ||
| 4298 | tex-src/texinfo.tex,30627 | 4308 | tex-src/texinfo.tex,30627 |
| 4299 | \def\texinfoversion{\texinfoversion26,1032 | 4309 | \def\texinfoversion{\texinfoversion26,1032 |
diff --git a/test/manual/etags/Makefile b/test/manual/etags/Makefile index 07ad0f46416..c1df703905e 100644 --- a/test/manual/etags/Makefile +++ b/test/manual/etags/Makefile | |||
| @@ -25,12 +25,13 @@ PSSRC=$(addprefix ./ps-src/,rfc1245.ps) | |||
| 25 | PROLSRC=$(addprefix ./prol-src/,ordsets.prolog natded.prolog) | 25 | PROLSRC=$(addprefix ./prol-src/,ordsets.prolog natded.prolog) |
| 26 | PYTSRC=$(addprefix ./pyt-src/,server.py) | 26 | PYTSRC=$(addprefix ./pyt-src/,server.py) |
| 27 | RBSRC=$(addprefix ./ruby-src/,test.rb test1.ru) | 27 | RBSRC=$(addprefix ./ruby-src/,test.rb test1.ru) |
| 28 | SCMSRC=$(addprefix ./scm-src/,test.scm) | ||
| 28 | TEXSRC=$(addprefix ./tex-src/,testenv.tex gzip.texi texinfo.tex nonewline.tex) | 29 | TEXSRC=$(addprefix ./tex-src/,testenv.tex gzip.texi texinfo.tex nonewline.tex) |
| 29 | YSRC=$(addprefix ./y-src/,parse.y parse.c atest.y cccp.c cccp.y) | 30 | YSRC=$(addprefix ./y-src/,parse.y parse.c atest.y cccp.c cccp.y) |
| 30 | SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\ | 31 | SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\ |
| 31 | ${FORTHSRC} ${GOSRC} ${HTMLSRC} ${JAVASRC} ${LUASRC} ${MAKESRC}\ | 32 | ${FORTHSRC} ${GOSRC} ${HTMLSRC} ${JAVASRC} ${LUASRC} ${MAKESRC}\ |
| 32 | ${OBJCSRC} ${OBJCPPSRC} ${PASSRC} ${PHPSRC} ${PERLSRC} ${PSSRC}\ | 33 | ${OBJCSRC} ${OBJCPPSRC} ${PASSRC} ${PHPSRC} ${PERLSRC} ${PSSRC}\ |
| 33 | ${PROLSRC} ${PYTSRC} ${RBSRC} ${TEXSRC} ${YSRC} | 34 | ${PROLSRC} ${PYTSRC} ${RBSRC} ${SCMSRC} ${TEXSRC} ${YSRC} |
| 34 | NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz | 35 | NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz |
| 35 | 36 | ||
| 36 | ETAGS_PROG=../../../lib-src/etags | 37 | ETAGS_PROG=../../../lib-src/etags |
diff --git a/test/manual/etags/el-src/TAGTEST.EL b/test/manual/etags/el-src/TAGTEST.EL index acf0baf82f0..89a67913771 100644 --- a/test/manual/etags/el-src/TAGTEST.EL +++ b/test/manual/etags/el-src/TAGTEST.EL | |||
| @@ -1,4 +1,5 @@ | |||
| 1 | (foo::defmumble bletch beuarghh) | 1 | (foo::defmumble bletch beuarghh) |
| 2 | (defun foo==bar () (message "hi")) ; Bug#5624 | ||
| 2 | ;;; Ctags test file for lisp mode. | 3 | ;;; Ctags test file for lisp mode. |
| 3 | 4 | ||
| 4 | ;; from emacs/lisp/delsel.el:76: | 5 | ;; from emacs/lisp/delsel.el:76: |
diff --git a/test/manual/etags/scm-src/test.scm b/test/manual/etags/scm-src/test.scm new file mode 100644 index 00000000000..e3921e718fc --- /dev/null +++ b/test/manual/etags/scm-src/test.scm | |||
| @@ -0,0 +1,20 @@ | |||
| 1 | (define hello "Hello, Emacs!") | ||
| 2 | |||
| 3 | (set! hello "Hello, world!") | ||
| 4 | |||
| 5 | (define (hello-world) | ||
| 6 | (display hello) | ||
| 7 | (newline)) | ||
| 8 | |||
| 9 | ;; Bug 5624 | ||
| 10 | (define (there-is-a-=-in-the-middle!) #t) | ||
| 11 | |||
| 12 | (define =starts-with-equals! #t) | ||
| 13 | |||
| 14 | (define (((((curry-test a) b) c) d) e) | ||
| 15 | (list a b c d e)) | ||
| 16 | |||
| 17 | (define-syntax test-begin | ||
| 18 | (syntax-rules () | ||
| 19 | ((test-begin exp ...) | ||
| 20 | ((lambda () exp ...))))) | ||
diff --git a/test/manual/image-size-tests.el b/test/manual/image-size-tests.el index 577c7658791..ad43426dd20 100644 --- a/test/manual/image-size-tests.el +++ b/test/manual/image-size-tests.el | |||
| @@ -25,8 +25,8 @@ | |||
| 25 | (defmacro im-should (image width height &rest props) | 25 | (defmacro im-should (image width height &rest props) |
| 26 | `(let ((im (im-image ,image ,@props))) | 26 | `(let ((im (im-image ,image ,@props))) |
| 27 | (unless (im-compare im ,width ,height) | 27 | (unless (im-compare im ,width ,height) |
| 28 | (error "%s didn't succeed; size is %s" | 28 | (error "%s %s didn't succeed; size is %s" |
| 29 | ',props (image-size im t))))) | 29 | ',image ',props (image-size im t))))) |
| 30 | 30 | ||
| 31 | (defun im-image (type &rest props) | 31 | (defun im-image (type &rest props) |
| 32 | (let ((image-scaling-factor 1)) | 32 | (let ((image-scaling-factor 1)) |
| @@ -67,6 +67,9 @@ | |||
| 67 | ;; Both max-width/height. | 67 | ;; Both max-width/height. |
| 68 | (im-should :w 100 50 :max-width 100 :max-height 75) | 68 | (im-should :w 100 50 :max-width 100 :max-height 75) |
| 69 | (im-should :w 50 25 :max-width 100 :max-height 25) | 69 | (im-should :w 50 25 :max-width 100 :max-height 25) |
| 70 | ;; :width and :max-height (max-height wins). | ||
| 71 | (im-should :w 400 200 :width 400 :max-height 200) | ||
| 72 | (im-should :w 400 200 :width 500 :max-height 200) | ||
| 70 | 73 | ||
| 71 | ;; Test the image that's taller than it is wide. | 74 | ;; Test the image that's taller than it is wide. |
| 72 | (im-should :h 100 200) | 75 | (im-should :h 100 200) |
| @@ -87,6 +90,9 @@ | |||
| 87 | ;; Both max-width/height. | 90 | ;; Both max-width/height. |
| 88 | (im-should :h 50 100 :max-width 75 :max-height 100) | 91 | (im-should :h 50 100 :max-width 75 :max-height 100) |
| 89 | (im-should :h 25 50 :max-width 25 :max-height 100) | 92 | (im-should :h 25 50 :max-width 25 :max-height 100) |
| 93 | ;; :height and :max-width (max-width wins). | ||
| 94 | (im-should :h 200 400 :height 400 :max-width 200) | ||
| 95 | (im-should :h 200 400 :height 500 :max-width 200) | ||
| 90 | ) | 96 | ) |
| 91 | 97 | ||
| 92 | ;;; image-size-tests.el ends here | 98 | ;;; image-size-tests.el ends here |
diff --git a/test/manual/indent/perl.perl b/test/manual/indent/perl.perl index f86a09b2733..06f32e7f090 100755 --- a/test/manual/indent/perl.perl +++ b/test/manual/indent/perl.perl | |||
| @@ -53,6 +53,14 @@ EOF1 | |||
| 53 | bar | 53 | bar |
| 54 | EOF2 | 54 | EOF2 |
| 55 | 55 | ||
| 56 | print <<~"EOF1" . <<\EOF2 . s/he"llo/th'ere/; | ||
| 57 | foo | ||
| 58 | EOF2 | ||
| 59 | bar | ||
| 60 | EOF1 | ||
| 61 | bar | ||
| 62 | EOF2 | ||
| 63 | |||
| 56 | print $'; # This should not start a string! | 64 | print $'; # This should not start a string! |
| 57 | 65 | ||
| 58 | print "hello" for /./; | 66 | print "hello" for /./; |
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index a4994b6223b..2aa85f0b247 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el | |||
| @@ -182,37 +182,66 @@ changes." | |||
| 182 | (should (equal (help-function-arglist #'mod-test-sum) | 182 | (should (equal (help-function-arglist #'mod-test-sum) |
| 183 | '(arg1 arg2)))) | 183 | '(arg1 arg2)))) |
| 184 | 184 | ||
| 185 | (ert-deftest module--test-assertions () | 185 | (defmacro module--with-temp-directory (name &rest body) |
| 186 | "Check that -module-assertions work." | 186 | "Bind NAME to the name of a temporary directory and evaluate BODY. |
| 187 | NAME must be a symbol. Delete the temporary directory after BODY | ||
| 188 | exits normally or non-locally. NAME will be bound to the | ||
| 189 | directory name (not the directory file name) of the temporary | ||
| 190 | directory." | ||
| 191 | (declare (indent 1)) | ||
| 192 | (cl-check-type name symbol) | ||
| 193 | `(let ((,name (file-name-as-directory | ||
| 194 | (make-temp-file "emacs-module-test" :directory)))) | ||
| 195 | (unwind-protect | ||
| 196 | (progn ,@body) | ||
| 197 | (delete-directory ,name :recursive)))) | ||
| 198 | |||
| 199 | (defmacro module--test-assertion (pattern &rest body) | ||
| 200 | "Test that PATTERN matches the assertion triggered by BODY. | ||
| 201 | Run Emacs as a subprocess, load the test module `mod-test-file', | ||
| 202 | and evaluate BODY. Verify that Emacs aborts and prints a module | ||
| 203 | assertion message that matches PATTERN. PATTERN is evaluated and | ||
| 204 | must evaluate to a regular expression string." | ||
| 205 | (declare (indent 1)) | ||
| 206 | ;; To contain any core dumps. | ||
| 207 | `(module--with-temp-directory tempdir | ||
| 208 | (with-temp-buffer | ||
| 209 | (let* ((default-directory tempdir) | ||
| 210 | (status (call-process mod-test-emacs nil t nil | ||
| 211 | "-batch" "-Q" "-module-assertions" "-eval" | ||
| 212 | ,(prin1-to-string | ||
| 213 | `(progn | ||
| 214 | (require 'mod-test ,mod-test-file) | ||
| 215 | ,@body))))) | ||
| 216 | (should (stringp status)) | ||
| 217 | ;; eg "Aborted" or "Abort trap: 6" | ||
| 218 | (should (string-prefix-p "Abort" status)) | ||
| 219 | (search-backward "Emacs module assertion: ") | ||
| 220 | (goto-char (match-end 0)) | ||
| 221 | (should (string-match-p ,pattern | ||
| 222 | (buffer-substring-no-properties | ||
| 223 | (point) (point-max)))))))) | ||
| 224 | |||
| 225 | (ert-deftest module--test-assertions--load-non-live-object () | ||
| 226 | "Check that -module-assertions verify that non-live objects | ||
| 227 | aren’t accessed." | ||
| 187 | (skip-unless (file-executable-p mod-test-emacs)) | 228 | (skip-unless (file-executable-p mod-test-emacs)) |
| 188 | ;; This doesn’t yet cause undefined behavior. | 229 | ;; This doesn’t yet cause undefined behavior. |
| 189 | (should (eq (mod-test-invalid-store) 123)) | 230 | (should (eq (mod-test-invalid-store) 123)) |
| 190 | ;; To contain any core dumps. | 231 | (module--test-assertion (rx "Emacs value not found in " |
| 191 | (let ((tempdir (make-temp-file "emacs-module-test" t))) | 232 | (+ digit) " values of " |
| 192 | (unwind-protect | 233 | (+ digit) " environments\n") |
| 193 | (with-temp-buffer | 234 | ;; Storing and reloading a local value causes undefined behavior, |
| 194 | (should (string-match-p | 235 | ;; which should be detected by the module assertions. |
| 195 | "Abort" ; eg "Aborted" or "Abort trap: 6" | 236 | (mod-test-invalid-store) |
| 196 | (let ((default-directory tempdir)) | 237 | (mod-test-invalid-load))) |
| 197 | (call-process mod-test-emacs nil t nil | 238 | |
| 198 | "-batch" "-Q" "-module-assertions" "-eval" | 239 | (ert-deftest module--test-assertions--call-emacs-from-gc () |
| 199 | (prin1-to-string | 240 | "Check that -module-assertions prevents calling Emacs functions |
| 200 | `(progn | 241 | during garbage collection." |
| 201 | (require 'mod-test ,mod-test-file) | 242 | (skip-unless (file-executable-p mod-test-emacs)) |
| 202 | ;; Storing and reloading a local | 243 | (module--test-assertion |
| 203 | ;; value causes undefined behavior, | 244 | (rx "Module function called during garbage collection\n") |
| 204 | ;; which should be detected by the | 245 | (mod-test-invalid-finalizer))) |
| 205 | ;; module assertions. | ||
| 206 | (mod-test-invalid-store) | ||
| 207 | (mod-test-invalid-load))))))) | ||
| 208 | (search-backward "Emacs module assertion:") | ||
| 209 | (should (string-match-p (rx bos "Emacs module assertion: " | ||
| 210 | "Emacs value not found in " | ||
| 211 | (+ digit) " values of " | ||
| 212 | (+ digit) " environments" eos) | ||
| 213 | (buffer-substring-no-properties | ||
| 214 | (line-beginning-position) | ||
| 215 | (line-end-position))))) | ||
| 216 | (delete-directory tempdir t)))) | ||
| 217 | 246 | ||
| 218 | ;;; emacs-module-tests.el ends here | 247 | ;;; emacs-module-tests.el ends here |
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 2e463455f0c..e294859226c 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el | |||
| @@ -373,6 +373,12 @@ | |||
| 373 | (should-error (assoc 3 d1) :type 'wrong-type-argument) | 373 | (should-error (assoc 3 d1) :type 'wrong-type-argument) |
| 374 | (should-error (assoc 3 d2) :type 'wrong-type-argument))) | 374 | (should-error (assoc 3 d2) :type 'wrong-type-argument))) |
| 375 | 375 | ||
| 376 | (ert-deftest test-assoc-testfn () | ||
| 377 | (let ((alist '(("a" . 1) ("b" . 2)))) | ||
| 378 | (should-not (assoc "a" alist #'ignore)) | ||
| 379 | (should (eq (assoc "b" alist #'string-equal) (cadr alist))) | ||
| 380 | (should-not (assoc "b" alist #'eq)))) | ||
| 381 | |||
| 376 | (ert-deftest test-cycle-rassq () | 382 | (ert-deftest test-cycle-rassq () |
| 377 | (let ((c1 (cyc1 '(0 . 1))) | 383 | (let ((c1 (cyc1 '(0 . 1))) |
| 378 | (c2 (cyc2 '(0 . 1) '(0 . 2))) | 384 | (c2 (cyc2 '(0 . 1) '(0 . 2))) |
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 98cbb6a301d..dd5a2003b41 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el | |||
| @@ -142,6 +142,23 @@ literals (Bug#20852)." | |||
| 142 | "unescaped character literals " | 142 | "unescaped character literals " |
| 143 | "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) | 143 | "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) |
| 144 | 144 | ||
| 145 | (ert-deftest lread-tests--funny-quote-symbols () | ||
| 146 | "Check that 'smart quotes' or similar trigger errors in symbol names." | ||
| 147 | (dolist (quote-char | ||
| 148 | '(#x2018 ;; LEFT SINGLE QUOTATION MARK | ||
| 149 | #x2019 ;; RIGHT SINGLE QUOTATION MARK | ||
| 150 | #x201B ;; SINGLE HIGH-REVERSED-9 QUOTATION MARK | ||
| 151 | #x201C ;; LEFT DOUBLE QUOTATION MARK | ||
| 152 | #x201D ;; RIGHT DOUBLE QUOTATION MARK | ||
| 153 | #x201F ;; DOUBLE HIGH-REVERSED-9 QUOTATION MARK | ||
| 154 | #x301E ;; DOUBLE PRIME QUOTATION MARK | ||
| 155 | #xFF02 ;; FULLWIDTH QUOTATION MARK | ||
| 156 | #xFF07 ;; FULLWIDTH APOSTROPHE | ||
| 157 | )) | ||
| 158 | (let ((str (format "%cfoo" quote-char))) | ||
| 159 | (should-error (read str) :type 'invalid-read-syntax) | ||
| 160 | (should (eq (read (concat "\\" str)) (intern str)))))) | ||
| 161 | |||
| 145 | (ert-deftest lread-test-bug26837 () | 162 | (ert-deftest lread-test-bug26837 () |
| 146 | "Test for http://debbugs.gnu.org/26837 ." | 163 | "Test for http://debbugs.gnu.org/26837 ." |
| 147 | (let ((load-path (cons | 164 | (let ((load-path (cons |
| @@ -164,4 +181,10 @@ literals (Bug#20852)." | |||
| 164 | (concat (format-message "Loading `%s': " file-name) | 181 | (concat (format-message "Loading `%s': " file-name) |
| 165 | "old-style backquotes detected!"))))) | 182 | "old-style backquotes detected!"))))) |
| 166 | 183 | ||
| 184 | (ert-deftest lread-lread--substitute-object-in-subtree () | ||
| 185 | (let ((x (cons 0 1))) | ||
| 186 | (setcar x x) | ||
| 187 | (lread--substitute-object-in-subtree x 1 t) | ||
| 188 | (should (eq x (cdr x))))) | ||
| 189 | |||
| 167 | ;;; lread-tests.el ends here | 190 | ;;; lread-tests.el ends here |