Commit | Line | Data |
---|---|---|
3bace969 AH |
1 | ;;; undo-tests.el --- Tests of primitive-undo |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2012-2014 Free Software Foundation, Inc. |
3bace969 AH |
4 | |
5 | ;; Author: Aaron S. Hawley <aaron.s.hawley@gmail.com> | |
6 | ||
7 | ;; This program is free software: you can redistribute it and/or | |
8 | ;; modify it under the terms of the GNU General Public License as | |
9 | ;; published by the Free Software Foundation, either version 3 of the | |
10 | ;; License, or (at your option) any later version. | |
11 | ;; | |
12 | ;; This program is distributed in the hope that it will be useful, but | |
13 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
15 | ;; General Public License for more details. | |
16 | ;; | |
17 | ;; You should have received a copy of the GNU General Public License | |
18 | ;; along with this program. If not, see `http://www.gnu.org/licenses/'. | |
19 | ||
20 | ;;; Commentary: | |
21 | ||
22 | ;; Profiling when the code was translate from C to Lisp on 2012-12-24. | |
23 | ||
24 | ;;; C | |
25 | ||
26 | ;; (elp-instrument-function 'primitive-undo) | |
27 | ;; (load-file "undo-test.elc") | |
28 | ;; (benchmark 100 '(let ((undo-test5-error nil)) (undo-test-all))) | |
29 | ;; Elapsed time: 305.218000s (104.841000s in 14804 GCs) | |
30 | ;; M-x elp-results | |
31 | ;; Function Name Call Count Elapsed Time Average Time | |
32 | ;; primitive-undo 2600 3.4889999999 0.0013419230 | |
33 | ||
34 | ;;; Lisp | |
35 | ||
36 | ;; (load-file "primundo.elc") | |
37 | ;; (elp-instrument-function 'primitive-undo) | |
38 | ;; (benchmark 100 '(undo-test-all)) | |
39 | ;; Elapsed time: 295.974000s (104.582000s in 14704 GCs) | |
40 | ;; M-x elp-results | |
41 | ;; Function Name Call Count Elapsed Time Average Time | |
42 | ;; primitive-undo 2700 3.6869999999 0.0013655555 | |
43 | ||
44 | ;;; Code: | |
45 | ||
46 | (require 'ert) | |
47 | ||
48 | (ert-deftest undo-test0 () | |
49 | "Test basics of \\[undo]." | |
50 | (with-temp-buffer | |
51 | (buffer-enable-undo) | |
52 | (condition-case err | |
53 | (undo) | |
54 | (error | |
55 | (unless (string= "No further undo information" | |
56 | (cadr err)) | |
57 | (error err)))) | |
58 | (undo-boundary) | |
59 | (insert "This") | |
60 | (undo-boundary) | |
61 | (erase-buffer) | |
62 | (undo-boundary) | |
63 | (insert "That") | |
64 | (undo-boundary) | |
65 | (forward-word -1) | |
66 | (undo-boundary) | |
67 | (insert "With ") | |
68 | (undo-boundary) | |
69 | (forward-word -1) | |
70 | (undo-boundary) | |
71 | (kill-word 1) | |
72 | (undo-boundary) | |
73 | (put-text-property (point-min) (point-max) 'face 'bold) | |
74 | (undo-boundary) | |
75 | (remove-text-properties (point-min) (point-max) '(face default)) | |
76 | (undo-boundary) | |
77 | (set-buffer-multibyte (not enable-multibyte-characters)) | |
78 | (undo-boundary) | |
79 | (undo) | |
80 | (should | |
81 | (equal (should-error (undo-more nil)) | |
51fb5578 | 82 | '(wrong-type-argument number-or-marker-p nil))) |
3bace969 AH |
83 | (undo-more 7) |
84 | (should (string-equal "" (buffer-string))))) | |
85 | ||
86 | (ert-deftest undo-test1 () | |
87 | "Test undo of \\[undo] command (redo)." | |
88 | (with-temp-buffer | |
89 | (buffer-enable-undo) | |
90 | (undo-boundary) | |
91 | (insert "This") | |
92 | (undo-boundary) | |
93 | (erase-buffer) | |
94 | (undo-boundary) | |
95 | (insert "That") | |
96 | (undo-boundary) | |
97 | (forward-word -1) | |
98 | (undo-boundary) | |
99 | (insert "With ") | |
100 | (undo-boundary) | |
101 | (forward-word -1) | |
102 | (undo-boundary) | |
103 | (kill-word 1) | |
104 | (undo-boundary) | |
105 | (facemenu-add-face 'bold (point-min) (point-max)) | |
106 | (undo-boundary) | |
107 | (set-buffer-multibyte (not enable-multibyte-characters)) | |
108 | (undo-boundary) | |
109 | (should | |
110 | (string-equal (buffer-string) | |
111 | (progn | |
112 | (undo) | |
113 | (undo-more 4) | |
114 | (undo) | |
115 | ;(undo-more -4) | |
116 | (buffer-string)))))) | |
117 | ||
118 | (ert-deftest undo-test2 () | |
119 | "Test basic redoing with \\[undo] command." | |
120 | (with-temp-buffer | |
121 | (buffer-enable-undo) | |
122 | (undo-boundary) | |
123 | (insert "One") | |
124 | (undo-boundary) | |
125 | (insert " Zero") | |
126 | (undo-boundary) | |
67a17772 | 127 | (push-mark nil t) |
3bace969 AH |
128 | (delete-region (save-excursion |
129 | (forward-word -1) | |
130 | (point)) (point)) | |
131 | (undo-boundary) | |
132 | (beginning-of-line) | |
133 | (insert "Zero") | |
134 | (undo-boundary) | |
135 | (undo) | |
136 | (should | |
137 | (string-equal (buffer-string) | |
138 | (progn | |
139 | (undo-more 2) | |
140 | (undo) | |
141 | (buffer-string)))))) | |
142 | ||
3bace969 AH |
143 | (ert-deftest undo-test4 () |
144 | "Test \\[undo] of \\[flush-lines]." | |
145 | (with-temp-buffer | |
146 | (buffer-enable-undo) | |
147 | (dotimes (i 1048576) | |
148 | (if (zerop (% i 2)) | |
149 | (insert "Evenses") | |
150 | (insert "Oddses"))) | |
151 | (undo-boundary) | |
152 | (should | |
153 | ;; Avoid string-equal because ERT will save the `buffer-string' | |
154 | ;; to the explanation. Using `not' will record nil or non-nil. | |
155 | (not | |
156 | (null | |
157 | (string-equal (buffer-string) | |
158 | (progn | |
159 | (flush-lines "oddses" (point-min) (point-max)) | |
160 | (undo-boundary) | |
161 | (undo) | |
162 | (undo) | |
163 | (buffer-string)))))))) | |
164 | ||
165 | (ert-deftest undo-test5 () | |
166 | "Test basic redoing with \\[undo] command." | |
167 | (with-temp-buffer | |
168 | (buffer-enable-undo) | |
169 | (undo-boundary) | |
170 | (insert "AYE") | |
171 | (undo-boundary) | |
172 | (insert " BEE") | |
173 | (undo-boundary) | |
174 | (setq buffer-undo-list (cons '(0.0 bogus) buffer-undo-list)) | |
67a17772 | 175 | (push-mark nil t) |
3bace969 AH |
176 | (delete-region (save-excursion |
177 | (forward-word -1) | |
178 | (point)) (point)) | |
179 | (undo-boundary) | |
180 | (beginning-of-line) | |
181 | (insert "CEE") | |
182 | (undo-boundary) | |
183 | (undo) | |
184 | (setq buffer-undo-list (cons "bogus" buffer-undo-list)) | |
185 | (should | |
186 | (string-equal | |
187 | (buffer-string) | |
188 | (progn | |
189 | (if (and (boundp 'undo-test5-error) (not undo-test5-error)) | |
190 | (progn | |
191 | (should (null (undo-more 2))) | |
192 | (should (undo))) | |
193 | ;; Errors are generated by new Lisp version of | |
194 | ;; `primitive-undo' not by built-in C version. | |
195 | (should | |
196 | (equal (should-error (undo-more 2)) | |
197 | '(error "Unrecognized entry in undo list (0.0 bogus)"))) | |
198 | (should | |
199 | (equal (should-error (undo)) | |
200 | '(error "Unrecognized entry in undo list \"bogus\"")))) | |
201 | (buffer-string)))))) | |
202 | ||
7faba176 GM |
203 | ;; http://debbugs.gnu.org/14824 |
204 | (ert-deftest undo-test-buffer-modified () | |
205 | "Test undoing marks buffer unmodified." | |
206 | (with-temp-buffer | |
207 | (buffer-enable-undo) | |
208 | (insert "1") | |
209 | (undo-boundary) | |
210 | (set-buffer-modified-p nil) | |
211 | (insert "2") | |
212 | (undo) | |
213 | (should-not (buffer-modified-p)))) | |
214 | ||
215 | (ert-deftest undo-test-file-modified () | |
216 | "Test undoing marks buffer visiting file unmodified." | |
217 | (let ((tempfile (make-temp-file "undo-test"))) | |
218 | (unwind-protect | |
219 | (progn | |
220 | (with-current-buffer (find-file-noselect tempfile) | |
221 | (insert "1") | |
222 | (undo-boundary) | |
223 | (set-buffer-modified-p nil) | |
224 | (insert "2") | |
225 | (undo) | |
226 | (should-not (buffer-modified-p)))) | |
227 | (delete-file tempfile)))) | |
228 | ||
4807c7eb | 229 | (ert-deftest undo-test-region-not-most-recent () |
e3d090b4 BR |
230 | "Test undo in region of an edit not the most recent." |
231 | (with-temp-buffer | |
232 | (buffer-enable-undo) | |
233 | (transient-mark-mode 1) | |
234 | (insert "1111") | |
235 | (undo-boundary) | |
236 | (goto-char 2) | |
237 | (insert "2") | |
238 | (forward-char 2) | |
239 | (undo-boundary) | |
240 | (insert "3") | |
241 | (undo-boundary) | |
242 | ;; Highlight around "2", not "3" | |
243 | (push-mark (+ 3 (point-min)) t t) | |
244 | (setq mark-active t) | |
245 | (goto-char (point-min)) | |
246 | (undo) | |
247 | (should (string= (buffer-string) | |
248 | "11131")))) | |
249 | ||
4807c7eb BR |
250 | (ert-deftest undo-test-region-deletion () |
251 | "Test undoing a deletion to demonstrate bug 17235." | |
252 | (with-temp-buffer | |
253 | (buffer-enable-undo) | |
254 | (transient-mark-mode 1) | |
255 | (insert "12345") | |
256 | (search-backward "4") | |
257 | (undo-boundary) | |
258 | (delete-forward-char 1) | |
259 | (search-backward "1") | |
260 | (undo-boundary) | |
261 | (insert "xxxx") | |
262 | (undo-boundary) | |
263 | (insert "yy") | |
264 | (search-forward "35") | |
265 | (undo-boundary) | |
266 | ;; Select "35" | |
267 | (push-mark (point) t t) | |
268 | (setq mark-active t) | |
269 | (forward-char -2) | |
270 | (undo) ; Expect "4" to come back | |
271 | (should (string= (buffer-string) | |
272 | "xxxxyy12345")))) | |
273 | ||
274 | (ert-deftest undo-test-region-example () | |
275 | "The same example test case described in comments for | |
276 | undo-make-selective-list." | |
277 | ;; buf pos: | |
278 | ;; 123456789 buffer-undo-list undo-deltas | |
279 | ;; --------- ---------------- ----------- | |
280 | ;; aaa (1 . 4) (1 . -3) | |
281 | ;; aaba (3 . 4) N/A (in region) | |
282 | ;; ccaaba (1 . 3) (1 . -2) | |
283 | ;; ccaabaddd (7 . 10) (7 . -3) | |
284 | ;; ccaabdd ("ad" . 6) (6 . 2) | |
285 | ;; ccaabaddd (6 . 8) (6 . -2) | |
286 | ;; | |<-- region: "caab", from 2 to 6 | |
287 | (with-temp-buffer | |
288 | (buffer-enable-undo) | |
289 | (transient-mark-mode 1) | |
290 | (insert "aaa") | |
291 | (goto-char 3) | |
292 | (undo-boundary) | |
293 | (insert "b") | |
294 | (goto-char 1) | |
295 | (undo-boundary) | |
296 | (insert "cc") | |
297 | (goto-char 7) | |
298 | (undo-boundary) | |
299 | (insert "ddd") | |
300 | (search-backward "ad") | |
301 | (undo-boundary) | |
302 | (delete-forward-char 2) | |
303 | (undo-boundary) | |
304 | ;; Select "dd" | |
305 | (push-mark (point) t t) | |
306 | (setq mark-active t) | |
307 | (goto-char (point-max)) | |
308 | (undo) | |
309 | (undo-boundary) | |
310 | (should (string= (buffer-string) | |
311 | "ccaabaddd")) | |
312 | ;; Select "caab" | |
313 | (push-mark 2 t t) | |
314 | (setq mark-active t) | |
315 | (goto-char 6) | |
316 | (undo) | |
317 | (undo-boundary) | |
318 | (should (string= (buffer-string) | |
319 | "ccaaaddd")))) | |
320 | ||
321 | (ert-deftest undo-test-region-eob () | |
e3d090b4 BR |
322 | "Test undo in region of a deletion at EOB, demonstrating bug 16411." |
323 | (with-temp-buffer | |
324 | (buffer-enable-undo) | |
325 | (transient-mark-mode 1) | |
326 | (insert "This sentence corrupted?") | |
327 | (undo-boundary) | |
328 | ;; Same as recipe at | |
329 | ;; http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16411 | |
330 | (insert "aaa") | |
331 | (undo-boundary) | |
332 | (undo) | |
333 | ;; Select entire buffer | |
334 | (push-mark (point) t t) | |
335 | (setq mark-active t) | |
336 | (goto-char (point-min)) | |
337 | ;; Should undo the undo of "aaa", ie restore it. | |
338 | (undo) | |
339 | (should (string= (buffer-string) | |
340 | "This sentence corrupted?aaa")))) | |
341 | ||
37ea8275 BR |
342 | (ert-deftest undo-test-marker-adjustment-nominal () |
343 | "Test nominal behavior of marker adjustments." | |
344 | (with-temp-buffer | |
345 | (buffer-enable-undo) | |
346 | (insert "abcdefg") | |
347 | (undo-boundary) | |
348 | (let ((m (make-marker))) | |
349 | (set-marker m 2 (current-buffer)) | |
350 | (goto-char (point-min)) | |
351 | (delete-forward-char 3) | |
352 | (undo-boundary) | |
353 | (should (= (point-min) (marker-position m))) | |
354 | (undo) | |
355 | (undo-boundary) | |
356 | (should (= 2 (marker-position m)))))) | |
357 | ||
358 | (ert-deftest undo-test-region-t-marker () | |
359 | "Test undo in region containing marker with t insertion-type." | |
360 | (with-temp-buffer | |
361 | (buffer-enable-undo) | |
362 | (transient-mark-mode 1) | |
363 | (insert "abcdefg") | |
364 | (undo-boundary) | |
365 | (let ((m (make-marker))) | |
366 | (set-marker-insertion-type m t) | |
367 | (set-marker m (point-min) (current-buffer)) ; m at a | |
368 | (goto-char (+ 2 (point-min))) | |
369 | (push-mark (point) t t) | |
370 | (setq mark-active t) | |
371 | (goto-char (point-min)) | |
372 | (delete-forward-char 1) ;; delete region covering "ab" | |
373 | (undo-boundary) | |
374 | (should (= (point-min) (marker-position m))) | |
375 | ;; Resurrect "ab". m's insertion type means the reinsertion | |
376 | ;; moves it forward 2, and then the marker adjustment returns it | |
377 | ;; to its rightful place. | |
378 | (undo) | |
379 | (undo-boundary) | |
380 | (should (= (point-min) (marker-position m)))))) | |
381 | ||
382 | (ert-deftest undo-test-marker-adjustment-moved () | |
383 | "Test marker adjustment behavior when the marker moves. | |
384 | Demonstrates bug 16818." | |
385 | (with-temp-buffer | |
386 | (buffer-enable-undo) | |
387 | (insert "abcdefghijk") | |
388 | (undo-boundary) | |
389 | (let ((m (make-marker))) | |
390 | (set-marker m 2 (current-buffer)) ; m at b | |
391 | (goto-char (point-min)) | |
392 | (delete-forward-char 3) ; m at d | |
393 | (undo-boundary) | |
394 | (set-marker m 4) ; m at g | |
395 | (undo) | |
396 | (undo-boundary) | |
397 | ;; m still at g, but shifted 3 because deletion undone | |
398 | (should (= 7 (marker-position m)))))) | |
399 | ||
400 | (ert-deftest undo-test-region-mark-adjustment () | |
401 | "Test that the mark's marker adjustment in undo history doesn't | |
402 | obstruct undo in region from finding the correct change group. | |
403 | Demonstrates bug 16818." | |
404 | (with-temp-buffer | |
405 | (buffer-enable-undo) | |
406 | (transient-mark-mode 1) | |
407 | (insert "First line\n") | |
408 | (insert "Second line\n") | |
409 | (undo-boundary) | |
410 | ||
411 | (goto-char (point-min)) | |
412 | (insert "aaa") | |
413 | (undo-boundary) | |
414 | ||
415 | (undo) | |
416 | (undo-boundary) | |
417 | ||
418 | (goto-char (point-max)) | |
419 | (insert "bbb") | |
420 | (undo-boundary) | |
421 | ||
422 | (push-mark (point) t t) | |
423 | (setq mark-active t) | |
424 | (goto-char (- (point) 3)) | |
425 | (delete-forward-char 1) | |
426 | (undo-boundary) | |
427 | ||
428 | (insert "bbb") | |
429 | (undo-boundary) | |
430 | ||
431 | (goto-char (point-min)) | |
432 | (push-mark (point) t t) | |
433 | (setq mark-active t) | |
434 | (goto-char (+ (point) 3)) | |
435 | (undo) | |
436 | (undo-boundary) | |
437 | ||
438 | (should (string= (buffer-string) "aaaFirst line\nSecond line\nbbb")))) | |
439 | ||
3bace969 AH |
440 | (defun undo-test-all (&optional interactive) |
441 | "Run all tests for \\[undo]." | |
442 | (interactive "p") | |
443 | (if interactive | |
444 | (ert-run-tests-interactively "^undo-") | |
445 | (ert-run-tests-batch "^undo-"))) | |
446 | ||
447 | (provide 'undo-tests) | |
448 | ;;; undo-tests.el ends here |