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-begin-backend-failure-doesnt-break-company-backends ()
161 (company-begin-backend #'ignore))
162 (let (company-frontends
164 (list (lambda (command &optional _)
167 (candidates '("a" "ab" "ac")))))))
169 (company-call 'complete))
170 (should (eq 3 company-candidates-length)))))
172 (ert-deftest company-require-match-explicit ()
176 (let (company-frontends
177 (company-require-match 'company-explicit-action-p)
179 (list (lambda (command &optional _)
181 (prefix (buffer-substring (point-min) (point)))
182 (candidates '("abc" "abd")))))))
185 (let ((last-command-event ?e))
186 (company-call 'self-insert-command 1))
187 (should (eq 2 company-candidates-length))
188 (should (eq 3 (point))))))
190 (ert-deftest company-dont-require-match-when-idle ()
194 (let (company-frontends
195 (company-minimum-prefix-length 2)
196 (company-require-match 'company-explicit-action-p)
198 (list (lambda (command &optional _)
200 (prefix (buffer-substring (point-min) (point)))
201 (candidates '("abc" "abd")))))))
202 (company-idle-begin (current-buffer) (selected-window)
203 (buffer-chars-modified-tick) (point))
204 (should (eq 2 company-candidates-length))
205 (let ((last-command-event ?e))
206 (company-call 'self-insert-command 1))
207 (should (eq nil company-candidates-length))
208 (should (eq 4 (point))))))
210 (ert-deftest company-dont-require-match-if-was-a-match-and-old-prefix-ended ()
214 (let (company-frontends
215 company-auto-complete
216 (company-require-match t)
218 (list (lambda (command &optional _)
220 (prefix (company-grab-word))
221 (candidates '("abc" "ab" "abd"))
225 (let ((last-command-event ?e))
226 (company-call 'self-insert-command 1))
227 (should (eq 3 company-candidates-length))
228 (should (eq 3 (point)))
229 (let ((last-command-event ? ))
230 (company-call 'self-insert-command 1))
231 (should (null company-candidates-length))
232 (should (eq 4 (point))))))
234 (ert-deftest company-dont-require-match-if-was-a-match-and-new-prefix-is-stop ()
238 (let (company-frontends
239 (company-require-match t)
241 (list (lambda (command &optional _)
243 (prefix (if (> (point) 2)
245 (buffer-substring (point-min) (point))))
246 (candidates '("a" "b" "c")))))))
249 (should (eq 3 company-candidates-length))
250 (let ((last-command-event ?e))
251 (company-call 'self-insert-command 1))
252 (should (not company-candidates)))))
254 (ert-deftest company-should-complete-whitelist ()
258 (let (company-frontends
259 company-begin-commands
261 (list (lambda (command &optional _)
263 (prefix (buffer-substring (point-min) (point)))
264 (candidates '("abc" "abd")))))))
265 (let ((company-continue-commands nil))
268 (company-call 'backward-delete-char 1)
269 (should (null company-candidates-length)))
270 (let ((company-continue-commands '(backward-delete-char)))
273 (company-call 'backward-delete-char 1)
274 (should (eq 2 company-candidates-length))))))
276 (ert-deftest company-should-complete-blacklist ()
280 (let (company-frontends
281 company-begin-commands
283 (list (lambda (command &optional _)
285 (prefix (buffer-substring (point-min) (point)))
286 (candidates '("abc" "abd")))))))
287 (let ((company-continue-commands '(not backward-delete-char)))
290 (company-call 'backward-delete-char 1)
291 (should (null company-candidates-length)))
292 (let ((company-continue-commands '(not backward-delete-char-untabify)))
295 (company-call 'backward-delete-char 1)
296 (should (eq 2 company-candidates-length))))))
298 (ert-deftest company-auto-complete-explicit ()
302 (let (company-frontends
303 (company-auto-complete 'company-explicit-action-p)
304 (company-auto-complete-chars '(? ))
306 (list (lambda (command &optional _)
308 (prefix (buffer-substring (point-min) (point)))
309 (candidates '("abcd" "abef")))))))
312 (let ((last-command-event ? ))
313 (company-call 'self-insert-command 1))
314 (should (string= "abcd " (buffer-string))))))
316 (ert-deftest company-no-auto-complete-when-idle ()
320 (let (company-frontends
321 (company-auto-complete 'company-explicit-action-p)
322 (company-auto-complete-chars '(? ))
323 (company-minimum-prefix-length 2)
325 (list (lambda (command &optional _)
327 (prefix (buffer-substring (point-min) (point)))
328 (candidates '("abcd" "abef")))))))
329 (company-idle-begin (current-buffer) (selected-window)
330 (buffer-chars-modified-tick) (point))
331 (let ((last-command-event ? ))
332 (company-call 'self-insert-command 1))
333 (should (string= "ab " (buffer-string))))))
335 (ert-deftest company-clears-explicit-action-when-no-matches ()
338 (let (company-frontends
340 (company-call 'manual-begin) ;; fails
341 (should (null company-candidates))
342 (should (null (company-explicit-action-p))))))
344 (ert-deftest company-ignore-case-replaces-prefix ()
347 (let (company-frontends
349 (list (lambda (command &optional _)
351 (prefix (buffer-substring (point-min) (point)))
352 (candidates '("abcd" "abef"))
357 (should (string= "ab" (buffer-string)))
359 (insert "A") ; hack, to keep it in one test
360 (company-complete-selection)
361 (should (string= "abcd" (buffer-string))))))
363 (ert-deftest company-ignore-case-with-keep-prefix ()
367 (let (company-frontends
369 (list (lambda (command &optional _)
371 (prefix (buffer-substring (point-min) (point)))
372 (candidates '("abcd" "abef"))
373 (ignore-case 'keep-prefix))))))
376 (company-complete-selection)
377 (should (string= "ABcd" (buffer-string))))))
379 (ert-deftest company-non-prefix-completion ()
383 (let (company-frontends
385 (list (lambda (command &optional _)
387 (prefix (buffer-substring (point-min) (point)))
388 (candidates '("tea-cup" "teal-color")))))))
391 (should (string= "tc" (buffer-string)))
392 (company-complete-selection)
393 (should (string= "tea-cup" (buffer-string))))))
395 (defvar ct-sorted nil)
397 (defun ct-equal-including-properties (list1 list2)
398 (or (and (not list1) (not list2))
399 (and (ert-equal-including-properties (car list1) (car list2))
400 (ct-equal-including-properties (cdr list1) (cdr list2)))))
402 (ert-deftest company-strips-duplicates-within-groups ()
403 (let* ((kvs '(("a" . "b")
412 (mapcar (lambda (kv) (propertize (car kv) 'ann (cdr kv)))
415 (lambda (command &optional arg)
420 (`annotation (get-text-property 0 'ann arg)))))
421 (reference '(("a" . "b")
428 (should (ct-equal-including-properties
429 (company--preprocess-candidates (funcall fn kvs))
430 (funcall fn reference))))
431 (should (ct-equal-including-properties
432 (company--preprocess-candidates (funcall fn kvs))
433 (funcall fn (butlast reference))))))
437 (ert-deftest company-column-with-composition ()
440 (save-window-excursion
441 (set-window-buffer nil (current-buffer))
443 (compose-region 1 (1+ (length "lambda")) "\\")
444 (should (= (company--column) 4)))))
446 (ert-deftest company-column-with-line-prefix ()
449 (save-window-excursion
450 (set-window-buffer nil (current-buffer))
452 (put-text-property (point-min) (point) 'line-prefix " ")
453 (should (= (company--column) 5)))))
455 (ert-deftest company-column-with-line-prefix-on-empty-line ()
458 (save-window-excursion
459 (set-window-buffer nil (current-buffer))
462 (put-text-property (point-min) (point-max) 'line-prefix " ")
463 (should (= (company--column) 2)))))
465 (ert-deftest company-column-with-tabs ()
468 (save-window-excursion
469 (set-window-buffer nil (current-buffer))
470 (insert "|\t|\t|\t(")
472 (should (= (company--column) 25))))))
474 (ert-deftest company-row-with-header-line-format ()
477 (save-window-excursion
478 (set-window-buffer nil (current-buffer))
479 (should (= (company--row) 0))
480 (setq header-line-format "aaaaaaa")
481 (should (= (company--row) 0)))))