diff options
Diffstat (limited to 'test/lisp/replace-tests.el')
| -rw-r--r-- | test/lisp/replace-tests.el | 374 |
1 files changed, 354 insertions, 20 deletions
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 06b6dd8a0a9..23ec24840fb 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -1,6 +1,6 @@ -;;; replace-tests.el --- tests for replace.el. +;;; replace-tests.el --- tests for replace.el. -*- lexical-binding:t -*- -;; Copyright (C) 2010-2017 Free Software Foundation, Inc. +;; Copyright (C) 2010-2022 Free Software Foundation, Inc. ;; Author: Nicolas Richard <youngfrog@members.fsf.org> ;; Author: Juri Linkov <juri@jurta.org> @@ -23,6 +23,7 @@ ;;; Code: (require 'ert) +(eval-when-compile (require 'subr-x)) (ert-deftest query-replace--split-string-tests () (let ((sep (propertize "\0" 'separator t))) @@ -54,7 +55,7 @@ fx 6:fx ") ;; * Test multi-line matches, this is the first test from - ;; https://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html + ;; https://lists.gnu.org/r/emacs-devel/2005-06/msg01008.html ;; where numbers are replaced with letters. ("a\na" 0 "\ a @@ -70,7 +71,7 @@ a :a ") ;; * Test multi-line matches, this is the second test from - ;; https://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html + ;; https://lists.gnu.org/r/emacs-devel/2005-06/msg01008.html ;; where numbers are replaced with letters. ("a\nb" 0 "\ a @@ -358,26 +359,359 @@ Each element has the format: (dotimes (i (length replace-occur-tests)) (replace-occur-test-create i)) -(defun replace-tests--query-replace-undo (&optional comma) +(ert-deftest replace-occur-revert-bug32543 () + "Test `occur-revert' with non-nil `list-matching-lines-jump-to-current-line'." + (let ((temp-buffer (get-buffer-create " *test-occur*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer temp-buffer + (erase-buffer) + (setq list-matching-lines-jump-to-current-line t) + (insert +";; This buffer is for text that is not saved, and for Lisp evaluation. +;; To create a file, visit it with C-x C-f and enter text in its buffer. + +") + (occur "and") + (with-current-buffer "*Occur*" + (revert-buffer) + (goto-char (point-min)) + (should (string-match "\\`2 matches for \"and\" in buffer: " + (buffer-substring-no-properties + (point) (pos-eol))))))) + (and (buffer-name temp-buffer) + (kill-buffer temp-buffer))))) + +(ert-deftest replace-occur-revert-bug32987 () + "Test `occur-revert' with non-nil `list-matching-lines-jump-to-current-line'." + (let ((temp-buffer (get-buffer-create " *test-occur*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer temp-buffer + (erase-buffer) + (setq list-matching-lines-jump-to-current-line nil) + (insert +";; This buffer is for text that is not saved, and for Lisp evaluation. +;; To create a file, visit it with C-x C-f and enter text in its buffer. + +") + (occur "and") + (with-current-buffer "*Occur*" + (revert-buffer) + (goto-char (point-min)) + (should (string-match "\\`2 matches for \"and\" in buffer: " + (buffer-substring-no-properties + (point) (pos-eol))))))) + (and (buffer-name temp-buffer) + (kill-buffer temp-buffer))))) + + +;;; General tests for `query-replace' and `query-replace-regexp'. + +(defconst query-replace-tests + '( + ;; query-replace + ("aaa" "M-% a RET 1 RET !" "111") + ("aaa" "M-% a RET 1 RET y n y" "1a1") + ;; Empty inputs + ("aaa" "M-% a RET RET !" "") + ("aaa" "M-% RET 1 RET !" "1a1a1a") + ("aaa" "M-% RET RET !" "aaa") + ;; Reuse the previous default + ("aaa" "M-% a RET 1 RET . M-% RET !" "111") + + ;; query-replace-regexp + ("aaa" "C-M-% a* RET 1 RET !" "1") + ;; Empty inputs + ("aaa" "C-M-% a* RET RET !" "") + ("aaa" "C-M-% RET 1 RET !" "1a1a1a") + ("aaa" "C-M-% RET RET !" "aaa") + ;; Empty matches + ("aaa" "C-M-% b* RET 1 RET !" "1a1a1a") + ;; Complete matches + ("aaa" "C-M-% .* RET 1 RET !" "1") + ;; Adjacent non-empty matches + ("abaab" "C-M-% ab* RET 12 RET !" "121212") + ;; Adjacent non-empty and empty matches + ("abab" "C-M-% a* RET 1 RET !" "1b1b") + ("abab" "C-M-% b* RET 1 RET !" "1a1a1") + ;; Test case from commit 5632eb272c7 + ("a a a " "C-M-% \\ba SPC RET c RET !" "ccc") ; not "ca c" + )) + +(defun query-replace--run-tests (tests) + (with-temp-buffer + (save-window-excursion + ;; `execute-kbd-macro' is applied to window only + (set-window-buffer nil (current-buffer)) + (dolist (case tests) + ;; Ensure empty input means empty string to replace: + (setq query-replace-defaults nil) + (delete-region (point-min) (point-max)) + (insert (nth 0 case)) + (goto-char (point-min)) + (execute-kbd-macro (kbd (nth 1 case))) + (should (equal (buffer-string) (nth 2 case))))))) + +(ert-deftest query-replace-tests () + (query-replace--run-tests query-replace-tests)) + +(ert-deftest query-replace-search-function-tests () + (let* ((replace-re-search-function #'re-search-forward)) + (query-replace--run-tests query-replace-tests)) + + (let* ((pairs '((1 . 2) (3 . 4))) + (replace-re-search-function + (lambda (string &optional _bound noerror count) + (let (found) + (while (and (not found) pairs) + (goto-char (caar pairs)) + (when (re-search-forward string (cdar pairs) noerror count) + (setq found t)) + (pop pairs)) + found))) + (tests + '( + ;; FIXME: this test should pass after fixing bug#54733: + ;; ("aaaa" "C-M-% .* RET 1 RET !" "1a1a") + ))) + (query-replace--run-tests tests))) + + +;;; General tests for `perform-replace'. + +(defconst perform-replace-tests + '( + ;; Test case from commit 5632eb272c7 + ("a a a " "\\ba " "c" nil t nil nil nil nil nil nil nil "ccc") ; not "ca c" + ;; The same with region inside the second match + ;; FIXME: this test should pass after fixing bug#54733: + ;; ("a a a " "\\ba " "c" nil t nil nil nil 1 4 nil nil "ca a ") + )) + +(defun perform-replace--run-tests (tests) (with-temp-buffer - (insert "111") - (goto-char 1) - (let ((count 0)) - ;; Don't wait for user input. - (cl-letf (((symbol-function 'read-event) - (lambda (&rest args) - (cl-incf count) - (let ((val (pcase count - ('2 (if comma ?, ?\s)) ; replace and: ',' no move; '\s' go next - ('3 ?u) ; undo - ('4 ?q) ; exit - (_ ?\s)))) ; replace current and go next - val)))) - (perform-replace "1" "2" t nil nil))) - (buffer-string))) + (dolist (case tests) + (delete-region (point-min) (point-max)) + (insert (pop case)) + (goto-char (point-min)) + (apply 'perform-replace (butlast case)) + (should (equal (buffer-string) (car (last case))))))) + +(ert-deftest perform-replace-tests () + (perform-replace--run-tests perform-replace-tests)) + + +;;; Tests for `query-replace' undo feature. + +(defvar replace-tests-bind-read-string nil + "A string to bind `read-string' and avoid the prompt.") + +(defvar replace-tests-perform-replace-regexp-flag t + "Value for regexp-flag argument passed to `perform-replace' in undo tests.") + +(defmacro replace-tests-with-undo (input from to char-nums def-chr &rest body) + "Helper to test `query-replace' undo feature. +INPUT is a string to insert in a temporary buffer. +FROM is the string to match and replace. +TO is the replacement string. +CHAR-NUMS is a list of elements (CHAR . NUMS), where CHAR is +one of the characters `,', `?\\s', `u', `U', `E' or `q' +and NUMS a list of integers. +DEF-CHAR is the character `?\\s' or `q'. +BODY is a list of forms to evaluate. + +Use CHAR-NUMS and DEF-CHAR to temporary bind the function value of +`read-event', thus avoiding the prompt. +For instance, if CHAR-NUMS is the lists ((?\\s . (1 2 3)) (?u . (4))), +then replace 3 matches of FROM with TO, and undo the last replacement. + +Return the last evalled form in BODY." + (declare (indent 5) (debug (stringp stringp stringp form characterp body))) + (let ((text (gensym "text")) + (count (gensym "count"))) + `(let* ((,text ,input) + (,count 0) + (inhibit-message t)) + (with-temp-buffer + (insert ,text) + (goto-char 1) + ;; Bind `read-event' to simulate user input. + ;; If `replace-tests-bind-read-string' is non-nil, then + ;; bind `read-string' as well. + (cl-letf (((symbol-function 'read-event) + (lambda (&rest _args) + (cl-incf ,count) + (pcase ,count ; Build the clauses from CHAR-NUMS + ,@(append + (delq nil + (mapcar + (lambda (chr) + (when-let (it (alist-get chr char-nums)) + (if (cdr it) + `(,(cons 'or it) ,chr) + `(,(car it) ,chr)))) + '(?, ?\s ?u ?U ?E ?q))) + `((_ ,def-chr)))))) + ((symbol-function 'read-string) + (if replace-tests-bind-read-string + (lambda (&rest _args) replace-tests-bind-read-string) + (symbol-function 'read-string))) + ;; Emulate replace-highlight clobbering match-data via + ;; isearch-lazy-highlight-new-loop and sit-for (bug#36328) + ((symbol-function 'replace-highlight) + (lambda (&rest _args) + (string-match "[A-Z ]" "ForestGreen"))) + ;; Override `sit-for' and `ding' so that we don't have + ;; to wait and listen to bells when running the test. + ((symbol-function 'sit-for) + (lambda (&rest _args) (redisplay))) + ((symbol-function 'ding) 'ignore)) + (perform-replace ,from ,to t replace-tests-perform-replace-regexp-flag nil)) + ,@body)))) + +(defun replace-tests--query-replace-undo (&optional comma) + (let ((input "111")) + (if comma + (should + (replace-tests-with-undo + input "1" "2" ((?, . (2)) (?u . (3)) (?q . (4))) ?\s (buffer-string))) + (should + (replace-tests-with-undo + input "1" "2" ((?\s . (2)) (?u . (3)) (?q . (4))) ?\s (buffer-string)))))) (ert-deftest query-replace--undo () (should (string= "211" (replace-tests--query-replace-undo))) (should (string= "211" (replace-tests--query-replace-undo 'comma)))) +(ert-deftest query-replace-undo-bug31073 () + "Test for https://debbugs.gnu.org/31073 ." + (let ((input "aaa aaa")) + (should + (replace-tests-with-undo + input "a" "B" ((?\s . (1 2 3)) (?U . (4))) ?q + (string= input (buffer-string)))))) + +(ert-deftest query-replace-undo-bug31492 () + "Test for https://debbugs.gnu.org/31492 ." + (let ((input "a\nb\nc\n")) + (should + (replace-tests-with-undo + input "^\\|\b\\|$" "foo" ((?\s . (1 2)) (?U . (3))) ?q + (string= input (buffer-string)))))) + +(ert-deftest query-replace-undo-bug31538 () + "Test for https://debbugs.gnu.org/31538 ." + (let ((input "aaa aaa") + (replace-tests-bind-read-string "Bfoo")) + (should + (replace-tests-with-undo + input "a" "B" ((?\s . (1 2 3)) (?E . (4)) (?U . (5))) ?q + (string= input (buffer-string)))))) + +(ert-deftest query-replace-undo-bug37073 () + "Test for https://debbugs.gnu.org/37073 ." + (let ((input "theorem 1\ntheorem 2\ntheorem 3")) + (should + (replace-tests-with-undo + input "theorem \\([0-9]+\\)" + '(replace-eval-replacement + replace-quote + (format "theorem \\\\ref{theo_%d}" (1+ (string-to-number (match-string 1))))) + ((?\s . (1 2)) (?U . (3))) + ?q + (string= input (buffer-string))))) + ;; Now run a test with regexp-flag arg in `perform-replace' set to nil + (let ((input " ^theorem$ 1\n ^theorem$ 2\n ^theorem$ 3") + (replace-tests-perform-replace-regexp-flag nil) + (expected " theo 1\n ^theorem$ 2\n ^theorem$ 3")) + (should + (replace-tests-with-undo + input "^theorem$" + "theo" + ((?\s . (1 2 4)) (?U . (3))) + ?q + (string= expected (buffer-string)))))) + +(ert-deftest query-replace-undo-bug37287 () + "Test for https://debbugs.gnu.org/37287 ." + (let ((input "foo-1\nfoo-2\nfoo-3") + (expected "foo-2\nfoo-2\nfoo-3")) + (should + (replace-tests-with-undo + input "\\([0-9]\\)" + '(replace-eval-replacement + replace-quote + (format "%d" (1+ (string-to-number (match-string 1))))) + ((?\s . (1 2 4)) (?U . (3))) + ?q + (string= expected (buffer-string)))))) + +(defmacro replace-tests-with-highlighted-occurrence (highlight-locus &rest body) + "Helper macro to test the highlight of matches when navigating occur buffer. + +Eval BODY with `next-error-highlight' and `next-error-highlight-no-select' +bound to HIGHLIGHT-LOCUS." + (declare (indent 1) (debug (form body))) + `(let ((regexp "foo") + (next-error-highlight ,highlight-locus) + (next-error-highlight-no-select ,highlight-locus) + (buffer (generate-new-buffer "test")) + (inhibit-message t)) + (unwind-protect + ;; Local bind to disable the deletion of `occur-highlight-overlay' + (cl-letf (((symbol-function 'occur-goto-locus-delete-o) (lambda ()))) + (with-current-buffer buffer (dotimes (_ 3) (insert regexp ?\n))) + (pop-to-buffer buffer) + (occur regexp) + (pop-to-buffer "*Occur*") + (occur-next) + ,@body) + (kill-buffer buffer) + (kill-buffer "*Occur*")))) + +(ert-deftest occur-highlight-occurrence () + "Test for https://debbugs.gnu.org/39121 ." + (let ((alist '((nil . nil) (0.5 . t) (t . t) (fringe-arrow . nil))) + (check-overlays + (lambda (has-ov) + (eq has-ov (not (null (overlays-in (point-min) (point-max)))))))) + (pcase-dolist (`(,highlight-locus . ,has-overlay) alist) + ;; Visiting occurrences + (replace-tests-with-highlighted-occurrence highlight-locus + (occur-mode-goto-occurrence) + (should (funcall check-overlays has-overlay))) + ;; Displaying occurrences + (replace-tests-with-highlighted-occurrence highlight-locus + (occur-mode-display-occurrence) + (with-current-buffer (marker-buffer + (caar (get-text-property (point) 'occur-target))) + (should (funcall check-overlays has-overlay))))))) + +(ert-deftest replace-regexp-bug45973 () + "Test for https://debbugs.gnu.org/45973 ." + (let ((before "1RB 1LC 1RC 1RB 1RD 0LE 1LA 1LD 1RH 0LA") + (after "1LB 1RC 1LC 1LB 1LD 0RE 1RA 1RD 1LH 0RA")) + (with-temp-buffer + (insert before) + (goto-char (point-min)) + (with-suppressed-warnings ((interactive-only replace-regexp)) + (replace-regexp + "\\(\\(L\\)\\|\\(R\\)\\)" + '(replace-eval-replacement + replace-quote + (if (match-string 2) "R" "L")))) + (should (equal (buffer-string) after))))) + +(ert-deftest test-count-matches () + (with-temp-buffer + (insert "oooooooooo") + (goto-char (point-min)) + (should (= (count-matches "oo") 5)) + (should (= (count-matches "o+") 1))) + (with-temp-buffer + (insert "o\n\n\n\no\n\n") + (goto-char (point-min)) + (should (= (count-matches "^$") 4)))) + ;;; replace-tests.el ends here |