1 ;;; core-tests.el --- company-mode tests -*- lexical-binding: t -*-
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
5 ;; Author: Dmitry Gutov
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
22 (require 'company-tests)
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))))))
36 (ert-deftest company--manual-prefix-set-and-unset ()
40 (let (company-frontends
42 (list (lambda (command &optional _)
44 (prefix (buffer-substring (point-min) (point)))
45 (candidates '("abc" "abd")))))))
46 (company-manual-begin)
47 (should (equal "ab" company--manual-prefix))
49 (should (null company--manual-prefix)))))
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)))))))
69 (ert-deftest company-common-with-non-prefix-completion ()
70 (let ((company-backend #'ignore)
71 (company-prefix "abc")
73 company-candidates-length
74 company-candidates-cache
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))))
83 (ert-deftest company-multi-backend-with-lambdas ()
84 (let ((company-backend
85 (list (lambda (command &optional _ &rest _r)
88 (candidates '("a" "b"))))
89 (lambda (command &optional _ &rest _r)
92 (candidates '("c" "d")))))))
93 (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" "d")))))
95 (ert-deftest company-multi-backend-filters-backends-by-prefix ()
96 (let ((company-backend
97 (list (lambda (command &optional _ &rest _r)
100 (candidates '("a" "b"))))
101 (lambda (command &optional _ &rest _r)
104 (candidates '("c" "d"))))
105 (lambda (command &optional _ &rest _r)
108 (candidates '("e" "f")))))))
109 (should (equal (company-call-backend 'candidates "z") '("a" "b" "e" "f")))))
111 (ert-deftest company-multi-backend-remembers-candidate-backend ()
112 (let ((company-backend
113 (list (lambda (command &optional _)
117 (candidates '("a" "c"))
118 (post-completion "13")))
119 (lambda (command &optional _)
123 (candidates '("b" "d"))
124 (post-completion "42")))
125 (lambda (command &optional _)
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)))))))
140 (ert-deftest company-multi-backend-handles-keyword-with ()
141 (let ((primo (lambda (command &optional _)
144 (candidates '("abb" "abc" "abd")))))
145 (secundo (lambda (command &optional _)
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"))))))
156 (ert-deftest company-multi-backend-handles-keyword-separate ()
157 (let ((one (lambda (command &optional _)
160 (candidates '("aa" "ca" "ba")))))
161 (two (lambda (command &optional _)
164 (candidates '("bb" "ab")))))
165 (tri (lambda (command &optional _)
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"))))))
176 (ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
181 (company-begin-backend #'ignore))
182 (let (company-frontends
184 (list (lambda (command &optional _)
187 (candidates '("a" "ab" "ac")))))))
189 (company-call 'complete))
190 (should (eq 3 company-candidates-length)))))
192 (ert-deftest company-require-match-explicit ()
196 (let (company-frontends
197 (company-require-match 'company-explicit-action-p)
199 (list (lambda (command &optional _)
201 (prefix (buffer-substring (point-min) (point)))
202 (candidates '("abc" "abd")))))))
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))))))
210 (ert-deftest company-dont-require-match-when-idle ()
214 (let (company-frontends
215 (company-minimum-prefix-length 2)
216 (company-require-match 'company-explicit-action-p)
218 (list (lambda (command &optional _)
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))))))
230 (ert-deftest company-dont-require-match-if-was-a-match-and-old-prefix-ended ()
234 (let (company-frontends
235 company-auto-complete
236 (company-require-match t)
238 (list (lambda (command &optional _)
240 (prefix (company-grab-word))
241 (candidates '("abc" "ab" "abd"))
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))))))
254 (ert-deftest company-dont-require-match-if-was-a-match-and-new-prefix-is-stop ()
258 (let (company-frontends
259 (company-require-match t)
261 (list (lambda (command &optional _)
263 (prefix (if (> (point) 2)
265 (buffer-substring (point-min) (point))))
266 (candidates '("a" "b" "c")))))))
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)))))
274 (ert-deftest company-should-complete-whitelist ()
278 (let (company-frontends
279 company-begin-commands
281 (list (lambda (command &optional _)
283 (prefix (buffer-substring (point-min) (point)))
284 (candidates '("abc" "abd")))))))
285 (let ((company-continue-commands nil))
288 (company-call 'backward-delete-char 1)
289 (should (null company-candidates-length)))
290 (let ((company-continue-commands '(backward-delete-char)))
293 (company-call 'backward-delete-char 1)
294 (should (eq 2 company-candidates-length))))))
296 (ert-deftest company-should-complete-blacklist ()
300 (let (company-frontends
301 company-begin-commands
303 (list (lambda (command &optional _)
305 (prefix (buffer-substring (point-min) (point)))
306 (candidates '("abc" "abd")))))))
307 (let ((company-continue-commands '(not backward-delete-char)))
310 (company-call 'backward-delete-char 1)
311 (should (null company-candidates-length)))
312 (let ((company-continue-commands '(not backward-delete-char-untabify)))
315 (company-call 'backward-delete-char 1)
316 (should (eq 2 company-candidates-length))))))
318 (ert-deftest company-auto-complete-explicit ()
322 (let (company-frontends
323 (company-auto-complete 'company-explicit-action-p)
324 (company-auto-complete-chars '(? ))
326 (list (lambda (command &optional _)
328 (prefix (buffer-substring (point-min) (point)))
329 (candidates '("abcd" "abef")))))))
332 (let ((last-command-event ? ))
333 (company-call 'self-insert-command 1))
334 (should (string= "abcd " (buffer-string))))))
336 (ert-deftest company-no-auto-complete-when-idle ()
340 (let (company-frontends
341 (company-auto-complete 'company-explicit-action-p)
342 (company-auto-complete-chars '(? ))
343 (company-minimum-prefix-length 2)
345 (list (lambda (command &optional _)
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))))))
355 (ert-deftest company-clears-explicit-action-when-no-matches ()
358 (let (company-frontends
360 (company-call 'manual-begin) ;; fails
361 (should (null company-candidates))
362 (should (null (company-explicit-action-p))))))
364 (ert-deftest company-ignore-case-replaces-prefix ()
367 (let (company-frontends
369 (list (lambda (command &optional _)
371 (prefix (buffer-substring (point-min) (point)))
372 (candidates '("abcd" "abef"))
377 (should (string= "ab" (buffer-string)))
379 (insert "A") ; hack, to keep it in one test
380 (company-complete-selection)
381 (should (string= "abcd" (buffer-string))))))
383 (ert-deftest company-ignore-case-with-keep-prefix ()
387 (let (company-frontends
389 (list (lambda (command &optional _)
391 (prefix (buffer-substring (point-min) (point)))
392 (candidates '("abcd" "abef"))
393 (ignore-case 'keep-prefix))))))
396 (company-complete-selection)
397 (should (string= "ABcd" (buffer-string))))))
399 (ert-deftest company-non-prefix-completion ()
403 (let (company-frontends
405 (list (lambda (command &optional _)
407 (prefix (buffer-substring (point-min) (point)))
408 (candidates '("tea-cup" "teal-color")))))))
411 (should (string= "tc" (buffer-string)))
412 (company-complete-selection)
413 (should (string= "tea-cup" (buffer-string))))))
415 (defvar ct-sorted nil)
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)))))
422 (ert-deftest company-strips-duplicates-returns-nil ()
423 (should (null (company--preprocess-candidates nil))))
425 (ert-deftest company-strips-duplicates-within-groups ()
426 (let* ((kvs '(("a" . "b")
435 (mapcar (lambda (kv) (propertize (car kv) 'ann (cdr kv)))
438 (lambda (command &optional arg)
443 (`annotation (get-text-property 0 'ann arg)))))
444 (reference '(("a" . "b")
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))))))
460 (ert-deftest company-column-with-composition ()
463 (save-window-excursion
464 (set-window-buffer nil (current-buffer))
466 (compose-region 1 (1+ (length "lambda")) "\\")
467 (should (= (company--column) 4)))))
469 (ert-deftest company-column-with-line-prefix ()
472 (save-window-excursion
473 (set-window-buffer nil (current-buffer))
475 (put-text-property (point-min) (point) 'line-prefix " ")
476 (should (= (company--column) 5)))))
478 (ert-deftest company-column-with-line-prefix-on-empty-line ()
481 (save-window-excursion
482 (set-window-buffer nil (current-buffer))
485 (put-text-property (point-min) (point-max) 'line-prefix " ")
486 (should (= (company--column) 2)))))
488 (ert-deftest company-column-with-tabs ()
491 (save-window-excursion
492 (set-window-buffer nil (current-buffer))
493 (insert "|\t|\t|\t(")
495 (should (= (company--column) 25))))))
497 (ert-deftest company-row-with-header-line-format ()
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)))))