]> code.delx.au - gnu-emacs-elpa/blob - company-tests.el
company-pseudo-tooltip-edit: update company-width
[gnu-emacs-elpa] / company-tests.el
1 ;;; company-tests.el --- company-mode tests -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2011, 2013-2014 Free Software Foundation, Inc.
4
5 ;; Author: Nikolaj Schumacher
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
23 ;;; Commentary:
24 ;;
25
26 ;;; Code:
27
28 (require 'ert)
29 (require 'company)
30 (require 'company-keywords)
31 (require 'company-clang)
32
33 ;;; Core
34
35 (ert-deftest company-sorted-keywords ()
36 "Test that keywords in `company-keywords-alist' are in alphabetical order."
37 (dolist (pair company-keywords-alist)
38 (when (consp (cdr pair))
39 (let ((prev (cadr pair)))
40 (dolist (next (cddr pair))
41 (should (not (equal prev next)))
42 (should (string< prev next))
43 (setq prev next))))))
44
45 (ert-deftest company-good-prefix ()
46 (let ((company-minimum-prefix-length 5)
47 company-abort-manual-when-too-short
48 company--manual-action ;idle begin
49 (company-selection-changed t)) ;has no effect
50 (should (eq t (company--good-prefix-p "!@#$%")))
51 (should (eq nil (company--good-prefix-p "abcd")))
52 (should (eq nil (company--good-prefix-p 'stop)))
53 (should (eq t (company--good-prefix-p '("foo" . 5))))
54 (should (eq nil (company--good-prefix-p '("foo" . 4))))
55 (should (eq t (company--good-prefix-p '("foo" . t))))))
56
57 (ert-deftest company--manual-prefix-set-and-unset ()
58 (with-temp-buffer
59 (insert "ab")
60 (company-mode)
61 (let (company-frontends
62 (company-backends
63 (list (lambda (command &optional arg)
64 (cl-case command
65 (prefix (buffer-substring (point-min) (point)))
66 (candidates '("abc" "abd")))))))
67 (company-manual-begin)
68 (should (equal "ab" company--manual-prefix))
69 (company-abort)
70 (should (null company--manual-prefix)))))
71
72 (ert-deftest company-abort-manual-when-too-short ()
73 (let ((company-minimum-prefix-length 5)
74 (company-abort-manual-when-too-short t)
75 (company-selection-changed t)) ;has not effect
76 (let ((company--manual-action nil)) ;idle begin
77 (should (eq t (company--good-prefix-p "!@#$%")))
78 (should (eq t (company--good-prefix-p '("foo" . 5))))
79 (should (eq t (company--good-prefix-p '("foo" . t)))))
80 (let ((company--manual-action t)
81 (company--manual-prefix "abc")) ;manual begin from this prefix
82 (should (eq t (company--good-prefix-p "!@#$")))
83 (should (eq nil (company--good-prefix-p "ab")))
84 (should (eq nil (company--good-prefix-p 'stop)))
85 (should (eq t (company--good-prefix-p '("foo" . 4))))
86 (should (eq t (company--good-prefix-p "abcd")))
87 (should (eq t (company--good-prefix-p "abc")))
88 (should (eq t (company--good-prefix-p '("bar" . t)))))))
89
90 (ert-deftest company-multi-backend-with-lambdas ()
91 (let ((company-backend
92 (list (lambda (command &optional arg &rest ignore)
93 (cl-case command
94 (prefix "z")
95 (candidates '("a" "b"))))
96 (lambda (command &optional arg &rest ignore)
97 (cl-case command
98 (prefix "z")
99 (candidates '("c" "d")))))))
100 (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" "d")))))
101
102 (ert-deftest company-multi-backend-filters-backends-by-prefix ()
103 (let ((company-backend
104 (list (lambda (command &optional arg &rest ignore)
105 (cl-case command
106 (prefix (cons "z" t))
107 (candidates '("a" "b"))))
108 (lambda (command &optional arg &rest ignore)
109 (cl-case command
110 (prefix "t")
111 (candidates '("c" "d"))))
112 (lambda (command &optional arg &rest ignore)
113 (cl-case command
114 (prefix "z")
115 (candidates '("e" "f")))))))
116 (should (equal (company-call-backend 'candidates "z") '("a" "b" "e" "f")))))
117
118 (ert-deftest company-multi-backend-remembers-candidate-backend ()
119 (let ((company-backend
120 (list (lambda (command &optional arg)
121 (cl-case command
122 (ignore-case nil)
123 (annotation "1")
124 (candidates '("a" "c"))
125 (post-completion "13")))
126 (lambda (command &optional arg)
127 (cl-case command
128 (ignore-case t)
129 (annotation "2")
130 (candidates '("b" "d"))
131 (post-completion "42")))
132 (lambda (command &optional arg)
133 (cl-case command
134 (annotation "3")
135 (candidates '("e"))
136 (post-completion "74"))))))
137 (let ((candidates (company-calculate-candidates nil)))
138 (should (equal candidates '("a" "b" "c" "d" "e")))
139 (should (equal t (company-call-backend 'ignore-case)))
140 (should (equal "1" (company-call-backend 'annotation (nth 0 candidates))))
141 (should (equal "2" (company-call-backend 'annotation (nth 1 candidates))))
142 (should (equal "13" (company-call-backend 'post-completion (nth 2 candidates))))
143 (should (equal "42" (company-call-backend 'post-completion (nth 3 candidates))))
144 (should (equal "3" (company-call-backend 'annotation (nth 4 candidates))))
145 (should (equal "74" (company-call-backend 'post-completion (nth 4 candidates)))))))
146
147 (ert-deftest company-multi-backend-handles-keyword-with ()
148 (let ((primo (lambda (command &optional arg)
149 (cl-case command
150 (prefix "a")
151 (candidates '("abb" "abc" "abd")))))
152 (secundo (lambda (command &optional arg)
153 (cl-case command
154 (prefix "a")
155 (candidates '("acc" "acd"))))))
156 (let ((company-backend (list 'ignore 'ignore :with secundo)))
157 (should (null (company-call-backend 'prefix))))
158 (let ((company-backend (list 'ignore primo :with secundo)))
159 (should (equal "a" (company-call-backend 'prefix)))
160 (should (equal '("abb" "abc" "abd" "acc" "acd")
161 (company-call-backend 'candidates "a"))))))
162
163 (ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
164 (with-temp-buffer
165 (insert "a")
166 (company-mode)
167 (should-error
168 (company-begin-backend (lambda (command &rest ignore))))
169 (let (company-frontends
170 (company-backends
171 (list (lambda (command &optional arg)
172 (cl-case command
173 (prefix "a")
174 (candidates '("a" "ab" "ac")))))))
175 (let (this-command)
176 (company-call 'complete))
177 (should (eq 3 company-candidates-length)))))
178
179 (ert-deftest company-require-match-explicit ()
180 (with-temp-buffer
181 (insert "ab")
182 (company-mode)
183 (let (company-frontends
184 (company-require-match 'company-explicit-action-p)
185 (company-backends
186 (list (lambda (command &optional arg)
187 (cl-case command
188 (prefix (buffer-substring (point-min) (point)))
189 (candidates '("abc" "abd")))))))
190 (let (this-command)
191 (company-complete))
192 (let ((last-command-event ?e))
193 (company-call 'self-insert-command 1))
194 (should (eq 2 company-candidates-length))
195 (should (eq 3 (point))))))
196
197 (ert-deftest company-dont-require-match-when-idle ()
198 (with-temp-buffer
199 (insert "ab")
200 (company-mode)
201 (let (company-frontends
202 (company-require-match 'company-explicit-action-p)
203 (company-backends
204 (list (lambda (command &optional arg)
205 (cl-case command
206 (prefix (buffer-substring (point-min) (point)))
207 (candidates '("abc" "abd")))))))
208 (company-idle-begin (current-buffer) (selected-window)
209 (buffer-chars-modified-tick) (point))
210 (let ((last-command-event ?e))
211 (company-call 'self-insert-command 1))
212 (should (eq nil company-candidates-length))
213 (should (eq 4 (point))))))
214
215 (ert-deftest company-should-complete-whitelist ()
216 (with-temp-buffer
217 (insert "ab")
218 (company-mode)
219 (let (company-frontends
220 company-begin-commands
221 (company-backends
222 (list (lambda (command &optional arg)
223 (cl-case command
224 (prefix (buffer-substring (point-min) (point)))
225 (candidates '("abc" "abd")))))))
226 (let ((company-continue-commands nil))
227 (let (this-command)
228 (company-complete))
229 (company-call 'backward-delete-char 1)
230 (should (null company-candidates-length)))
231 (let ((company-continue-commands '(backward-delete-char)))
232 (let (this-command)
233 (company-complete))
234 (company-call 'backward-delete-char 1)
235 (should (eq 2 company-candidates-length))))))
236
237 (ert-deftest company-should-complete-blacklist ()
238 (with-temp-buffer
239 (insert "ab")
240 (company-mode)
241 (let (company-frontends
242 company-begin-commands
243 (company-backends
244 (list (lambda (command &optional arg)
245 (cl-case command
246 (prefix (buffer-substring (point-min) (point)))
247 (candidates '("abc" "abd")))))))
248 (let ((company-continue-commands '(not backward-delete-char)))
249 (let (this-command)
250 (company-complete))
251 (company-call 'backward-delete-char 1)
252 (should (null company-candidates-length)))
253 (let ((company-continue-commands '(not backward-delete-char-untabify)))
254 (let (this-command)
255 (company-complete))
256 (company-call 'backward-delete-char 1)
257 (should (eq 2 company-candidates-length))))))
258
259 (ert-deftest company-auto-complete-explicit ()
260 (with-temp-buffer
261 (insert "ab")
262 (company-mode)
263 (let (company-frontends
264 (company-auto-complete 'company-explicit-action-p)
265 (company-auto-complete-chars '(? ))
266 (company-backends
267 (list (lambda (command &optional arg)
268 (cl-case command
269 (prefix (buffer-substring (point-min) (point)))
270 (candidates '("abcd" "abef")))))))
271 (let (this-command)
272 (company-complete))
273 (let ((last-command-event ? ))
274 (company-call 'self-insert-command 1))
275 (should (string= "abcd " (buffer-string))))))
276
277 (ert-deftest company-no-auto-complete-when-idle ()
278 (with-temp-buffer
279 (insert "ab")
280 (company-mode)
281 (let (company-frontends
282 (company-auto-complete 'company-explicit-action-p)
283 (company-auto-complete-chars '(? ))
284 (company-backends
285 (list (lambda (command &optional arg)
286 (cl-case command
287 (prefix (buffer-substring (point-min) (point)))
288 (candidates '("abcd" "abef")))))))
289 (company-idle-begin (current-buffer) (selected-window)
290 (buffer-chars-modified-tick) (point))
291 (let ((last-command-event ? ))
292 (company-call 'self-insert-command 1))
293 (should (string= "ab " (buffer-string))))))
294
295 (ert-deftest company-clears-explicit-action-when-no-matches ()
296 (with-temp-buffer
297 (company-mode)
298 (let (company-frontends
299 company-backends)
300 (company-call 'manual-begin) ;; fails
301 (should (null company-candidates))
302 (should (null (company-explicit-action-p))))))
303
304 (ert-deftest company-ignore-case-replaces-prefix ()
305 (with-temp-buffer
306 (company-mode)
307 (let (company-frontends
308 company-end-of-buffer-workaround
309 (company-backends
310 (list (lambda (command &optional arg)
311 (cl-case command
312 (prefix (buffer-substring (point-min) (point)))
313 (candidates '("abcd" "abef"))
314 (ignore-case t))))))
315 (insert "A")
316 (let (this-command)
317 (company-complete))
318 (should (string= "ab" (buffer-string)))
319 (delete-char -2)
320 (insert "A") ; hack, to keep it in one test
321 (company-complete-selection)
322 (should (string= "abcd" (buffer-string))))))
323
324 (ert-deftest company-ignore-case-with-keep-prefix ()
325 (with-temp-buffer
326 (insert "AB")
327 (company-mode)
328 (let (company-frontends
329 (company-backends
330 (list (lambda (command &optional arg)
331 (cl-case command
332 (prefix (buffer-substring (point-min) (point)))
333 (candidates '("abcd" "abef"))
334 (ignore-case 'keep-prefix))))))
335 (let (this-command)
336 (company-complete))
337 (company-complete-selection)
338 (should (string= "ABcd" (buffer-string))))))
339
340 (ert-deftest company-non-prefix-completion ()
341 (with-temp-buffer
342 (insert "tc")
343 (company-mode)
344 (let (company-frontends
345 company-end-of-buffer-workaround
346 (company-backends
347 (list (lambda (command &optional arg)
348 (cl-case command
349 (prefix (buffer-substring (point-min) (point)))
350 (candidates '("tea-cup" "teal-color")))))))
351 (let (this-command)
352 (company-complete))
353 (should (string= "tc" (buffer-string)))
354 (company-complete-selection)
355 (should (string= "tea-cup" (buffer-string))))))
356
357 (ert-deftest company-pseudo-tooltip-does-not-get-displaced ()
358 :tags '(interactive)
359 (with-temp-buffer
360 (save-window-excursion
361 (set-window-buffer nil (current-buffer))
362 (save-excursion (insert " ff"))
363 (company-mode)
364 (let ((company-frontends '(company-pseudo-tooltip-frontend))
365 (company-begin-commands '(self-insert-command))
366 (company-backends
367 (list (lambda (c &optional arg)
368 (cl-case c (prefix "") (candidates '("a" "b" "c")))))))
369 (let (this-command)
370 (company-call 'complete))
371 (company-call 'open-line 1)
372 (should (eq 2 (overlay-start company-pseudo-tooltip-overlay)))))))
373
374 (ert-deftest company-pseudo-tooltip-show ()
375 :tags '(interactive)
376 (with-temp-buffer
377 (save-window-excursion
378 (set-window-buffer nil (current-buffer))
379 (insert "aaaa\n bb\nccccccc\nddd")
380 (search-backward "bb")
381 (let ((col (company--column))
382 (company-candidates-length 2)
383 (company-candidates '("123" "45"))
384 (company-backend 'ignore))
385 (company-pseudo-tooltip-show (company--row) col 0)
386 (let ((ov company-pseudo-tooltip-overlay))
387 ;; With margins.
388 (should (eq (overlay-get ov 'company-width) 5))
389 ;; FIXME: Make it 2?
390 (should (eq (overlay-get ov 'company-height) company-tooltip-limit))
391 (should (eq (overlay-get ov 'company-column) col))
392 (should (string= (overlay-get ov 'company-after)
393 " 123 \nc 45 c\nddd\n")))))))
394
395 (ert-deftest company-pseudo-tooltip-edit-updates-width ()
396 :tags '(interactive)
397 (with-temp-buffer
398 (set-window-buffer nil (current-buffer))
399 (let ((company-candidates-length 5)
400 (company-candidates '("123" "45" "67" "89" "1011"))
401 (company-backend 'ignore)
402 (company-tooltip-limit 4)
403 (company-tooltip-offset-display 'scrollbar))
404 (company-pseudo-tooltip-show (company--row)
405 (company--column)
406 0)
407 (should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width)
408 6))
409 (company-pseudo-tooltip-edit 4)
410 (should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width)
411 7)))))
412
413 (ert-deftest company-preview-show-with-annotations ()
414 :tags '(interactive)
415 (with-temp-buffer
416 (save-window-excursion
417 (set-window-buffer nil (current-buffer))
418 (save-excursion (insert "\n"))
419 (let ((company-candidates-length 1)
420 (company-candidates '("123")))
421 (company-preview-show-at-point (point))
422 (let ((ov company-preview-overlay))
423 (should (string= (overlay-get ov 'display) "123\n")))))))
424
425 (ert-deftest company-pseudo-tooltip-show-with-annotations ()
426 :tags '(interactive)
427 (with-temp-buffer
428 (save-window-excursion
429 (set-window-buffer nil (current-buffer))
430 (insert " ")
431 (save-excursion (insert "\n"))
432 (let ((company-candidates-length 2)
433 (company-backend (lambda (action &optional arg &rest _ignore)
434 (when (eq action 'annotation)
435 (cdr (assoc arg '(("123" . "(4)")))))))
436 (company-candidates '("123" "45"))
437 company-tooltip-align-annotations)
438 (company-pseudo-tooltip-show-at-point (point))
439 (let ((ov company-pseudo-tooltip-overlay))
440 ;; With margins.
441 (should (eq (overlay-get ov 'company-width) 8))
442 (should (string= (overlay-get ov 'company-after)
443 " 123(4) \n 45 \n")))))))
444
445 (ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned ()
446 :tags '(interactive)
447 (with-temp-buffer
448 (save-window-excursion
449 (set-window-buffer nil (current-buffer))
450 (insert " ")
451 (save-excursion (insert "\n"))
452 (let ((company-candidates-length 3)
453 (company-backend (lambda (action &optional arg &rest _ignore)
454 (when (eq action 'annotation)
455 (cdr (assoc arg '(("123" . "(4)")
456 ("67" . "(891011)")))))))
457 (company-candidates '("123" "45" "67"))
458 (company-tooltip-align-annotations t))
459 (company-pseudo-tooltip-show-at-point (point))
460 (let ((ov company-pseudo-tooltip-overlay))
461 ;; With margins.
462 (should (eq (overlay-get ov 'company-width) 13))
463 (should (string= (overlay-get ov 'company-after)
464 " 123 (4) \n 45 \n 67 (891011) \n")))))))
465
466 (ert-deftest company-create-lines-shows-numbers ()
467 (let ((company-show-numbers t)
468 (company-candidates '("x" "y" "z"))
469 (company-candidates-length 3)
470 (company-backend 'ignore))
471 (should (equal '(" x 1 " " y 2 " " z 3 ")
472 (company--create-lines 0 999)))))
473
474 (ert-deftest company-create-lines-truncates-annotations ()
475 (let* ((ww (company--window-width))
476 (data `(("1" . "(123)")
477 ("2" . nil)
478 ("3" . ,(concat "(" (make-string (- ww 2) ?4) ")"))
479 (,(make-string ww ?4) . "<4>")))
480 (company-candidates (mapcar #'car data))
481 (company-candidates-length 4)
482 (company-tooltip-margin 1)
483 (company-backend (lambda (cmd &optional arg)
484 (when (eq cmd 'annotation)
485 (cdr (assoc arg data)))))
486 company-tooltip-align-annotations)
487 (should (equal (list (format " 1(123)%s " (company-space-string (- ww 8)))
488 (format " 2%s " (company-space-string (- ww 3)))
489 (format " 3(444%s " (make-string (- ww 7) ?4))
490 (format " %s " (make-string (- ww 2) ?4)))
491 (company--create-lines 0 999)))
492 (let ((company-tooltip-align-annotations t))
493 (should (equal (list (format " 1%s(123) " (company-space-string (- ww 8)))
494 (format " 2%s " (company-space-string (- ww 3)))
495 (format " 3 (444%s " (make-string (- ww 8) ?4))
496 (format " %s " (make-string (- ww 2) ?4)))
497 (company--create-lines 0 999))))))
498
499 (ert-deftest company-column-with-composition ()
500 (with-temp-buffer
501 (insert "lambda ()")
502 (compose-region 1 (1+ (length "lambda")) "\\")
503 (should (= (company--column) 4))))
504
505 (ert-deftest company-column-with-line-prefix ()
506 (with-temp-buffer
507 (insert "foo")
508 (put-text-property (point-min) (point) 'line-prefix " ")
509 (should (= (company--column) 5))))
510
511 (ert-deftest company-column-wth-line-prefix-on-empty-line ()
512 (with-temp-buffer
513 (insert "\n")
514 (forward-char -1)
515 (put-text-property (point-min) (point-max) 'line-prefix " ")
516 (should (= (company--column) 2))))
517
518 (ert-deftest company-plainify ()
519 (let ((tab-width 8))
520 (should (equal-including-properties
521 (company-plainify "\tabc\td\t")
522 (concat " "
523 "abc "
524 "d "))))
525 (should (equal-including-properties
526 (company-plainify (propertize "foobar" 'line-prefix "-*-"))
527 "-*-foobar")))
528
529 (ert-deftest company-modify-line ()
530 (let ((str "-*-foobar"))
531 (should (equal-including-properties
532 (company-modify-line str "zz" 4)
533 "-*-fzzbar"))
534 (should (equal-including-properties
535 (company-modify-line str "xx" 0)
536 "xx-foobar"))
537 (should (equal-including-properties
538 (company-modify-line str "zz" 10)
539 "-*-foobar zz"))))
540
541 (ert-deftest company-scrollbar-bounds ()
542 (should (equal nil (company--scrollbar-bounds 0 3 3)))
543 (should (equal nil (company--scrollbar-bounds 0 4 3)))
544 (should (equal '(0 . 0) (company--scrollbar-bounds 0 1 2)))
545 (should (equal '(1 . 1) (company--scrollbar-bounds 2 2 4)))
546 (should (equal '(2 . 3) (company--scrollbar-bounds 7 4 12)))
547 (should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12)))
548 (should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11))))
549
550 ;;; Async
551
552 (defun company-async-backend (command &optional arg)
553 (pcase command
554 (`prefix "foo")
555 (`candidates
556 (cons :async
557 (lambda (cb)
558 (run-with-timer 0.05 nil
559 #'funcall cb '("abc" "abd")))))))
560
561 (ert-deftest company-call-backend-forces-sync ()
562 (let ((company-backend 'company-async-backend)
563 (company-async-timeout 0.1))
564 (should (equal '("abc" "abd") (company-call-backend 'candidates)))))
565
566 (ert-deftest company-call-backend-errors-on-timeout ()
567 (with-temp-buffer
568 (let* ((company-backend (lambda (command &optional _arg)
569 (pcase command
570 (`candidates (cons :async 'ignore)))))
571 (company-async-timeout 0.1)
572 (err (should-error (company-call-backend 'candidates "foo"))))
573 (should (string-match-p "async timeout" (cadr err))))))
574
575 (ert-deftest company-call-backend-raw-passes-return-value-verbatim ()
576 (let ((company-backend 'company-async-backend))
577 (should (equal "foo" (company-call-backend-raw 'prefix)))
578 (should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
579 (should (equal 'closure (cadr (company-call-backend-raw 'candidates "foo"))))))
580
581 (ert-deftest company-manual-begin-forces-async-candidates-to-sync ()
582 (with-temp-buffer
583 (company-mode)
584 (let (company-frontends
585 company-transformers
586 (company-backends (list 'company-async-backend)))
587 (company-manual-begin)
588 (should (equal "foo" company-prefix))
589 (should (equal '("abc" "abd") company-candidates)))))
590
591 (ert-deftest company-idle-begin-allows-async-candidates ()
592 (with-temp-buffer
593 (company-mode)
594 (let (company-frontends
595 company-transformers
596 (company-backends (list 'company-async-backend)))
597 (company-idle-begin (current-buffer) (selected-window)
598 (buffer-chars-modified-tick) (point))
599 (should (null company-candidates))
600 (sleep-for 0.1)
601 (should (equal "foo" company-prefix))
602 (should (equal '("abc" "abd") company-candidates)))))
603
604 (ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed ()
605 (with-temp-buffer
606 (company-mode)
607 (let (company-frontends
608 (company-backends (list 'company-async-backend)))
609 (company-idle-begin (current-buffer) (selected-window)
610 (buffer-chars-modified-tick) (point))
611 (should (null company-candidates))
612 (insert "a")
613 (sleep-for 0.1)
614 (should (null company-candidates)))))
615
616 (ert-deftest company-idle-begin-async-allows-immediate-callbacks ()
617 (with-temp-buffer
618 (company-mode)
619 (let (company-frontends
620 (company-backends
621 (list (lambda (command &optional arg)
622 (pcase command
623 (`prefix (buffer-substring (point-min) (point)))
624 (`candidates
625 (let ((c (all-completions arg '("abc" "def"))))
626 (cons :async
627 (lambda (cb) (funcall cb c)))))
628 (`no-cache t)))))
629 (company-minimum-prefix-length 0))
630 (company-idle-begin (current-buffer) (selected-window)
631 (buffer-chars-modified-tick) (point))
632 (should (equal '("abc" "def") company-candidates))
633 (let ((last-command-event ?a))
634 (company-call 'self-insert-command 1))
635 (should (equal '("abc") company-candidates)))))
636
637 (ert-deftest company-multi-backend-forces-prefix-to-sync ()
638 (with-temp-buffer
639 (let ((company-backend (list 'ignore
640 (lambda (command)
641 (should (eq command 'prefix))
642 (cons :async
643 (lambda (cb)
644 (run-with-timer
645 0.01 nil
646 (lambda () (funcall cb nil))))))
647 (lambda (command)
648 (should (eq command 'prefix))
649 "foo"))))
650 (should (equal "foo" (company-call-backend-raw 'prefix))))
651 (let ((company-backend (list (lambda (_command)
652 (cons :async
653 (lambda (cb)
654 (run-with-timer
655 0.01 nil
656 (lambda () (funcall cb "bar"))))))
657 (lambda (_command)
658 "foo"))))
659 (should (equal "bar" (company-call-backend-raw 'prefix))))))
660
661 (ert-deftest company-multi-backend-merges-deferred-candidates ()
662 (with-temp-buffer
663 (let* ((immediate (lambda (command &optional arg)
664 (pcase command
665 (`prefix "foo")
666 (`candidates
667 (cons :async
668 (lambda (cb) (funcall cb '("f"))))))))
669 (company-backend (list 'ignore
670 (lambda (command &optional arg)
671 (pcase command
672 (`prefix "foo")
673 (`candidates
674 (should (equal arg "foo"))
675 (cons :async
676 (lambda (cb)
677 (run-with-timer
678 0.01 nil
679 (lambda () (funcall cb '("a" "b")))))))))
680 (lambda (command &optional arg)
681 (pcase command
682 (`prefix "foo")
683 (`candidates '("c" "d" "e"))))
684 immediate)))
685 (should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
686 (should (equal '("a" "b" "c" "d" "e" "f")
687 (company-call-backend 'candidates "foo")))
688 (let ((company-backend (list immediate)))
689 (should (equal '("f") (company-call-backend 'candidates "foo")))))))
690
691 ;;; Template
692
693 (ert-deftest company-template-removed-after-the-last-jump ()
694 (with-temp-buffer
695 (insert "{ }")
696 (goto-char 2)
697 (let ((tpl (company-template-declare-template (point) (1- (point-max)))))
698 (save-excursion
699 (dotimes (i 2)
700 (insert " ")
701 (company-template-add-field tpl (point) "foo")))
702 (company-call 'template-forward-field)
703 (should (= 3 (point)))
704 (company-call 'template-forward-field)
705 (should (= 7 (point)))
706 (company-call 'template-forward-field)
707 (should (= 11 (point)))
708 (should (zerop (length (overlay-get tpl 'company-template-fields))))
709 (should (null (overlay-buffer tpl))))))
710
711 (ert-deftest company-template-removed-after-input-and-jump ()
712 (with-temp-buffer
713 (insert "{ }")
714 (goto-char 2)
715 (let ((tpl (company-template-declare-template (point) (1- (point-max)))))
716 (save-excursion
717 (insert " ")
718 (company-template-add-field tpl (point) "bar"))
719 (company-call 'template-move-to-first tpl)
720 (should (= 3 (point)))
721 (dolist (c (string-to-list "tee"))
722 (let ((last-command-event c))
723 (company-call 'self-insert-command 1)))
724 (should (string= "{ tee }" (buffer-string)))
725 (should (overlay-buffer tpl))
726 (company-call 'template-forward-field)
727 (should (= 7 (point)))
728 (should (null (overlay-buffer tpl))))))
729
730 (defun company-call (name &rest args)
731 (let* ((maybe (intern (format "company-%s" name)))
732 (command (if (fboundp maybe) maybe name)))
733 (let ((this-command command))
734 (run-hooks 'pre-command-hook))
735 (apply command args)
736 (let ((this-command command))
737 (run-hooks 'post-command-hook))))
738
739 (ert-deftest company-template-c-like-templatify ()
740 (with-temp-buffer
741 (let ((text "foo(int a, short b)"))
742 (insert text)
743 (company-template-c-like-templatify text)
744 (should (equal "foo(arg0, arg1)" (buffer-string)))
745 (should (looking-at "arg0"))
746 (should (equal "int a"
747 (overlay-get (company-template-field-at) 'display))))))
748
749 (ert-deftest company-template-c-like-templatify-trims-after-closing-paren ()
750 (with-temp-buffer
751 (let ((text "foo(int a, short b)!@ #1334 a"))
752 (insert text)
753 (company-template-c-like-templatify text)
754 (should (equal "foo(arg0, arg1)" (buffer-string)))
755 (should (looking-at "arg0")))))
756
757 ;;; Clang
758
759 (ert-deftest company-clang-objc-templatify ()
760 (with-temp-buffer
761 (let ((text "createBookWithTitle:andAuthor:"))
762 (insert text)
763 (company-clang-objc-templatify text)
764 (should (equal "createBookWithTitle:arg0 andAuthor:arg1" (buffer-string)))
765 (should (looking-at "arg0"))
766 (should (null (overlay-get (company-template-field-at) 'display))))))