X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/fcca4e12b3376d19c55d3290fd976ab342faa238..79dbe65384654386166aa2c10d2ee56469aa3474:/packages/company/company-tests.el diff --git a/packages/company/company-tests.el b/packages/company/company-tests.el index 79d1f0257..0663c71f9 100644 --- a/packages/company/company-tests.el +++ b/packages/company/company-tests.el @@ -1,6 +1,6 @@ -;;; company-tests.el --- company-mode tests +;;; company-tests.el --- company-mode tests -*- lexical-binding: t -*- -;; Copyright (C) 2011, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2011, 2013-2014 Free Software Foundation, Inc. ;; Author: Nikolaj Schumacher @@ -25,13 +25,14 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'ert) (require 'company) (require 'company-keywords) -(require 'company-elisp) (require 'company-clang) +(defun company--column (&optional pos) + (car (company--col-row pos))) + ;;; Core (ert-deftest company-sorted-keywords () @@ -46,25 +47,122 @@ (ert-deftest company-good-prefix () (let ((company-minimum-prefix-length 5) - company--explicit-action) + company-abort-manual-when-too-short + company--manual-action ;idle begin + (company-selection-changed t)) ;has no effect (should (eq t (company--good-prefix-p "!@#$%"))) (should (eq nil (company--good-prefix-p "abcd"))) (should (eq nil (company--good-prefix-p 'stop))) (should (eq t (company--good-prefix-p '("foo" . 5)))) - (should (eq nil (company--good-prefix-p '("foo" . 4)))))) + (should (eq nil (company--good-prefix-p '("foo" . 4)))) + (should (eq t (company--good-prefix-p '("foo" . t)))))) + +(ert-deftest company--manual-prefix-set-and-unset () + (with-temp-buffer + (insert "ab") + (company-mode) + (let (company-frontends + (company-backends + (list (lambda (command &optional arg) + (cl-case command + (prefix (buffer-substring (point-min) (point))) + (candidates '("abc" "abd"))))))) + (company-manual-begin) + (should (equal "ab" company--manual-prefix)) + (company-abort) + (should (null company--manual-prefix))))) + +(ert-deftest company-abort-manual-when-too-short () + (let ((company-minimum-prefix-length 5) + (company-abort-manual-when-too-short t) + (company-selection-changed t)) ;has not effect + (let ((company--manual-action nil)) ;idle begin + (should (eq t (company--good-prefix-p "!@#$%"))) + (should (eq t (company--good-prefix-p '("foo" . 5)))) + (should (eq t (company--good-prefix-p '("foo" . t))))) + (let ((company--manual-action t) + (company--manual-prefix "abc")) ;manual begin from this prefix + (should (eq t (company--good-prefix-p "!@#$"))) + (should (eq nil (company--good-prefix-p "ab"))) + (should (eq nil (company--good-prefix-p 'stop))) + (should (eq t (company--good-prefix-p '("foo" . 4)))) + (should (eq t (company--good-prefix-p "abcd"))) + (should (eq t (company--good-prefix-p "abc"))) + (should (eq t (company--good-prefix-p '("bar" . t))))))) (ert-deftest company-multi-backend-with-lambdas () (let ((company-backend (list (lambda (command &optional arg &rest ignore) - (case command + (cl-case command (prefix "z") (candidates '("a" "b")))) (lambda (command &optional arg &rest ignore) - (case command + (cl-case command (prefix "z") (candidates '("c" "d"))))))) (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" "d"))))) +(ert-deftest company-multi-backend-filters-backends-by-prefix () + (let ((company-backend + (list (lambda (command &optional arg &rest ignore) + (cl-case command + (prefix (cons "z" t)) + (candidates '("a" "b")))) + (lambda (command &optional arg &rest ignore) + (cl-case command + (prefix "t") + (candidates '("c" "d")))) + (lambda (command &optional arg &rest ignore) + (cl-case command + (prefix "z") + (candidates '("e" "f"))))))) + (should (equal (company-call-backend 'candidates "z") '("a" "b" "e" "f"))))) + +(ert-deftest company-multi-backend-remembers-candidate-backend () + (let ((company-backend + (list (lambda (command &optional arg) + (cl-case command + (ignore-case nil) + (annotation "1") + (candidates '("a" "c")) + (post-completion "13"))) + (lambda (command &optional arg) + (cl-case command + (ignore-case t) + (annotation "2") + (candidates '("b" "d")) + (post-completion "42"))) + (lambda (command &optional arg) + (cl-case command + (annotation "3") + (candidates '("e")) + (post-completion "74")))))) + (let ((candidates (company-calculate-candidates nil))) + (should (equal candidates '("a" "b" "c" "d" "e"))) + (should (equal t (company-call-backend 'ignore-case))) + (should (equal "1" (company-call-backend 'annotation (nth 0 candidates)))) + (should (equal "2" (company-call-backend 'annotation (nth 1 candidates)))) + (should (equal "13" (company-call-backend 'post-completion (nth 2 candidates)))) + (should (equal "42" (company-call-backend 'post-completion (nth 3 candidates)))) + (should (equal "3" (company-call-backend 'annotation (nth 4 candidates)))) + (should (equal "74" (company-call-backend 'post-completion (nth 4 candidates))))))) + +(ert-deftest company-multi-backend-handles-keyword-with () + (let ((primo (lambda (command &optional arg) + (cl-case command + (prefix "a") + (candidates '("abb" "abc" "abd"))))) + (secundo (lambda (command &optional arg) + (cl-case command + (prefix "a") + (candidates '("acc" "acd")))))) + (let ((company-backend (list 'ignore 'ignore :with secundo))) + (should (null (company-call-backend 'prefix)))) + (let ((company-backend (list 'ignore primo :with secundo))) + (should (equal "a" (company-call-backend 'prefix))) + (should (equal '("abb" "abc" "abd" "acc" "acd") + (company-call-backend 'candidates "a")))))) + (ert-deftest company-begin-backend-failure-doesnt-break-company-backends () (with-temp-buffer (insert "a") @@ -74,7 +172,7 @@ (let (company-frontends (company-backends (list (lambda (command &optional arg) - (case command + (cl-case command (prefix "a") (candidates '("a" "ab" "ac"))))))) (let (this-command) @@ -89,7 +187,7 @@ (company-require-match 'company-explicit-action-p) (company-backends (list (lambda (command &optional arg) - (case command + (cl-case command (prefix (buffer-substring (point-min) (point))) (candidates '("abc" "abd"))))))) (let (this-command) @@ -104,19 +202,88 @@ (insert "ab") (company-mode) (let (company-frontends + (company-minimum-prefix-length 2) (company-require-match 'company-explicit-action-p) (company-backends (list (lambda (command &optional arg) - (case command + (cl-case command (prefix (buffer-substring (point-min) (point))) (candidates '("abc" "abd"))))))) (company-idle-begin (current-buffer) (selected-window) (buffer-chars-modified-tick) (point)) + (should (eq 2 company-candidates-length)) (let ((last-command-event ?e)) (company-call 'self-insert-command 1)) (should (eq nil company-candidates-length)) (should (eq 4 (point)))))) +(ert-deftest company-dont-require-match-if-old-prefix-ended-and-was-a-match () + (with-temp-buffer + (insert "ab") + (company-mode) + (let (company-frontends + (company-require-match 'company-explicit-action-p) + (company-backends + (list (lambda (command &optional arg) + (cl-case command + (prefix (company-grab-word)) + (candidates '("abc" "ab" "abd")) + (sorted t)))))) + (let (this-command) + (company-complete)) + (let ((last-command-event ?e)) + (company-call 'self-insert-command 1)) + (should (eq 3 company-candidates-length)) + (should (eq 3 (point))) + (let ((last-command-event ? )) + (company-call 'self-insert-command 1)) + (should (null company-candidates-length)) + (should (eq 4 (point)))))) + +(ert-deftest company-should-complete-whitelist () + (with-temp-buffer + (insert "ab") + (company-mode) + (let (company-frontends + company-begin-commands + (company-backends + (list (lambda (command &optional arg) + (cl-case command + (prefix (buffer-substring (point-min) (point))) + (candidates '("abc" "abd"))))))) + (let ((company-continue-commands nil)) + (let (this-command) + (company-complete)) + (company-call 'backward-delete-char 1) + (should (null company-candidates-length))) + (let ((company-continue-commands '(backward-delete-char))) + (let (this-command) + (company-complete)) + (company-call 'backward-delete-char 1) + (should (eq 2 company-candidates-length)))))) + +(ert-deftest company-should-complete-blacklist () + (with-temp-buffer + (insert "ab") + (company-mode) + (let (company-frontends + company-begin-commands + (company-backends + (list (lambda (command &optional arg) + (cl-case command + (prefix (buffer-substring (point-min) (point))) + (candidates '("abc" "abd"))))))) + (let ((company-continue-commands '(not backward-delete-char))) + (let (this-command) + (company-complete)) + (company-call 'backward-delete-char 1) + (should (null company-candidates-length))) + (let ((company-continue-commands '(not backward-delete-char-untabify))) + (let (this-command) + (company-complete)) + (company-call 'backward-delete-char 1) + (should (eq 2 company-candidates-length)))))) + (ert-deftest company-auto-complete-explicit () (with-temp-buffer (insert "ab") @@ -126,7 +293,7 @@ (company-auto-complete-chars '(? )) (company-backends (list (lambda (command &optional arg) - (case command + (cl-case command (prefix (buffer-substring (point-min) (point))) (candidates '("abcd" "abef"))))))) (let (this-command) @@ -142,9 +309,10 @@ (let (company-frontends (company-auto-complete 'company-explicit-action-p) (company-auto-complete-chars '(? )) + (company-minimum-prefix-length 2) (company-backends (list (lambda (command &optional arg) - (case command + (cl-case command (prefix (buffer-substring (point-min) (point))) (candidates '("abcd" "abef"))))))) (company-idle-begin (current-buffer) (selected-window) @@ -162,6 +330,59 @@ (should (null company-candidates)) (should (null (company-explicit-action-p)))))) +(ert-deftest company-ignore-case-replaces-prefix () + (with-temp-buffer + (company-mode) + (let (company-frontends + company-end-of-buffer-workaround + (company-backends + (list (lambda (command &optional arg) + (cl-case command + (prefix (buffer-substring (point-min) (point))) + (candidates '("abcd" "abef")) + (ignore-case t)))))) + (insert "A") + (let (this-command) + (company-complete)) + (should (string= "ab" (buffer-string))) + (delete-char -2) + (insert "A") ; hack, to keep it in one test + (company-complete-selection) + (should (string= "abcd" (buffer-string)))))) + +(ert-deftest company-ignore-case-with-keep-prefix () + (with-temp-buffer + (insert "AB") + (company-mode) + (let (company-frontends + (company-backends + (list (lambda (command &optional arg) + (cl-case command + (prefix (buffer-substring (point-min) (point))) + (candidates '("abcd" "abef")) + (ignore-case 'keep-prefix)))))) + (let (this-command) + (company-complete)) + (company-complete-selection) + (should (string= "ABcd" (buffer-string)))))) + +(ert-deftest company-non-prefix-completion () + (with-temp-buffer + (insert "tc") + (company-mode) + (let (company-frontends + company-end-of-buffer-workaround + (company-backends + (list (lambda (command &optional arg) + (cl-case command + (prefix (buffer-substring (point-min) (point))) + (candidates '("tea-cup" "teal-color"))))))) + (let (this-command) + (company-complete)) + (should (string= "tc" (buffer-string))) + (company-complete-selection) + (should (string= "tea-cup" (buffer-string)))))) + (ert-deftest company-pseudo-tooltip-does-not-get-displaced () :tags '(interactive) (with-temp-buffer @@ -173,51 +394,271 @@ (company-begin-commands '(self-insert-command)) (company-backends (list (lambda (c &optional arg) - (case c (prefix "") (candidates '("a" "b" "c"))))))) + (cl-case c (prefix "") (candidates '("a" "b" "c"))))))) (let (this-command) (company-call 'complete)) (company-call 'open-line 1) - (should (eq 2 (overlay-start company-pseudo-tooltip-overlay))))))) + (should (eq 1 (overlay-start company-pseudo-tooltip-overlay))))))) -(ert-deftest company-pseudo-tooltip-overlay-show () +(ert-deftest company-pseudo-tooltip-show () :tags '(interactive) (with-temp-buffer (save-window-excursion (set-window-buffer nil (current-buffer)) - (insert "aaaa\n bb\nccccc\nddd") + (insert "aaaa\n bb\nccccccc\nddd") (search-backward "bb") (let ((col (company--column)) (company-candidates-length 2) - (company-candidates '("123" "45"))) + (company-candidates '("123" "45")) + (company-backend 'ignore)) (company-pseudo-tooltip-show (company--row) col 0) (let ((ov company-pseudo-tooltip-overlay)) - (should (eq (overlay-get ov 'company-width) 3)) + ;; With margins. + (should (eq (overlay-get ov 'company-width) 5)) ;; FIXME: Make it 2? (should (eq (overlay-get ov 'company-height) company-tooltip-limit)) (should (eq (overlay-get ov 'company-column) col)) - (should (string= (overlay-get ov 'company-after) - " 123\nc45 c\nddd\n"))))))) + (should (string= (overlay-get ov 'company-display) + "\n 123 \nc 45 c\nddd\n"))))))) + +(ert-deftest company-pseudo-tooltip-edit-updates-width () + :tags '(interactive) + (with-temp-buffer + (set-window-buffer nil (current-buffer)) + (let ((company-candidates-length 5) + (company-candidates '("123" "45" "67" "89" "1011")) + (company-backend 'ignore) + (company-tooltip-limit 4) + (company-tooltip-offset-display 'scrollbar)) + (company-pseudo-tooltip-show (company--row) + (company--column) + 0) + (should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width) + 6)) + (company-pseudo-tooltip-edit 4) + (should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width) + 7))))) + +(ert-deftest company-preview-show-with-annotations () + :tags '(interactive) + (with-temp-buffer + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (save-excursion (insert "\n")) + (let ((company-candidates-length 1) + (company-candidates '("123"))) + (company-preview-show-at-point (point)) + (let* ((ov company-preview-overlay) + (str (overlay-get ov 'after-string))) + (should (string= str "123")) + (should (eq (get-text-property 0 'cursor str) t))))))) + +(ert-deftest company-pseudo-tooltip-show-with-annotations () + :tags '(interactive) + (with-temp-buffer + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (insert " ") + (save-excursion (insert "\n")) + (let ((company-candidates-length 2) + (company-backend (lambda (action &optional arg &rest _ignore) + (when (eq action 'annotation) + (cdr (assoc arg '(("123" . "(4)"))))))) + (company-candidates '("123" "45")) + company-tooltip-align-annotations) + (company-pseudo-tooltip-show-at-point (point) 0) + (let ((ov company-pseudo-tooltip-overlay)) + ;; With margins. + (should (eq (overlay-get ov 'company-width) 8)) + (should (string= (overlay-get ov 'company-display) + "\n 123(4) \n 45 \n"))))))) + +(ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned () + :tags '(interactive) + (with-temp-buffer + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (insert " ") + (save-excursion (insert "\n")) + (let ((company-candidates-length 3) + (company-backend (lambda (action &optional arg &rest _ignore) + (when (eq action 'annotation) + (cdr (assoc arg '(("123" . "(4)") + ("67" . "(891011)"))))))) + (company-candidates '("123" "45" "67")) + (company-tooltip-align-annotations t)) + (company-pseudo-tooltip-show-at-point (point) 0) + (let ((ov company-pseudo-tooltip-overlay)) + ;; With margins. + (should (eq (overlay-get ov 'company-width) 13)) + (should (string= (overlay-get ov 'company-display) + "\n 123 (4) \n 45 \n 67 (891011) \n"))))))) + +(ert-deftest company-create-lines-shows-numbers () + (let ((company-show-numbers t) + (company-candidates '("x" "y" "z")) + (company-candidates-length 3) + (company-backend 'ignore)) + (should (equal '(" x 1 " " y 2 " " z 3 ") + (company--create-lines 0 999))))) + +(ert-deftest company-create-lines-truncates-annotations () + (let* ((ww (company--window-width)) + (data `(("1" . "(123)") + ("2" . nil) + ("3" . ,(concat "(" (make-string (- ww 2) ?4) ")")) + (,(make-string ww ?4) . "<4>"))) + (company-candidates (mapcar #'car data)) + (company-candidates-length 4) + (company-tooltip-margin 1) + (company-backend (lambda (cmd &optional arg) + (when (eq cmd 'annotation) + (cdr (assoc arg data))))) + company-tooltip-align-annotations) + (should (equal (list (format " 1(123)%s " (company-space-string (- ww 8))) + (format " 2%s " (company-space-string (- ww 3))) + (format " 3(444%s " (make-string (- ww 7) ?4)) + (format " %s " (make-string (- ww 2) ?4))) + (company--create-lines 0 999))) + (let ((company-tooltip-align-annotations t)) + (should (equal (list (format " 1%s(123) " (company-space-string (- ww 8))) + (format " 2%s " (company-space-string (- ww 3))) + (format " 3 (444%s " (make-string (- ww 8) ?4)) + (format " %s " (make-string (- ww 2) ?4))) + (company--create-lines 0 999)))))) + +(ert-deftest company-create-lines-truncates-common-part () + (let* ((ww (company--window-width)) + (company-candidates-length 2) + (company-tooltip-margin 1) + (company-backend #'ignore)) + (let* ((company-common (make-string (- ww 3) ?1)) + (company-candidates `(,(concat company-common "2") + ,(concat company-common "3")))) + (should (equal (list (format " %s2 " (make-string (- ww 3) ?1)) + (format " %s3 " (make-string (- ww 3) ?1))) + (company--create-lines 0 999)))) + (let* ((company-common (make-string (- ww 2) ?1)) + (company-candidates `(,(concat company-common "2") + ,(concat company-common "3")))) + (should (equal (list (format " %s " company-common) + (format " %s " company-common)) + (company--create-lines 0 999)))) + (let* ((company-common (make-string ww ?1)) + (company-candidates `(,(concat company-common "2") + ,(concat company-common "3"))) + (res (company--create-lines 0 999))) + (should (equal (list (format " %s " (make-string (- ww 2) ?1)) + (format " %s " (make-string (- ww 2) ?1))) + res)) + (should (eq 'company-tooltip-common-selection + (get-text-property (- ww 2) 'face + (car res)))) + (should (eq 'company-tooltip-selection + (get-text-property (1- ww) 'face + (car res)))) + ))) + +(ert-deftest company-create-lines-clears-out-non-printables () + :tags '(interactive) + (let (company-show-numbers + (company-candidates (list + (decode-coding-string "avalis\351e" 'utf-8) + "avatar")) + (company-candidates-length 2) + (company-backend 'ignore)) + (should (equal '(" avalis‗e " + " avatar ") + (company--create-lines 0 999))))) + +(ert-deftest company-create-lines-handles-multiple-width () + :tags '(interactive) + (let (company-show-numbers + (company-candidates '("蛙蛙蛙蛙" "蛙abc")) + (company-candidates-length 2) + (company-backend 'ignore)) + (should (equal '(" 蛙蛙蛙蛙 " + " 蛙abc ") + (company--create-lines 0 999))))) (ert-deftest company-column-with-composition () + :tags '(interactive) (with-temp-buffer - (insert "lambda ()") - (compose-region 1 (1+ (length "lambda")) "\\") - (should (= (company--column) 4)))) + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (insert "lambda ()") + (compose-region 1 (1+ (length "lambda")) "\\") + (should (= (company--column) 4))))) (ert-deftest company-column-with-line-prefix () + :tags '(interactive) (with-temp-buffer - (insert "foo") - (put-text-property (point-min) (point) 'line-prefix " ") - (should (= (company--column) 5)))) + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (insert "foo") + (put-text-property (point-min) (point) 'line-prefix " ") + (should (= (company--column) 5))))) -(ert-deftest company-modify-line-with-line-prefix () - (let ((str (propertize "foobar" 'line-prefix "-*-"))) +(ert-deftest company-column-with-line-prefix-on-empty-line () + :tags '(interactive) + (with-temp-buffer + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (insert "\n") + (forward-char -1) + (put-text-property (point-min) (point-max) 'line-prefix " ") + (should (= (company--column) 2))))) + +(ert-deftest company-column-with-tabs () + :tags '(interactive) + (with-temp-buffer + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (insert "|\t|\t|\t(") + (let ((tab-width 8)) + (should (= (company--column) 25)))))) + +(ert-deftest company-row-with-header-line-format () + :tags '(interactive) + (with-temp-buffer + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (should (= (company--row) 0)) + (setq header-line-format "aaaaaaa") + (should (= (company--row) 0))))) + +(ert-deftest company-plainify () + (let ((tab-width 8)) + (should (equal-including-properties + (company-plainify "\tabc\td\t") + (concat " " + "abc " + "d ")))) + (should (equal-including-properties + (company-plainify (propertize "foobar" 'line-prefix "-*-")) + "-*-foobar"))) + +(ert-deftest company-buffer-lines-with-lines-folded () + :tags '(interactive) + (with-temp-buffer + (insert (propertize "aaa\nbbb\nccc\nddd\n" 'display "aaa+\n")) + (insert "eee\nfff\nggg") + (should (equal (company-buffer-lines (point-min) (point-max)) + '("aaa" "eee" "fff" "ggg"))))) + +(ert-deftest company-buffer-lines-with-multiline-display () + :tags '(interactive) + (with-temp-buffer + (insert (propertize "a" 'display "bbb\nccc\ndddd\n")) + (insert "eee\nfff\nggg") + (should (equal (company-buffer-lines (point-min) (point-max)) + '("" "" "" "eee" "fff" "ggg"))))) + +(ert-deftest company-modify-line () + (let ((str "-*-foobar")) (should (equal-including-properties (company-modify-line str "zz" 4) "-*-fzzbar")) - (should (equal-including-properties - (company-modify-line str "zzxx" 1) - "-zzxxobar")) (should (equal-including-properties (company-modify-line str "xx" 0) "xx-foobar")) @@ -225,6 +666,194 @@ (company-modify-line str "zz" 10) "-*-foobar zz")))) +(ert-deftest company-scrollbar-bounds () + (should (equal nil (company--scrollbar-bounds 0 3 3))) + (should (equal nil (company--scrollbar-bounds 0 4 3))) + (should (equal '(0 . 0) (company--scrollbar-bounds 0 1 2))) + (should (equal '(1 . 1) (company--scrollbar-bounds 2 2 4))) + (should (equal '(2 . 3) (company--scrollbar-bounds 7 4 12))) + (should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12))) + (should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11)))) + +;;; Async + +(defun company-async-backend (command &optional arg) + (pcase command + (`prefix "foo") + (`candidates + (cons :async + (lambda (cb) + (run-with-timer 0.05 nil + #'funcall cb '("abc" "abd"))))))) + +(ert-deftest company-call-backend-forces-sync () + (let ((company-backend 'company-async-backend) + (company-async-timeout 0.1)) + (should (equal '("abc" "abd") (company-call-backend 'candidates))))) + +(ert-deftest company-call-backend-errors-on-timeout () + (with-temp-buffer + (let* ((company-backend (lambda (command &optional _arg) + (pcase command + (`candidates (cons :async 'ignore))))) + (company-async-timeout 0.1) + (err (should-error (company-call-backend 'candidates "foo")))) + (should (string-match-p "async timeout" (cadr err)))))) + +(ert-deftest company-call-backend-raw-passes-return-value-verbatim () + (let ((company-backend 'company-async-backend)) + (should (equal "foo" (company-call-backend-raw 'prefix))) + (should (equal :async (car (company-call-backend-raw 'candidates "foo")))) + (should (equal 'closure (cadr (company-call-backend-raw 'candidates "foo")))))) + +(ert-deftest company-manual-begin-forces-async-candidates-to-sync () + (with-temp-buffer + (company-mode) + (let (company-frontends + company-transformers + (company-backends (list 'company-async-backend))) + (company-manual-begin) + (should (equal "foo" company-prefix)) + (should (equal '("abc" "abd") company-candidates))))) + +(ert-deftest company-idle-begin-allows-async-candidates () + (with-temp-buffer + (company-mode) + (let (company-frontends + company-transformers + (company-backends (list 'company-async-backend))) + (company-idle-begin (current-buffer) (selected-window) + (buffer-chars-modified-tick) (point)) + (should (null company-candidates)) + (sleep-for 0.1) + (should (equal "foo" company-prefix)) + (should (equal '("abc" "abd") company-candidates))))) + +(ert-deftest company-idle-begin-cancels-async-candidates-if-buffer-changed () + (with-temp-buffer + (company-mode) + (let (company-frontends + (company-backends (list 'company-async-backend))) + (company-idle-begin (current-buffer) (selected-window) + (buffer-chars-modified-tick) (point)) + (should (null company-candidates)) + (insert "a") + (sleep-for 0.1) + (should (null company-candidates))))) + +(ert-deftest company-idle-begin-async-allows-immediate-callbacks () + (with-temp-buffer + (company-mode) + (let (company-frontends + (company-backends + (list (lambda (command &optional arg) + (pcase command + (`prefix (buffer-substring (point-min) (point))) + (`candidates + (let ((c (all-completions arg '("abc" "def")))) + (cons :async + (lambda (cb) (funcall cb c))))) + (`no-cache t))))) + (company-minimum-prefix-length 0)) + (company-idle-begin (current-buffer) (selected-window) + (buffer-chars-modified-tick) (point)) + (should (equal '("abc" "def") company-candidates)) + (let ((last-command-event ?a)) + (company-call 'self-insert-command 1)) + (should (equal '("abc") company-candidates))))) + +(ert-deftest company-multi-backend-forces-prefix-to-sync () + (with-temp-buffer + (let ((company-backend (list 'ignore + (lambda (command) + (should (eq command 'prefix)) + (cons :async + (lambda (cb) + (run-with-timer + 0.01 nil + (lambda () (funcall cb nil)))))) + (lambda (command) + (should (eq command 'prefix)) + "foo")))) + (should (equal "foo" (company-call-backend-raw 'prefix)))) + (let ((company-backend (list (lambda (_command) + (cons :async + (lambda (cb) + (run-with-timer + 0.01 nil + (lambda () (funcall cb "bar")))))) + (lambda (_command) + "foo")))) + (should (equal "bar" (company-call-backend-raw 'prefix)))))) + +(ert-deftest company-multi-backend-merges-deferred-candidates () + (with-temp-buffer + (let* ((immediate (lambda (command &optional arg) + (pcase command + (`prefix "foo") + (`candidates + (cons :async + (lambda (cb) (funcall cb '("f")))))))) + (company-backend (list 'ignore + (lambda (command &optional arg) + (pcase command + (`prefix "foo") + (`candidates + (should (equal arg "foo")) + (cons :async + (lambda (cb) + (run-with-timer + 0.01 nil + (lambda () (funcall cb '("a" "b"))))))))) + (lambda (command &optional arg) + (pcase command + (`prefix "foo") + (`candidates '("c" "d" "e")))) + immediate))) + (should (equal :async (car (company-call-backend-raw 'candidates "foo")))) + (should (equal '("a" "b" "c" "d" "e" "f") + (company-call-backend 'candidates "foo"))) + (let ((company-backend (list immediate))) + (should (equal '("f") (company-call-backend 'candidates "foo"))))))) + +;;; Transformers + +(ert-deftest company-occurrence-prefer-closest-above () + (with-temp-buffer + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (insert "foo0 +foo1 +") + (save-excursion + (insert " +foo3 +foo2")) + (let ((company-backend 'company-dabbrev) + (company-occurrence-weight-function + 'company-occurrence-prefer-closest-above)) + (should (equal '("foo1" "foo0" "foo3" "foo2" "foo4") + (company-sort-by-occurrence + '("foo0" "foo1" "foo2" "foo3" "foo4")))))))) + +(ert-deftest company-occurrence-prefer-any-closest () + (with-temp-buffer + (save-window-excursion + (set-window-buffer nil (current-buffer)) + (insert "foo0 +foo1 +") + (save-excursion + (insert " +foo3 +foo2")) + (let ((company-backend 'company-dabbrev) + (company-occurrence-weight-function + 'company-occurrence-prefer-any-closest)) + (should (equal '("foo1" "foo3" "foo0" "foo2" "foo4") + (company-sort-by-occurrence + '("foo0" "foo1" "foo2" "foo3" "foo4")))))))) + ;;; Template (ert-deftest company-template-removed-after-the-last-jump () @@ -267,6 +896,8 @@ (defun company-call (name &rest args) (let* ((maybe (intern (format "company-%s" name))) (command (if (fboundp maybe) maybe name))) + (let ((this-command command)) + (run-hooks 'pre-command-hook)) (apply command args) (let ((this-command command)) (run-hooks 'post-command-hook)))) @@ -289,172 +920,18 @@ (should (equal "foo(arg0, arg1)" (buffer-string))) (should (looking-at "arg0"))))) -;;; Elisp - -(defmacro company-elisp-with-buffer (contents &rest body) - (declare (indent 0)) - `(with-temp-buffer - (insert ,contents) - (setq major-mode 'emacs-lisp-mode) - (re-search-backward "|") - (replace-match "") - (let ((company-elisp-detect-function-context t)) - ,@body))) - -(ert-deftest company-elisp-candidates-predicate () - (company-elisp-with-buffer - "(foo ba|)" - (should (eq (company-elisp--candidates-predicate "ba") - 'boundp)) - (should (eq (let (company-elisp-detect-function-context) - (company-elisp--candidates-predicate "ba")) - 'company-elisp--predicate))) - (company-elisp-with-buffer - "(foo| )" - (should (eq (company-elisp--candidates-predicate "foo") - 'fboundp)) - (should (eq (let (company-elisp-detect-function-context) - (company-elisp--candidates-predicate "foo")) - 'company-elisp--predicate))) - (company-elisp-with-buffer - "(foo 'b|)" - (should (eq (company-elisp--candidates-predicate "b") - 'company-elisp--predicate)))) - -(ert-deftest company-elisp-candidates-predicate-in-docstring () - (company-elisp-with-buffer - "(def foo () \"Doo be doo `ide|" - (should (eq 'company-elisp--predicate - (company-elisp--candidates-predicate "ide"))))) - -;; This one's also an integration test. -(ert-deftest company-elisp-candidates-recognizes-binding-form () - (let ((company-elisp-detect-function-context t) - (obarray [when what whelp]) - (what 1) - (whelp 2) - (wisp 3)) - (company-elisp-with-buffer - "(let ((foo 7) (wh| )))" - (should (equal '("what" "whelp") - (company-elisp-candidates "wh")))) - (company-elisp-with-buffer - "(cond ((null nil) (wh| )))" - (should (equal '("when") - (company-elisp-candidates "wh")))))) - -(ert-deftest company-elisp-candidates-predicate-binding-without-value () - (loop for (text prefix predicate) in '(("(let (foo|" "foo" boundp) - ("(let (foo (bar|" "bar" boundp) - ("(let (foo) (bar|" "bar" fboundp)) - do - (eval `(company-elisp-with-buffer - ,text - (should (eq ',predicate - (company-elisp--candidates-predicate ,prefix))))))) - -(ert-deftest company-elisp-finds-vars () - (let ((obarray [boo bar baz backquote]) - (boo t) - (bar t) - (baz t)) - (should (equal '("bar" "baz") - (company-elisp--globals "ba" 'boundp))))) - -(ert-deftest company-elisp-finds-functions () - (let ((obarray [when what whelp]) - (what t) - (whelp t)) - (should (equal '("when") - (company-elisp--globals "wh" 'fboundp))))) - -(ert-deftest company-elisp-finds-things () - (let ((obarray [when what whelp]) - (what t) - (whelp t)) - (should (equal '("what" "whelp" "when") - (sort (company-elisp--globals "wh" 'company-elisp--predicate) - 'string<))))) - -(ert-deftest company-elisp-locals-vars () - (company-elisp-with-buffer - "(let ((foo 5) (bar 6)) - (cl-labels ((borg ())) - (lambda (boo baz) - b|)))" - (should (equal '("bar" "baz" "boo") - (company-elisp--locals "b" nil))))) - -(ert-deftest company-elisp-locals-single-var () - (company-elisp-with-buffer - "(dotimes (itk 100) - (dolist (item items) - it|))" - (should (equal '("itk" "item") - (company-elisp--locals "it" nil))))) - -(ert-deftest company-elisp-locals-funs () - (company-elisp-with-buffer - "(cl-labels ((foo ()) - (fee ())) - (let ((fun 4)) - (f| )))" - (should (equal '("fee" "foo") - (sort (company-elisp--locals "f" t) 'string<))))) - -(ert-deftest company-elisp-locals-skips-current-varlist () - (company-elisp-with-buffer - "(let ((foo 1) - (f| )))" - (should (null (company-elisp--locals "f" nil))))) - -(ert-deftest company-elisp-show-locals-first () - (company-elisp-with-buffer - "(let ((floo 1) - (flop 2) - (flee 3)) - fl|)" - (let ((obarray [float-pi])) - (let (company-elisp-show-locals-first) - (should (eq nil (company-elisp 'sorted)))) - (let ((company-elisp-show-locals-first t)) - (should (eq t (company-elisp 'sorted))) - (should (equal '("flee" "floo" "flop" "float-pi") - (company-elisp-candidates "fl"))))))) - -(ert-deftest company-elisp-candidates-no-duplicates () - (company-elisp-with-buffer - "(let ((float-pi 4)) - f|)" - (let ((obarray [float-pi]) - (company-elisp-show-locals-first t)) - (should (equal '("float-pi") (company-elisp-candidates "f")))))) - -(ert-deftest company-elisp-shouldnt-complete-defun-name () - (company-elisp-with-buffer - "(defun foob|)" - (should (null (company-elisp 'prefix))))) - -(ert-deftest company-elisp-should-complete-def-call () - (company-elisp-with-buffer - "(defu|" - (should (equal "defu" (company-elisp 'prefix))))) - -(ert-deftest company-elisp-should-complete-in-defvar () - ;; It will also complete the var name, at least for now. - (company-elisp-with-buffer - "(defvar abc de|" - (should (equal "de" (company-elisp 'prefix))))) - -(ert-deftest company-elisp-shouldnt-complete-in-defun-arglist () - (company-elisp-with-buffer - "(defsubst foobar (ba|" - (should (null (company-elisp 'prefix))))) - -(ert-deftest company-elisp-prefix-in-defun-body () - (company-elisp-with-buffer - "(defun foob ()|)" - (should (equal "" (company-elisp 'prefix))))) +(ert-deftest company-template-c-like-templatify-generics () + (with-temp-buffer + (let ((text "foo(int i, Dict, long l)")) + (insert text) + (company-template-c-like-templatify text) + (should (equal "foo(arg2, arg3, arg4)" (buffer-string))) + (should (looking-at "arg0")) + (should (equal "TKey" (overlay-get (company-template-field-at) 'display))) + (search-forward "arg3") + (forward-char -1) + (should (equal "Dict" + (overlay-get (company-template-field-at) 'display)))))) ;;; Clang