test/lisp/replace-tests.el

   1 ;;; replace-tests.el --- tests for replace.el.
   2
   3 ;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Richard <youngfrog@members.fsf.org>
   6 ;; Author: Juri Linkov <juri@jurta.org>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  22
  23 ;;; Code:
  24
  25 (require 'ert)
  26
  27 (ert-deftest query-replace--split-string-tests ()
  28   (let ((sep (propertize "\0" 'separator t)))
  29     (dolist (before '("" "b"))
  30       (dolist (after '("" "a"))
  31         (should (equal
  32                  (query-replace--split-string (concat before sep after))
  33                  (cons before after)))
  34         (should (equal
  35                  (query-replace--split-string (concat before "\0" after))
  36                  (concat before "\0" after)))))))
  37
  38 (defconst replace-occur-tests
  39   '(
  40     ;; * Test one-line matches (at bob, eob, bol, eol).
  41     ("x" 0 "\
  42 xa
  43 b
  44 cx
  45 xd
  46 xex
  47 fx
  48 " "\
  49 6 matches in 5 lines for \"x\" in buffer:  *test-occur*
  50       1:xa
  51       3:cx
  52       4:xd
  53       5:xex
  54       6:fx
  55 ")
  56     ;; * Test multi-line matches, this is the first test from
  57     ;; https://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html
  58     ;; where numbers are replaced with letters.
  59     ("a\na" 0 "\
  60 a
  61 a
  62 a
  63 a
  64 a
  65 " "\
  66 2 matches for \"a\na\" in buffer:  *test-occur*
  67       1:a
  68        :a
  69       3:a
  70        :a
  71 ")
  72     ;; * Test multi-line matches, this is the second test from
  73     ;; https://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html
  74     ;; where numbers are replaced with letters.
  75     ("a\nb" 0 "\
  76 a
  77 b
  78 c
  79 a
  80 b
  81 " "\
  82 2 matches for \"a\nb\" in buffer:  *test-occur*
  83       1:a
  84        :b
  85       4:a
  86        :b
  87 ")
  88     ;; * Test line numbers for multi-line matches with empty last match line.
  89     ("a\n" 0 "\
  90 a
  91
  92 c
  93 a
  94
  95 " "\
  96 2 matches for \"a\n\" in buffer:  *test-occur*
  97       1:a
  98        :
  99       4:a
 100        :
 101 ")
 102     ;; * Test multi-line matches with 3 match lines.
 103     ("x\n.x\n" 0 "\
 104 ax
 105 bx
 106 c
 107 d
 108 ex
 109 fx
 110 " "\
 111 2 matches for \"x\n.x\n\" in buffer:  *test-occur*
 112       1:ax
 113        :bx
 114        :c
 115       5:ex
 116        :fx
 117        :
 118 ")
 119     ;; * Test non-overlapping context lines with matches at bob/eob.
 120     ("x" 1 "\
 121 ax
 122 b
 123 c
 124 d
 125 ex
 126 f
 127 g
 128 hx
 129 " "\
 130 3 matches for \"x\" in buffer:  *test-occur*
 131       1:ax
 132        :b
 133 -------
 134        :d
 135       5:ex
 136        :f
 137 -------
 138        :g
 139       8:hx
 140 ")
 141     ;; * Test non-overlapping context lines with matches not at bob/eob.
 142     ("x" 1 "\
 143 a
 144 bx
 145 c
 146 d
 147 ex
 148 f
 149 " "\
 150 2 matches for \"x\" in buffer:  *test-occur*
 151        :a
 152       2:bx
 153        :c
 154 -------
 155        :d
 156       5:ex
 157        :f
 158 ")
 159     ;; * Test overlapping context lines with matches at bob/eob.
 160     ("x" 2 "\
 161 ax
 162 bx
 163 c
 164 dx
 165 e
 166 f
 167 gx
 168 h
 169 i
 170 j
 171 kx
 172 " "\
 173 5 matches for \"x\" in buffer:  *test-occur*
 174       1:ax
 175       2:bx
 176        :c
 177       4:dx
 178        :e
 179        :f
 180       7:gx
 181        :h
 182        :i
 183        :j
 184      11:kx
 185 ")
 186     ;; * Test overlapping context lines with matches not at bob/eob.
 187     ("x" 2 "\
 188 a
 189 b
 190 cx
 191 d
 192 e
 193 f
 194 gx
 195 h
 196 i
 197 " "\
 198 2 matches for \"x\" in buffer:  *test-occur*
 199        :a
 200        :b
 201       3:cx
 202        :d
 203        :e
 204        :f
 205       7:gx
 206        :h
 207        :i
 208 ")
 209     ;; * Test overlapping context lines with empty first and last line..
 210     ("x" 2 "\
 211
 212 b
 213 cx
 214 d
 215 e
 216 f
 217 gx
 218 h
 219
 220 " "\
 221 2 matches for \"x\" in buffer:  *test-occur*
 222        :
 223        :b
 224       3:cx
 225        :d
 226        :e
 227        :f
 228       7:gx
 229        :h
 230        :
 231 ")
 232     ;; * Test multi-line overlapping context lines.
 233     ("x\n.x" 2 "\
 234 ax
 235 bx
 236 c
 237 d
 238 ex
 239 fx
 240 g
 241 h
 242 i
 243 jx
 244 kx
 245 " "\
 246 3 matches for \"x\n.x\" in buffer:  *test-occur*
 247       1:ax
 248        :bx
 249        :c
 250        :d
 251       5:ex
 252        :fx
 253        :g
 254        :h
 255        :i
 256      10:jx
 257        :kx
 258 ")
 259     ;; * Test multi-line non-overlapping context lines.
 260     ("x\n.x" 2 "\
 261 ax
 262 bx
 263 c
 264 d
 265 e
 266 f
 267 gx
 268 hx
 269 " "\
 270 2 matches for \"x\n.x\" in buffer:  *test-occur*
 271       1:ax
 272        :bx
 273        :c
 274        :d
 275 -------
 276        :e
 277        :f
 278       7:gx
 279        :hx
 280 ")
 281     ;; * Test non-overlapping negative (before-context) lines.
 282     ("x" -2 "\
 283 a
 284 bx
 285 c
 286 d
 287 e
 288 fx
 289 g
 290 h
 291 ix
 292 " "\
 293 3 matches for \"x\" in buffer:  *test-occur*
 294        :a
 295       2:bx
 296 -------
 297        :d
 298        :e
 299       6:fx
 300 -------
 301        :g
 302        :h
 303       9:ix
 304 ")
 305     ;; * Test overlapping negative (before-context) lines.
 306     ("x" -3 "\
 307 a
 308 bx
 309 c
 310 dx
 311 e
 312 f
 313 gx
 314 h
 315 " "\
 316 3 matches for \"x\" in buffer:  *test-occur*
 317        :a
 318       2:bx
 319        :c
 320       4:dx
 321        :e
 322        :f
 323       7:gx
 324 ")
 325
 326 )
 327   "List of tests for `occur'.
 328 Each element has the format:
 329 \(REGEXP NLINES INPUT-BUFFER-STRING OUTPUT-BUFFER-STRING).")
 330
 331 (defun replace-occur-test-case (test)
 332   (let ((regexp (nth 0 test))
 333         (nlines (nth 1 test))
 334         (input-buffer-string (nth 2 test))
 335         (temp-buffer (get-buffer-create " *test-occur*")))
 336     (unwind-protect
 337         (save-window-excursion
 338           (with-current-buffer temp-buffer
 339             (erase-buffer)
 340             (insert input-buffer-string)
 341             (occur regexp nlines)
 342             (with-current-buffer "*Occur*"
 343               (buffer-substring-no-properties (point-min) (point-max)))))
 344       (and (buffer-name temp-buffer)
 345            (kill-buffer temp-buffer)))))
 346
 347 (defun replace-occur-test-create (n)
 348   "Create a test for element N of the `replace-occur-tests' constant."
 349   (let ((testname (intern (format "occur-test-%.2d" n)))
 350         (testdoc (format "Test element %d of `replace-occur-tests'." n)))
 351     (eval
 352      `(ert-deftest ,testname ()
 353         ,testdoc
 354         (let (replace-occur-hook)
 355           (should (equal (replace-occur-test-case (nth ,n replace-occur-tests))
 356                          (nth 3 (nth ,n replace-occur-tests)))))))))
 357
 358 (dotimes (i (length replace-occur-tests))
 359   (replace-occur-test-create i))
 360
 361 (defun replace-tests--query-replace-undo (&optional comma)
 362   (with-temp-buffer
 363     (insert "111")
 364     (goto-char 1)
 365     (let ((count 0))
 366       ;; Don't wait for user input.
 367       (cl-letf (((symbol-function 'read-event)
 368                  (lambda (&rest args)
 369                    (cl-incf count)
 370                    (let ((val (pcase count
 371                                 ('2 (if comma ?, ?\s)) ; replace and: ',' no move; '\s' go next
 372                                 ('3 ?u) ; undo
 373                                 ('4 ?q) ; exit
 374                                 (_ ?\s)))) ; replace current and go next
 375                      val))))
 376         (perform-replace "1" "2" t nil nil)))
 377     (buffer-string)))
 378
 379 (ert-deftest query-replace--undo ()
 380   (should (string= "211" (replace-tests--query-replace-undo)))
 381   (should (string= "211" (replace-tests--query-replace-undo 'comma))))
 382
 383 ;;; replace-tests.el ends here