Bump copyright
[gnu-emacs-elpa] / test / core-tests.el
1 ;;; core-tests.el --- company-mode tests -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
4
5 ;; Author: Dmitry Gutov
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 (require 'company-tests)
23
24 (ert-deftest company-good-prefix ()
25 (let ((company-minimum-prefix-length 5)
26 company-abort-manual-when-too-short
27 company--manual-action ;idle begin
28 (company-selection-changed t)) ;has no effect
29 (should (eq t (company--good-prefix-p "!@#$%")))
30 (should (eq nil (company--good-prefix-p "abcd")))
31 (should (eq nil (company--good-prefix-p 'stop)))
32 (should (eq t (company--good-prefix-p '("foo" . 5))))
33 (should (eq nil (company--good-prefix-p '("foo" . 4))))
34 (should (eq t (company--good-prefix-p '("foo" . t))))))
35
36 (ert-deftest company--manual-prefix-set-and-unset ()
37 (with-temp-buffer
38 (insert "ab")
39 (company-mode)
40 (let (company-frontends
41 (company-backends
42 (list (lambda (command &optional _)
43 (cl-case command
44 (prefix (buffer-substring (point-min) (point)))
45 (candidates '("abc" "abd")))))))
46 (company-manual-begin)
47 (should (equal "ab" company--manual-prefix))
48 (company-abort)
49 (should (null company--manual-prefix)))))
50
51 (ert-deftest company-abort-manual-when-too-short ()
52 (let ((company-minimum-prefix-length 5)
53 (company-abort-manual-when-too-short t)
54 (company-selection-changed t)) ;has not effect
55 (let ((company--manual-action nil)) ;idle begin
56 (should (eq t (company--good-prefix-p "!@#$%")))
57 (should (eq t (company--good-prefix-p '("foo" . 5))))
58 (should (eq t (company--good-prefix-p '("foo" . t)))))
59 (let ((company--manual-action t)
60 (company--manual-prefix "abc")) ;manual begin from this prefix
61 (should (eq t (company--good-prefix-p "!@#$")))
62 (should (eq nil (company--good-prefix-p "ab")))
63 (should (eq nil (company--good-prefix-p 'stop)))
64 (should (eq t (company--good-prefix-p '("foo" . 4))))
65 (should (eq t (company--good-prefix-p "abcd")))
66 (should (eq t (company--good-prefix-p "abc")))
67 (should (eq t (company--good-prefix-p '("bar" . t)))))))
68
69 (ert-deftest company-common-with-non-prefix-completion ()
70 (let ((company-backend #'ignore)
71 (company-prefix "abc")
72 company-candidates
73 company-candidates-length
74 company-candidates-cache
75 company-common)
76 (company-update-candidates '("abc" "def-abc"))
77 (should (null company-common))
78 (company-update-candidates '("abc" "abe-c"))
79 (should (null company-common))
80 (company-update-candidates '("abcd" "abcde" "abcdf"))
81 (should (equal "abcd" company-common))))
82
83 (ert-deftest company-multi-backend-with-lambdas ()
84 (let ((company-backend
85 (list (lambda (command &optional _ &rest _r)
86 (cl-case command
87 (prefix "z")
88 (candidates '("a" "b"))))
89 (lambda (command &optional _ &rest _r)
90 (cl-case command
91 (prefix "z")
92 (candidates '("c" "d")))))))
93 (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" "d")))))
94
95 (ert-deftest company-multi-backend-filters-backends-by-prefix ()
96 (let ((company-backend
97 (list (lambda (command &optional _ &rest _r)
98 (cl-case command
99 (prefix (cons "z" t))
100 (candidates '("a" "b"))))
101 (lambda (command &optional _ &rest _r)
102 (cl-case command
103 (prefix "t")
104 (candidates '("c" "d"))))
105 (lambda (command &optional _ &rest _r)
106 (cl-case command
107 (prefix "z")
108 (candidates '("e" "f")))))))
109 (should (equal (company-call-backend 'candidates "z") '("a" "b" "e" "f")))))
110
111 (ert-deftest company-multi-backend-remembers-candidate-backend ()
112 (let ((company-backend
113 (list (lambda (command &optional _)
114 (cl-case command
115 (ignore-case nil)
116 (annotation "1")
117 (candidates '("a" "c"))
118 (post-completion "13")))
119 (lambda (command &optional _)
120 (cl-case command
121 (ignore-case t)
122 (annotation "2")
123 (candidates '("b" "d"))
124 (post-completion "42")))
125 (lambda (command &optional _)
126 (cl-case command
127 (annotation "3")
128 (candidates '("e"))
129 (post-completion "74"))))))
130 (let ((candidates (company-calculate-candidates nil)))
131 (should (equal candidates '("a" "b" "c" "d" "e")))
132 (should (equal t (company-call-backend 'ignore-case)))
133 (should (equal "1" (company-call-backend 'annotation (nth 0 candidates))))
134 (should (equal "2" (company-call-backend 'annotation (nth 1 candidates))))
135 (should (equal "13" (company-call-backend 'post-completion (nth 2 candidates))))
136 (should (equal "42" (company-call-backend 'post-completion (nth 3 candidates))))
137 (should (equal "3" (company-call-backend 'annotation (nth 4 candidates))))
138 (should (equal "74" (company-call-backend 'post-completion (nth 4 candidates)))))))
139
140 (ert-deftest company-multi-backend-handles-keyword-with ()
141 (let ((primo (lambda (command &optional _)
142 (cl-case command
143 (prefix "a")
144 (candidates '("abb" "abc" "abd")))))
145 (secundo (lambda (command &optional _)
146 (cl-case command
147 (prefix "a")
148 (candidates '("acc" "acd"))))))
149 (let ((company-backend (list 'ignore 'ignore :with secundo)))
150 (should (null (company-call-backend 'prefix))))
151 (let ((company-backend (list 'ignore primo :with secundo)))
152 (should (equal "a" (company-call-backend 'prefix)))
153 (should (equal '("abb" "abc" "abd" "acc" "acd")
154 (company-call-backend 'candidates "a"))))))
155
156 (ert-deftest company-multi-backend-handles-keyword-separate ()
157 (let ((one (lambda (command &optional _)
158 (cl-case command
159 (prefix "a")
160 (candidates '("aa" "ca" "ba")))))
161 (two (lambda (command &optional _)
162 (cl-case command
163 (prefix "a")
164 (candidates '("bb" "ab")))))
165 (tri (lambda (command &optional _)
166 (cl-case command
167 (prefix "a")
168 (sorted t)
169 (candidates '("cc" "bc" "ac"))))))
170 (let ((company-backend (list one two tri :separate)))
171 (should (company-call-backend 'sorted))
172 (should-not (company-call-backend 'duplicates))
173 (should (equal '("aa" "ba" "ca" "ab" "bb" "cc" "bc" "ac")
174 (company-call-backend 'candidates "a"))))))
175
176 (ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
177 (with-temp-buffer
178 (insert "a")
179 (company-mode)
180 (should-error
181 (company-begin-backend #'ignore))
182 (let (company-frontends
183 (company-backends
184 (list (lambda (command &optional _)
185 (cl-case command
186 (prefix "a")
187 (candidates '("a" "ab" "ac")))))))
188 (let (this-command)
189 (company-call 'complete))
190 (should (eq 3 company-candidates-length)))))
191
192 (ert-deftest company-require-match-explicit ()
193 (with-temp-buffer
194 (insert "ab")
195 (company-mode)
196 (let (company-frontends
197 (company-require-match 'company-explicit-action-p)
198 (company-backends
199 (list (lambda (command &optional _)
200 (cl-case command
201 (prefix (buffer-substring (point-min) (point)))
202 (candidates '("abc" "abd")))))))
203 (let (this-command)
204 (company-complete))
205 (let ((last-command-event ?e))
206 (company-call 'self-insert-command 1))
207 (should (eq 2 company-candidates-length))
208 (should (eq 3 (point))))))
209
210 (ert-deftest company-dont-require-match-when-idle ()
211 (with-temp-buffer
212 (insert "ab")
213 (company-mode)
214 (let (company-frontends
215 (company-minimum-prefix-length 2)
216 (company-require-match 'company-explicit-action-p)
217 (company-backends
218 (list (lambda (command &optional _)
219 (cl-case command
220 (prefix (buffer-substring (point-min) (point)))
221 (candidates '("abc" "abd")))))))
222 (company-idle-begin (current-buffer) (selected-window)
223 (buffer-chars-modified-tick) (point))
224 (should (eq 2 company-candidates-length))
225 (let ((last-command-event ?e))
226 (company-call 'self-insert-command 1))
227 (should (eq nil company-candidates-length))
228 (should (eq 4 (point))))))
229
230 (ert-deftest company-dont-require-match-if-was-a-match-and-old-prefix-ended ()
231 (with-temp-buffer
232 (insert "ab")
233 (company-mode)
234 (let (company-frontends
235 company-auto-complete
236 (company-require-match t)
237 (company-backends
238 (list (lambda (command &optional _)
239 (cl-case command
240 (prefix (company-grab-word))
241 (candidates '("abc" "ab" "abd"))
242 (sorted t))))))
243 (let (this-command)
244 (company-complete))
245 (let ((last-command-event ?e))
246 (company-call 'self-insert-command 1))
247 (should (eq 3 company-candidates-length))
248 (should (eq 3 (point)))
249 (let ((last-command-event ? ))
250 (company-call 'self-insert-command 1))
251 (should (null company-candidates-length))
252 (should (eq 4 (point))))))
253
254 (ert-deftest company-dont-require-match-if-was-a-match-and-new-prefix-is-stop ()
255 (with-temp-buffer
256 (company-mode)
257 (insert "c")
258 (let (company-frontends
259 (company-require-match t)
260 (company-backends
261 (list (lambda (command &optional _)
262 (cl-case command
263 (prefix (if (> (point) 2)
264 'stop
265 (buffer-substring (point-min) (point))))
266 (candidates '("a" "b" "c")))))))
267 (let (this-command)
268 (company-complete))
269 (should (eq 3 company-candidates-length))
270 (let ((last-command-event ?e))
271 (company-call 'self-insert-command 1))
272 (should (not company-candidates)))))
273
274 (ert-deftest company-should-complete-whitelist ()
275 (with-temp-buffer
276 (insert "ab")
277 (company-mode)
278 (let (company-frontends
279 company-begin-commands
280 (company-backends
281 (list (lambda (command &optional _)
282 (cl-case command
283 (prefix (buffer-substring (point-min) (point)))
284 (candidates '("abc" "abd")))))))
285 (let ((company-continue-commands nil))
286 (let (this-command)
287 (company-complete))
288 (company-call 'backward-delete-char 1)
289 (should (null company-candidates-length)))
290 (let ((company-continue-commands '(backward-delete-char)))
291 (let (this-command)
292 (company-complete))
293 (company-call 'backward-delete-char 1)
294 (should (eq 2 company-candidates-length))))))
295
296 (ert-deftest company-should-complete-blacklist ()
297 (with-temp-buffer
298 (insert "ab")
299 (company-mode)
300 (let (company-frontends
301 company-begin-commands
302 (company-backends
303 (list (lambda (command &optional _)
304 (cl-case command
305 (prefix (buffer-substring (point-min) (point)))
306 (candidates '("abc" "abd")))))))
307 (let ((company-continue-commands '(not backward-delete-char)))
308 (let (this-command)
309 (company-complete))
310 (company-call 'backward-delete-char 1)
311 (should (null company-candidates-length)))
312 (let ((company-continue-commands '(not backward-delete-char-untabify)))
313 (let (this-command)
314 (company-complete))
315 (company-call 'backward-delete-char 1)
316 (should (eq 2 company-candidates-length))))))
317
318 (ert-deftest company-auto-complete-explicit ()
319 (with-temp-buffer
320 (insert "ab")
321 (company-mode)
322 (let (company-frontends
323 (company-auto-complete 'company-explicit-action-p)
324 (company-auto-complete-chars '(? ))
325 (company-backends
326 (list (lambda (command &optional _)
327 (cl-case command
328 (prefix (buffer-substring (point-min) (point)))
329 (candidates '("abcd" "abef")))))))
330 (let (this-command)
331 (company-complete))
332 (let ((last-command-event ? ))
333 (company-call 'self-insert-command 1))
334 (should (string= "abcd " (buffer-string))))))
335
336 (ert-deftest company-no-auto-complete-when-idle ()
337 (with-temp-buffer
338 (insert "ab")
339 (company-mode)
340 (let (company-frontends
341 (company-auto-complete 'company-explicit-action-p)
342 (company-auto-complete-chars '(? ))
343 (company-minimum-prefix-length 2)
344 (company-backends
345 (list (lambda (command &optional _)
346 (cl-case command
347 (prefix (buffer-substring (point-min) (point)))
348 (candidates '("abcd" "abef")))))))
349 (company-idle-begin (current-buffer) (selected-window)
350 (buffer-chars-modified-tick) (point))
351 (let ((last-command-event ? ))
352 (company-call 'self-insert-command 1))
353 (should (string= "ab " (buffer-string))))))
354
355 (ert-deftest company-clears-explicit-action-when-no-matches ()
356 (with-temp-buffer
357 (company-mode)
358 (let (company-frontends
359 company-backends)
360 (company-call 'manual-begin) ;; fails
361 (should (null company-candidates))
362 (should (null (company-explicit-action-p))))))
363
364 (ert-deftest company-ignore-case-replaces-prefix ()
365 (with-temp-buffer
366 (company-mode)
367 (let (company-frontends
368 (company-backends
369 (list (lambda (command &optional _)
370 (cl-case command
371 (prefix (buffer-substring (point-min) (point)))
372 (candidates '("abcd" "abef"))
373 (ignore-case t))))))
374 (insert "A")
375 (let (this-command)
376 (company-complete))
377 (should (string= "ab" (buffer-string)))
378 (delete-char -2)
379 (insert "A") ; hack, to keep it in one test
380 (company-complete-selection)
381 (should (string= "abcd" (buffer-string))))))
382
383 (ert-deftest company-ignore-case-with-keep-prefix ()
384 (with-temp-buffer
385 (insert "AB")
386 (company-mode)
387 (let (company-frontends
388 (company-backends
389 (list (lambda (command &optional _)
390 (cl-case command
391 (prefix (buffer-substring (point-min) (point)))
392 (candidates '("abcd" "abef"))
393 (ignore-case 'keep-prefix))))))
394 (let (this-command)
395 (company-complete))
396 (company-complete-selection)
397 (should (string= "ABcd" (buffer-string))))))
398
399 (ert-deftest company-non-prefix-completion ()
400 (with-temp-buffer
401 (insert "tc")
402 (company-mode)
403 (let (company-frontends
404 (company-backends
405 (list (lambda (command &optional _)
406 (cl-case command
407 (prefix (buffer-substring (point-min) (point)))
408 (candidates '("tea-cup" "teal-color")))))))
409 (let (this-command)
410 (company-complete))
411 (should (string= "tc" (buffer-string)))
412 (company-complete-selection)
413 (should (string= "tea-cup" (buffer-string))))))
414
415 (defvar ct-sorted nil)
416
417 (defun ct-equal-including-properties (list1 list2)
418 (or (and (not list1) (not list2))
419 (and (ert-equal-including-properties (car list1) (car list2))
420 (ct-equal-including-properties (cdr list1) (cdr list2)))))
421
422 (ert-deftest company-strips-duplicates-returns-nil ()
423 (should (null (company--preprocess-candidates nil))))
424
425 (ert-deftest company-strips-duplicates-within-groups ()
426 (let* ((kvs '(("a" . "b")
427 ("a" . nil)
428 ("a" . "b")
429 ("a" . "c")
430 ("a" . "b")
431 ("b" . "c")
432 ("b" . nil)
433 ("a" . "b")))
434 (fn (lambda (kvs)
435 (mapcar (lambda (kv) (propertize (car kv) 'ann (cdr kv)))
436 kvs)))
437 (company-backend
438 (lambda (command &optional arg)
439 (pcase command
440 (`prefix "")
441 (`sorted ct-sorted)
442 (`duplicates t)
443 (`annotation (get-text-property 0 'ann arg)))))
444 (reference '(("a" . "b")
445 ("a" . nil)
446 ("a" . "c")
447 ("b" . "c")
448 ("b" . nil)
449 ("a" . "b"))))
450 (let ((ct-sorted t))
451 (should (ct-equal-including-properties
452 (company--preprocess-candidates (funcall fn kvs))
453 (funcall fn reference))))
454 (should (ct-equal-including-properties
455 (company--preprocess-candidates (funcall fn kvs))
456 (funcall fn (butlast reference))))))
457
458 ;;; Row and column
459
460 (ert-deftest company-column-with-composition ()
461 :tags '(interactive)
462 (with-temp-buffer
463 (save-window-excursion
464 (set-window-buffer nil (current-buffer))
465 (insert "lambda ()")
466 (compose-region 1 (1+ (length "lambda")) "\\")
467 (should (= (company--column) 4)))))
468
469 (ert-deftest company-column-with-line-prefix ()
470 :tags '(interactive)
471 (with-temp-buffer
472 (save-window-excursion
473 (set-window-buffer nil (current-buffer))
474 (insert "foo")
475 (put-text-property (point-min) (point) 'line-prefix " ")
476 (should (= (company--column) 5)))))
477
478 (ert-deftest company-column-with-line-prefix-on-empty-line ()
479 :tags '(interactive)
480 (with-temp-buffer
481 (save-window-excursion
482 (set-window-buffer nil (current-buffer))
483 (insert "\n")
484 (forward-char -1)
485 (put-text-property (point-min) (point-max) 'line-prefix " ")
486 (should (= (company--column) 2)))))
487
488 (ert-deftest company-column-with-tabs ()
489 :tags '(interactive)
490 (with-temp-buffer
491 (save-window-excursion
492 (set-window-buffer nil (current-buffer))
493 (insert "|\t|\t|\t(")
494 (let ((tab-width 8))
495 (should (= (company--column) 25))))))
496
497 (ert-deftest company-row-with-header-line-format ()
498 :tags '(interactive)
499 (with-temp-buffer
500 (save-window-excursion
501 (set-window-buffer nil (current-buffer))
502 (should (= (company--row) 0))
503 (setq header-line-format "aaaaaaa")
504 (should (= (company--row) 0)))))