1 ;;; company-tests.el --- company-mode tests -*- lexical-binding: t -*-
3 ;; Copyright (C) 2011, 2013-2014 Free Software Foundation, Inc.
5 ;; Author: Nikolaj Schumacher
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/>.
28 (eval-when-compile (require 'cl))
31 (require 'company-keywords)
32 (require 'company-clang)
36 (ert-deftest company-sorted-keywords ()
37 "Test that keywords in `company-keywords-alist' are in alphabetical order."
38 (dolist (pair company-keywords-alist)
39 (when (consp (cdr pair))
40 (let ((prev (cadr pair)))
41 (dolist (next (cddr pair))
42 (should (not (equal prev next)))
43 (should (string< prev next))
46 (ert-deftest company-good-prefix ()
47 (let ((company-minimum-prefix-length 5)
48 company-abort-manual-when-too-short
49 company--manual-action ;idle begin
50 (company-selection-changed t)) ;has no effect
51 (should (eq t (company--good-prefix-p "!@#$%")))
52 (should (eq nil (company--good-prefix-p "abcd")))
53 (should (eq nil (company--good-prefix-p 'stop)))
54 (should (eq t (company--good-prefix-p '("foo" . 5))))
55 (should (eq nil (company--good-prefix-p '("foo" . 4))))
56 (should (eq t (company--good-prefix-p '("foo" . t))))))
58 (ert-deftest company--manual-prefix-set-and-unset ()
62 (let (company-frontends
64 (list (lambda (command &optional arg)
66 (prefix (buffer-substring (point-min) (point)))
67 (candidates '("abc" "abd")))))))
68 (company-manual-begin)
69 (should (equal "ab" company--manual-prefix))
71 (should (null company--manual-prefix)))))
73 (ert-deftest company-abort-manual-when-too-short ()
74 (let ((company-minimum-prefix-length 5)
75 (company-abort-manual-when-too-short t)
76 (company-selection-changed t)) ;has not effect
77 (let ((company--manual-action nil)) ;idle begin
78 (should (eq t (company--good-prefix-p "!@#$%")))
79 (should (eq t (company--good-prefix-p '("foo" . 5))))
80 (should (eq t (company--good-prefix-p '("foo" . t)))))
81 (let ((company--manual-action t)
82 (company--manual-prefix "abc")) ;manual begin from this prefix
83 (should (eq t (company--good-prefix-p "!@#$")))
84 (should (eq nil (company--good-prefix-p "ab")))
85 (should (eq nil (company--good-prefix-p 'stop)))
86 (should (eq t (company--good-prefix-p '("foo" . 4))))
87 (should (eq t (company--good-prefix-p "abcd")))
88 (should (eq t (company--good-prefix-p "abc")))
89 (should (eq t (company--good-prefix-p '("bar" . t)))))))
91 (ert-deftest company-multi-backend-with-lambdas ()
92 (let ((company-backend
93 (list (lambda (command &optional arg &rest ignore)
96 (candidates '("a" "b"))))
97 (lambda (command &optional arg &rest ignore)
100 (candidates '("c" "d")))))))
101 (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" "d")))))
103 (ert-deftest company-multi-backend-remembers-candidate-backend ()
104 (let ((company-backend
105 (list (lambda (command &optional arg)
109 (candidates '("a" "c"))
110 (post-completion "13")))
111 (lambda (command &optional arg)
115 (candidates '("b" "d"))
116 (post-completion "42")))
117 (lambda (command &optional arg)
121 (post-completion "74"))))))
122 (let ((candidates (company-calculate-candidates nil)))
123 (should (equal candidates '("a" "b" "c" "d" "e")))
124 (should (equal t (company-call-backend 'ignore-case)))
125 (should (equal "1" (company-call-backend 'annotation (nth 0 candidates))))
126 (should (equal "2" (company-call-backend 'annotation (nth 1 candidates))))
127 (should (equal "13" (company-call-backend 'post-completion (nth 2 candidates))))
128 (should (equal "42" (company-call-backend 'post-completion (nth 3 candidates))))
129 (should (equal "3" (company-call-backend 'annotation (nth 4 candidates))))
130 (should (equal "74" (company-call-backend 'post-completion (nth 4 candidates)))))))
132 (ert-deftest company-multi-backend-handles-keyword-with ()
133 (let ((primo (lambda (command &optional arg)
136 (candidates '("abb" "abc" "abd")))))
137 (secundo (lambda (command &optional arg)
140 (candidates '("acc" "acd"))))))
141 (let ((company-backend (list 'ignore 'ignore :with secundo)))
142 (should (null (company-call-backend 'prefix))))
143 (let ((company-backend (list 'ignore primo :with secundo)))
144 (should (equal "a" (company-call-backend 'prefix)))
145 (should (equal '("abb" "abc" "abd" "acc" "acd")
146 (company-call-backend 'candidates "a"))))))
148 (ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
153 (company-begin-backend (lambda (command &rest ignore))))
154 (let (company-frontends
156 (list (lambda (command &optional arg)
159 (candidates '("a" "ab" "ac")))))))
161 (company-call 'complete))
162 (should (eq 3 company-candidates-length)))))
164 (ert-deftest company-require-match-explicit ()
168 (let (company-frontends
169 (company-require-match 'company-explicit-action-p)
171 (list (lambda (command &optional arg)
173 (prefix (buffer-substring (point-min) (point)))
174 (candidates '("abc" "abd")))))))
177 (let ((last-command-event ?e))
178 (company-call 'self-insert-command 1))
179 (should (eq 2 company-candidates-length))
180 (should (eq 3 (point))))))
182 (ert-deftest company-dont-require-match-when-idle ()
186 (let (company-frontends
187 (company-require-match 'company-explicit-action-p)
189 (list (lambda (command &optional arg)
191 (prefix (buffer-substring (point-min) (point)))
192 (candidates '("abc" "abd")))))))
193 (company-idle-begin (current-buffer) (selected-window)
194 (buffer-chars-modified-tick) (point))
195 (let ((last-command-event ?e))
196 (company-call 'self-insert-command 1))
197 (should (eq nil company-candidates-length))
198 (should (eq 4 (point))))))
200 (ert-deftest company-should-complete-whitelist ()
204 (let (company-frontends
205 company-begin-commands
207 (list (lambda (command &optional arg)
209 (prefix (buffer-substring (point-min) (point)))
210 (candidates '("abc" "abd")))))))
211 (let ((company-continue-commands nil))
214 (company-call 'backward-delete-char 1)
215 (should (null company-candidates-length)))
216 (let ((company-continue-commands '(backward-delete-char)))
219 (company-call 'backward-delete-char 1)
220 (should (eq 2 company-candidates-length))))))
222 (ert-deftest company-should-complete-blacklist ()
226 (let (company-frontends
227 company-begin-commands
229 (list (lambda (command &optional arg)
231 (prefix (buffer-substring (point-min) (point)))
232 (candidates '("abc" "abd")))))))
233 (let ((company-continue-commands '(not backward-delete-char)))
236 (company-call 'backward-delete-char 1)
237 (should (null company-candidates-length)))
238 (let ((company-continue-commands '(not backward-delete-char-untabify)))
241 (company-call 'backward-delete-char 1)
242 (should (eq 2 company-candidates-length))))))
244 (ert-deftest company-auto-complete-explicit ()
248 (let (company-frontends
249 (company-auto-complete 'company-explicit-action-p)
250 (company-auto-complete-chars '(? ))
252 (list (lambda (command &optional arg)
254 (prefix (buffer-substring (point-min) (point)))
255 (candidates '("abcd" "abef")))))))
258 (let ((last-command-event ? ))
259 (company-call 'self-insert-command 1))
260 (should (string= "abcd " (buffer-string))))))
262 (ert-deftest company-no-auto-complete-when-idle ()
266 (let (company-frontends
267 (company-auto-complete 'company-explicit-action-p)
268 (company-auto-complete-chars '(? ))
270 (list (lambda (command &optional arg)
272 (prefix (buffer-substring (point-min) (point)))
273 (candidates '("abcd" "abef")))))))
274 (company-idle-begin (current-buffer) (selected-window)
275 (buffer-chars-modified-tick) (point))
276 (let ((last-command-event ? ))
277 (company-call 'self-insert-command 1))
278 (should (string= "ab " (buffer-string))))))
280 (ert-deftest company-clears-explicit-action-when-no-matches ()
283 (let (company-frontends
285 (company-call 'manual-begin) ;; fails
286 (should (null company-candidates))
287 (should (null (company-explicit-action-p))))))
289 (ert-deftest company-ignore-case-replaces-prefix ()
292 (let (company-frontends
293 company-end-of-buffer-workaround
295 (list (lambda (command &optional arg)
297 (prefix (buffer-substring (point-min) (point)))
298 (candidates '("abcd" "abef"))
303 (should (string= "ab" (buffer-string)))
305 (insert "A") ; hack, to keep it in one test
306 (company-complete-selection)
307 (should (string= "abcd" (buffer-string))))))
309 (ert-deftest company-ignore-case-with-keep-prefix ()
313 (let (company-frontends
315 (list (lambda (command &optional arg)
317 (prefix (buffer-substring (point-min) (point)))
318 (candidates '("abcd" "abef"))
319 (ignore-case 'keep-prefix))))))
322 (company-complete-selection)
323 (should (string= "ABcd" (buffer-string))))))
325 (ert-deftest company-non-prefix-completion ()
329 (let (company-frontends
330 company-end-of-buffer-workaround
332 (list (lambda (command &optional arg)
334 (prefix (buffer-substring (point-min) (point)))
335 (candidates '("tea-cup" "teal-color")))))))
338 (should (string= "tc" (buffer-string)))
339 (company-complete-selection)
340 (should (string= "tea-cup" (buffer-string))))))
342 (ert-deftest company-pseudo-tooltip-does-not-get-displaced ()
345 (save-window-excursion
346 (set-window-buffer nil (current-buffer))
347 (save-excursion (insert " ff"))
349 (let ((company-frontends '(company-pseudo-tooltip-frontend))
350 (company-begin-commands '(self-insert-command))
352 (list (lambda (c &optional arg)
353 (case c (prefix "") (candidates '("a" "b" "c")))))))
355 (company-call 'complete))
356 (company-call 'open-line 1)
357 (should (eq 2 (overlay-start company-pseudo-tooltip-overlay)))))))
359 (ert-deftest company-pseudo-tooltip-show ()
362 (save-window-excursion
363 (set-window-buffer nil (current-buffer))
364 (insert "aaaa\n bb\nccccccc\nddd")
365 (search-backward "bb")
366 (let ((col (company--column))
367 (company-candidates-length 2)
368 (company-candidates '("123" "45"))
369 (company-backend 'ignore))
370 (company-pseudo-tooltip-show (company--row) col 0)
371 (let ((ov company-pseudo-tooltip-overlay))
373 (should (eq (overlay-get ov 'company-width) 5))
375 (should (eq (overlay-get ov 'company-height) company-tooltip-limit))
376 (should (eq (overlay-get ov 'company-column) col))
377 (should (string= (overlay-get ov 'company-after)
378 " 123 \nc 45 c\nddd\n")))))))
380 (ert-deftest company-preview-show-with-annotations ()
383 (save-window-excursion
384 (set-window-buffer nil (current-buffer))
385 (save-excursion (insert "\n"))
386 (let ((company-candidates-length 1)
387 (company-candidates '("123")))
388 (company-preview-show-at-point (point))
389 (let ((ov company-preview-overlay))
390 (should (string= (overlay-get ov 'display) "123\n")))))))
392 (ert-deftest company-pseudo-tooltip-show-with-annotations ()
395 (save-window-excursion
396 (set-window-buffer nil (current-buffer))
398 (save-excursion (insert "\n"))
399 (let ((company-candidates-length 2)
400 (company-backend (lambda (action &optional arg &rest _ignore)
401 (when (eq action 'annotation)
402 (cdr (assoc arg '(("123" . "(4)")))))))
403 (company-candidates '("123" "45"))
404 company-tooltip-align-annotations)
405 (company-pseudo-tooltip-show-at-point (point))
406 (let ((ov company-pseudo-tooltip-overlay))
408 (should (eq (overlay-get ov 'company-width) 8))
409 (should (string= (overlay-get ov 'company-after)
410 " 123(4) \n 45 \n")))))))
412 (ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned ()
415 (save-window-excursion
416 (set-window-buffer nil (current-buffer))
418 (save-excursion (insert "\n"))
419 (let ((company-candidates-length 3)
420 (company-backend (lambda (action &optional arg &rest _ignore)
421 (when (eq action 'annotation)
422 (cdr (assoc arg '(("123" . "(4)")
423 ("67" . "(891011)")))))))
424 (company-candidates '("123" "45" "67"))
425 (company-tooltip-align-annotations t))
426 (company-pseudo-tooltip-show-at-point (point))
427 (let ((ov company-pseudo-tooltip-overlay))
429 (should (eq (overlay-get ov 'company-width) 13))
430 (should (string= (overlay-get ov 'company-after)
431 " 123 (4) \n 45 \n 67 (891011) \n")))))))
433 (ert-deftest company-create-lines-shows-numbers ()
434 (let ((company-show-numbers t)
435 (company-candidates '("x" "y" "z"))
436 (company-candidates-length 3)
437 (company-backend 'ignore))
438 (should (equal '(" x 1 " " y 2 " " z 3 ")
439 (company--create-lines 0 999)))))
441 (ert-deftest company-create-lines-truncates-annotations ()
442 (let* ((ww (company--window-width))
443 (data `(("1" . "(123)")
445 ("3" . ,(concat "(" (make-string (- ww 2) ?4) ")"))
446 (,(make-string ww ?4) . "<4>")))
447 (company-candidates (mapcar #'car data))
448 (company-candidates-length 4)
449 (company-tooltip-margin 1)
450 (company-backend (lambda (cmd &optional arg)
451 (when (eq cmd 'annotation)
452 (cdr (assoc arg data)))))
453 company-tooltip-align-annotations)
454 (should (equal (list (format " 1(123)%s " (company-space-string (- ww 8)))
455 (format " 2%s " (company-space-string (- ww 3)))
456 (format " 3(444%s " (make-string (- ww 7) ?4))
457 (format " %s " (make-string (- ww 2) ?4)))
458 (company--create-lines 0 999)))
459 (let ((company-tooltip-align-annotations t))
460 (should (equal (list (format " 1%s(123) " (company-space-string (- ww 8)))
461 (format " 2%s " (company-space-string (- ww 3)))
462 (format " 3 (444%s " (make-string (- ww 8) ?4))
463 (format " %s " (make-string (- ww 2) ?4)))
464 (company--create-lines 0 999))))))
466 (ert-deftest company-column-with-composition ()
469 (compose-region 1 (1+ (length "lambda")) "\\")
470 (should (= (company--column) 4))))
472 (ert-deftest company-column-with-line-prefix ()
475 (put-text-property (point-min) (point) 'line-prefix " ")
476 (should (= (company--column) 5))))
478 (ert-deftest company-column-wth-line-prefix-on-empty-line ()
482 (put-text-property (point-min) (point-max) 'line-prefix " ")
483 (should (= (company--column) 2))))
485 (ert-deftest company-plainify ()
487 (should (equal-including-properties
488 (company-plainify "\tabc\td\t")
492 (should (equal-including-properties
493 (company-plainify (propertize "foobar" 'line-prefix "-*-"))
496 (ert-deftest company-modify-line ()
497 (let ((str "-*-foobar"))
498 (should (equal-including-properties
499 (company-modify-line str "zz" 4)
501 (should (equal-including-properties
502 (company-modify-line str "xx" 0)
504 (should (equal-including-properties
505 (company-modify-line str "zz" 10)
508 (ert-deftest company-scrollbar-bounds ()
509 (should (equal nil (company--scrollbar-bounds 0 3 3)))
510 (should (equal nil (company--scrollbar-bounds 0 4 3)))
511 (should (equal '(0 . 0) (company--scrollbar-bounds 0 1 2)))
512 (should (equal '(1 . 1) (company--scrollbar-bounds 2 2 4)))
513 (should (equal '(2 . 3) (company--scrollbar-bounds 7 4 12)))
514 (should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12)))
515 (should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11))))
519 (defun company-async-backend (command &optional arg)
525 (run-with-timer 0.05 nil
526 #'funcall cb '("abc" "abd")))))))
528 (ert-deftest company-call-backend-forces-sync ()
529 (let ((company-backend 'company-async-backend)
530 (company-async-timeout 0.1))
531 (should (equal '("abc" "abd") (company-call-backend 'candidates)))))
533 (ert-deftest company-call-backend-errors-on-timeout ()
535 (let* ((company-backend (lambda (command &optional _arg)
537 (`candidates (cons :async 'ignore)))))
538 (company-async-timeout 0.1)
539 (err (should-error (company-call-backend 'candidates "foo"))))
540 (should (string-match-p "async timeout" (cadr err))))))
542 (ert-deftest company-call-backend-raw-passes-return-value-verbatim ()
543 (let ((company-backend 'company-async-backend))
544 (should (equal "foo" (company-call-backend-raw 'prefix)))
545 (should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
546 (should (equal 'closure (cadr (company-call-backend-raw 'candidates "foo"))))))
548 (ert-deftest company-manual-begin-forces-async-candidates-to-sync ()
551 (let (company-frontends
552 (company-backends (list 'company-async-backend)))
553 (company-manual-begin)
554 (should (equal "foo" company-prefix))
555 (should (equal '("abc" "abd") company-candidates)))))
557 (ert-deftest company-idle-begin-allows-async-candidates ()
560 (let (company-frontends
561 (company-backends (list 'company-async-backend)))
562 (company-idle-begin (current-buffer) (selected-window)
563 (buffer-chars-modified-tick) (point))
564 (should (null company-candidates))
566 (should (equal "foo" company-prefix))
567 (should (equal '("abc" "abd") company-candidates)))))
569 (ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed ()
572 (let (company-frontends
573 (company-backends (list 'company-async-backend)))
574 (company-idle-begin (current-buffer) (selected-window)
575 (buffer-chars-modified-tick) (point))
576 (should (null company-candidates))
579 (should (null company-prefix))
580 (should (null company-candidates)))))
582 (ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
585 (let (company-frontends
587 (list (lambda (command &optional arg)
589 (`prefix (buffer-substring (point-min) (point)))
591 (let ((c (all-completions arg '("abc" "def"))))
593 (lambda (cb) (funcall cb c)))))
595 (company-minimum-prefix-length 0))
596 (company-idle-begin (current-buffer) (selected-window)
597 (buffer-chars-modified-tick) (point))
598 (should (equal '("abc" "def") company-candidates))
599 (let ((last-command-event ?a))
600 (company-call 'self-insert-command 1))
601 (should (equal '("abc") company-candidates)))))
603 (ert-deftest company-multi-backend-forces-prefix-to-sync ()
605 (let ((company-backend (list 'ignore
607 (should (eq command 'prefix))
612 (lambda () (funcall cb nil))))))
614 (should (eq command 'prefix))
616 (should (equal "foo" (company-call-backend-raw 'prefix))))
617 (let ((company-backend (list (lambda (_command)
622 (lambda () (funcall cb "bar"))))))
625 (should (equal "bar" (company-call-backend-raw 'prefix))))))
627 (ert-deftest company-multi-backend-merges-deferred-candidates ()
629 (let* ((immediate (lambda (command &optional arg)
634 (lambda (cb) (funcall cb '("f"))))))))
635 (company-backend (list 'ignore
636 (lambda (command &optional arg)
640 (should (equal arg "foo"))
645 (lambda () (funcall cb '("a" "b")))))))))
646 (lambda (command &optional arg)
649 (`candidates '("c" "d" "e"))))
651 (should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
652 (should (equal '("a" "b" "c" "d" "e" "f")
653 (company-call-backend 'candidates "foo")))
654 (let ((company-backend (list immediate)))
655 (should (equal '("f") (company-call-backend 'candidates "foo")))))))
659 (ert-deftest company-template-removed-after-the-last-jump ()
663 (let ((tpl (company-template-declare-template (point) (1- (point-max)))))
667 (company-template-add-field tpl (point) "foo")))
668 (company-call 'template-forward-field)
669 (should (= 3 (point)))
670 (company-call 'template-forward-field)
671 (should (= 7 (point)))
672 (company-call 'template-forward-field)
673 (should (= 11 (point)))
674 (should (zerop (length (overlay-get tpl 'company-template-fields))))
675 (should (null (overlay-buffer tpl))))))
677 (ert-deftest company-template-removed-after-input-and-jump ()
681 (let ((tpl (company-template-declare-template (point) (1- (point-max)))))
684 (company-template-add-field tpl (point) "bar"))
685 (company-call 'template-move-to-first tpl)
686 (should (= 3 (point)))
687 (dolist (c (string-to-list "tee"))
688 (let ((last-command-event c))
689 (company-call 'self-insert-command 1)))
690 (should (string= "{ tee }" (buffer-string)))
691 (should (overlay-buffer tpl))
692 (company-call 'template-forward-field)
693 (should (= 7 (point)))
694 (should (null (overlay-buffer tpl))))))
696 (defun company-call (name &rest args)
697 (let* ((maybe (intern (format "company-%s" name)))
698 (command (if (fboundp maybe) maybe name)))
699 (let ((this-command command))
700 (run-hooks 'pre-command-hook))
702 (let ((this-command command))
703 (run-hooks 'post-command-hook))))
705 (ert-deftest company-template-c-like-templatify ()
707 (let ((text "foo(int a, short b)"))
709 (company-template-c-like-templatify text)
710 (should (equal "foo(arg0, arg1)" (buffer-string)))
711 (should (looking-at "arg0"))
712 (should (equal "int a"
713 (overlay-get (company-template-field-at) 'display))))))
715 (ert-deftest company-template-c-like-templatify-trims-after-closing-paren ()
717 (let ((text "foo(int a, short b)!@ #1334 a"))
719 (company-template-c-like-templatify text)
720 (should (equal "foo(arg0, arg1)" (buffer-string)))
721 (should (looking-at "arg0")))))
725 (ert-deftest company-clang-objc-templatify ()
727 (let ((text "createBookWithTitle:andAuthor:"))
729 (company-clang-objc-templatify text)
730 (should (equal "createBookWithTitle:arg0 andAuthor:arg1" (buffer-string)))
731 (should (looking-at "arg0"))
732 (should (null (overlay-get (company-template-field-at) 'display))))))