code.delx.au - gnu-emacs-elpa/blob - packages/company/test/frontends-tests.el

   1 ;;; frontends-tests.el --- company-mode tests  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015, 2016  Free Software Foundation, Inc.
   4
   5 ;; Author: Dmitry Gutov
   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 (require 'company-tests)
  23
  24 (ert-deftest company-pseudo-tooltip-does-not-get-displaced ()
  25   :tags '(interactive)
  26   (with-temp-buffer
  27     (save-window-excursion
  28       (set-window-buffer nil (current-buffer))
  29       (save-excursion (insert " ff"))
  30       (company-mode)
  31       (let ((company-frontends '(company-pseudo-tooltip-frontend))
  32             (company-begin-commands '(self-insert-command))
  33             (company-backends
  34              (list (lambda (c &rest _)
  35                      (cl-case c (prefix "") (candidates '("a" "b" "c")))))))
  36         (let (this-command)
  37           (company-call 'complete))
  38         (company-call 'open-line 1)
  39         (should (eq 2 (overlay-start company-pseudo-tooltip-overlay)))))))
  40
  41 (ert-deftest company-pseudo-tooltip-show ()
  42   :tags '(interactive)
  43   (with-temp-buffer
  44     (save-window-excursion
  45     (set-window-buffer nil (current-buffer))
  46     (insert "aaaa\n  bb\nccccccc\nddd")
  47     (search-backward "bb")
  48     (let ((col (company--column))
  49           (company-candidates-length 2)
  50           (company-candidates '("123" "45"))
  51           (company-backend 'ignore))
  52       (company-pseudo-tooltip-show (company--row) col 0)
  53       (let ((ov company-pseudo-tooltip-overlay))
  54         ;; With margins.
  55         (should (eq (overlay-get ov 'company-width) 5))
  56         ;; FIXME: Make it 2?
  57         (should (eq (overlay-get ov 'company-height) company-tooltip-limit))
  58         (should (eq (overlay-get ov 'company-column) col))
  59         (should (string= (overlay-get ov 'company-display)
  60                          "  123 \nc 45  c\nddd\n")))))))
  61
  62 (ert-deftest company-pseudo-tooltip-edit-updates-width ()
  63   :tags '(interactive)
  64   (with-temp-buffer
  65     (set-window-buffer nil (current-buffer))
  66     (let ((company-candidates-length 5)
  67           (company-candidates '("123" "45" "67" "89" "1011"))
  68           (company-backend 'ignore)
  69           (company-tooltip-limit 4)
  70           (company-tooltip-offset-display 'scrollbar))
  71       (company-pseudo-tooltip-show (company--row)
  72                                    (company--column)
  73                                    0)
  74       (should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width)
  75                   6))
  76       (company-pseudo-tooltip-edit 4)
  77       (should (eq (overlay-get company-pseudo-tooltip-overlay 'company-width)
  78                   7)))))
  79
  80 (ert-deftest company-preview-show-with-annotations ()
  81   :tags '(interactive)
  82   (with-temp-buffer
  83     (save-window-excursion
  84       (set-window-buffer nil (current-buffer))
  85       (save-excursion (insert "\n"))
  86       (let ((company-candidates-length 1)
  87             (company-candidates '("123"))
  88             (company-backend #'ignore))
  89         (company-preview-show-at-point (point))
  90         (let* ((ov company-preview-overlay)
  91                (str (overlay-get ov 'after-string)))
  92           (should (string= str "123"))
  93           (should (eq (get-text-property 0 'cursor str) 1)))))))
  94
  95 (ert-deftest company-pseudo-tooltip-show-with-annotations ()
  96   :tags '(interactive)
  97   (with-temp-buffer
  98     (save-window-excursion
  99       (set-window-buffer nil (current-buffer))
 100       (insert " ")
 101       (save-excursion (insert "\n"))
 102       (let ((company-candidates-length 2)
 103             (company-backend (lambda (action &optional arg &rest _ignore)
 104                                (when (eq action 'annotation)
 105                                  (cdr (assoc arg '(("123" . "(4)")))))))
 106             (company-candidates '("123" "45"))
 107             company-tooltip-align-annotations)
 108         (company-pseudo-tooltip-show-at-point (point) 0)
 109         (let ((ov company-pseudo-tooltip-overlay))
 110           ;; With margins.
 111           (should (eq (overlay-get ov 'company-width) 8))
 112           (should (string= (overlay-get ov 'company-display)
 113                            " 123(4) \n 45     \n")))))))
 114
 115 (ert-deftest company-pseudo-tooltip-show-with-annotations-right-aligned ()
 116   :tags '(interactive)
 117   (with-temp-buffer
 118     (save-window-excursion
 119       (set-window-buffer nil (current-buffer))
 120       (insert " ")
 121       (save-excursion (insert "\n"))
 122       (let ((company-candidates-length 3)
 123             (company-backend (lambda (action &optional arg &rest _ignore)
 124                                (when (eq action 'annotation)
 125                                  (cdr (assoc arg '(("123" . "(4)")
 126                                                    ("67" . "(891011)")))))))
 127             (company-candidates '("123" "45" "67"))
 128             (company-tooltip-align-annotations t))
 129         (company-pseudo-tooltip-show-at-point (point) 0)
 130         (let ((ov company-pseudo-tooltip-overlay))
 131           ;; With margins.
 132           (should (eq (overlay-get ov 'company-width) 13))
 133           (should (string= (overlay-get ov 'company-display)
 134                            " 123     (4) \n 45          \n 67 (891011) \n")))))))
 135
 136 (ert-deftest company-create-lines-shows-numbers ()
 137   (let ((company-show-numbers t)
 138         (company-candidates '("x" "y" "z"))
 139         (company-candidates-length 3)
 140         (company-backend 'ignore))
 141     (should (equal '(" x 1 " " y 2 " " z 3 ")
 142                    (company--create-lines 0 999)))))
 143
 144 (ert-deftest company-create-lines-truncates-annotations ()
 145   (let* ((ww (company--window-width))
 146          (data `(("1" . "(123)")
 147                  ("2" . nil)
 148                  ("3" . ,(concat "(" (make-string (- ww 2) ?4) ")"))
 149                  (,(make-string ww ?4) . "<4>")))
 150          (company-candidates (mapcar #'car data))
 151          (company-candidates-length 4)
 152          (company-tooltip-margin 1)
 153          (company-backend (lambda (cmd &optional arg &rest _)
 154                             (when (eq cmd 'annotation)
 155                               (cdr (assoc arg data)))))
 156          company-tooltip-align-annotations)
 157     (should (equal (list (format " 1(123)%s " (company-space-string (- ww 8)))
 158                          (format " 2%s " (company-space-string (- ww 3)))
 159                          (format " 3(444%s " (make-string (- ww 7) ?4))
 160                          (format " %s " (make-string (- ww 2) ?4)))
 161                    (company--create-lines 0 999)))
 162     (let ((company-tooltip-align-annotations t))
 163       (should (equal (list (format " 1%s(123) " (company-space-string (- ww 8)))
 164                            (format " 2%s " (company-space-string (- ww 3)))
 165                            (format " 3 (444%s " (make-string (- ww 8) ?4))
 166                            (format " %s " (make-string (- ww 2) ?4)))
 167                      (company--create-lines 0 999))))))
 168
 169 (ert-deftest company-create-lines-truncates-common-part ()
 170   (let* ((ww (company--window-width))
 171          (company-candidates-length 2)
 172          (company-tooltip-margin 1)
 173          (company-backend #'ignore))
 174     (let* ((company-common (make-string (- ww 3) ?1))
 175            (company-candidates `(,(concat company-common "2")
 176                                  ,(concat company-common "3"))))
 177       (should (equal (list (format " %s2 " (make-string (- ww 3) ?1))
 178                            (format " %s3 " (make-string (- ww 3) ?1)))
 179                      (company--create-lines 0 999))))
 180     (let* ((company-common (make-string (- ww 2) ?1))
 181            (company-candidates `(,(concat company-common "2")
 182                                  ,(concat company-common "3"))))
 183       (should (equal (list (format " %s " company-common)
 184                            (format " %s " company-common))
 185                      (company--create-lines 0 999))))
 186     (let* ((company-common (make-string ww ?1))
 187            (company-candidates `(,(concat company-common "2")
 188                                  ,(concat company-common "3")))
 189            (res (company--create-lines 0 999)))
 190       (should (equal (list (format " %s " (make-string (- ww 2) ?1))
 191                            (format " %s " (make-string (- ww 2) ?1)))
 192                      res))
 193       (should (equal '(company-tooltip-common-selection
 194                        company-tooltip-selection
 195                        company-tooltip)
 196                      (get-text-property (- ww 2) 'face
 197                                         (car res))))
 198       (should (equal '(company-tooltip-selection
 199                        company-tooltip)
 200                      (get-text-property (1- ww) 'face
 201                                         (car res))))
 202       )))
 203
 204 (ert-deftest company-create-lines-clears-out-non-printables ()
 205   :tags '(interactive)
 206   (let (company-show-numbers
 207         (company-candidates (list
 208                              (decode-coding-string "avalis\351e" 'utf-8)
 209                              "avatar"))
 210         (company-candidates-length 2)
 211         (company-backend 'ignore))
 212     (should (equal '(" avalis‗e "
 213                      " avatar   ")
 214                    (company--create-lines 0 999)))))
 215
 216 (ert-deftest company-create-lines-handles-multiple-width ()
 217   :tags '(interactive)
 218   (let (company-show-numbers
 219         (company-candidates '("蛙蛙蛙蛙" "蛙abc"))
 220         (company-candidates-length 2)
 221         (company-backend 'ignore))
 222     (should (equal '(" 蛙蛙蛙蛙 "
 223                      " 蛙abc    ")
 224                    (company--create-lines 0 999)))))
 225
 226 (ert-deftest company-create-lines-handles-multiple-width-in-annotation ()
 227   (let* (company-show-numbers
 228          (alist '(("a" . " ︸") ("b" . " ︸︸")))
 229          (company-candidates (mapcar #'car alist))
 230          (company-candidates-length 2)
 231          (company-backend (lambda (c &optional a &rest _)
 232                             (when (eq c 'annotation)
 233                               (assoc-default a alist)))))
 234     (should (equal '(" a ︸   "
 235                      " b ︸︸ ")
 236                    (company--create-lines 0 999)))))
 237
 238 (ert-deftest company-create-lines-with-multiple-width-and-keep-prefix ()
 239   :tags '(interactive)
 240   (let* (company-show-numbers
 241          (company-candidates '("MIRAI発売1カ月"
 242                                "MIRAI発売2カ月"))
 243          (company-candidates-length 2)
 244          (company-prefix "MIRAI発")
 245          (company-backend (lambda (c &rest _)
 246                             (pcase c
 247                               (`ignore-case 'keep-prefix)))))
 248     (should (equal '(" MIRAI発売1カ月 "
 249                      " MIRAI発売2カ月 ")
 250                    (company--create-lines 0 999)))))
 251
 252 (ert-deftest company-fill-propertize-truncates-search-highlight ()
 253   (let ((company-search-string "foo")
 254         (company-backend #'ignore)
 255         (company-prefix ""))
 256     (should (ert-equal-including-properties
 257              (company-fill-propertize "barfoo" nil 6 t nil nil)
 258              #("barfoo"
 259                0 3 (face (company-tooltip) mouse-face (company-tooltip-mouse))
 260                3 6 (face (company-tooltip-search company-tooltip) mouse-face (company-tooltip-mouse)))))
 261     (should (ert-equal-including-properties
 262              (company-fill-propertize "barfoo" nil 5 t "" " ")
 263              #("barfo "
 264                0 3 (face (company-tooltip) mouse-face (company-tooltip-mouse))
 265                3 5 (face (company-tooltip-search company-tooltip) mouse-face (company-tooltip-mouse))
 266                5 6 (face (company-tooltip) mouse-face (company-tooltip-mouse)))))
 267     (should (ert-equal-including-properties
 268              (company-fill-propertize "barfoo" nil 3 t " " " ")
 269              #(" bar "
 270                0 5 (face (company-tooltip) mouse-face (company-tooltip-mouse)))))))
 271
 272 (ert-deftest company-fill-propertize-overrides-face-property ()
 273   (let ((company-backend #'ignore)
 274         (company-prefix "")
 275         (str1 (propertize "str1" 'face 'foo))
 276         (str2 (propertize "str2" 'face 'foo)))
 277     (should (ert-equal-including-properties
 278              (company-fill-propertize str1 str2 8 nil nil nil)
 279              #("str1str2"
 280                0 4 (face (company-tooltip) mouse-face (company-tooltip-mouse))
 281                4 8 (face (company-tooltip-annotation company-tooltip)
 282                          mouse-face (company-tooltip-mouse)))))))
 283
 284 (ert-deftest company-fill-propertize-delegates-to-pre-render ()
 285   (let ((company-backend
 286          (lambda (command &rest args)
 287            (pcase command
 288              (`pre-render
 289               (propertize (car args)
 290                           'face (if (cadr args)
 291                                     'annotation
 292                                   'value))))))
 293         (company-prefix "")
 294         (str1 (propertize "str1" 'foo 'bar))
 295         (str2 (propertize "str2" 'foo 'bar)))
 296     (let ((res (company-fill-propertize str1 str2 8 nil nil nil)))
 297       ;; Could use `ert-equal-including-properties' as well.
 298       (should (eq (get-text-property 0 'foo res) 'bar))
 299       (should (eq (get-text-property 4 'foo res) 'bar))
 300       (should (equal (get-text-property 0 'face res)
 301                      '(value company-tooltip)))
 302       (should (equal (get-text-property 4 'face res)
 303                      '(annotation company-tooltip-annotation company-tooltip))))))
 304
 305 (ert-deftest company-column-with-composition ()
 306   :tags '(interactive)
 307   (with-temp-buffer
 308     (save-window-excursion
 309       (set-window-buffer nil (current-buffer))
 310       (insert "lambda ()")
 311       (compose-region 1 (1+ (length "lambda")) "\\")
 312       (should (= (company--column) 4)))))
 313
 314 (ert-deftest company-plainify ()
 315   (let ((tab-width 8))
 316     (should (equal-including-properties
 317              (company-plainify "\tabc\td\t")
 318              (concat "        "
 319                      "abc     "
 320                      "d       "))))
 321   (should (equal-including-properties
 322            (company-plainify (propertize "foobar" 'line-prefix "-*-"))
 323            "-*-foobar")))
 324
 325 (ert-deftest company-buffer-lines-with-lines-folded ()
 326   :tags '(interactive)
 327   (with-temp-buffer
 328     (insert (propertize "aaa\nbbb\nccc\nddd\n" 'display "aaa+\n"))
 329     (insert "eee\nfff\nggg")
 330     (should (equal (company-buffer-lines (point-min) (point-max))
 331                    '("aaa" "eee" "fff" "ggg")))))
 332
 333 (ert-deftest company-buffer-lines-with-multiline-display ()
 334   :tags '(interactive)
 335   (with-temp-buffer
 336     (insert (propertize "a" 'display "bbb\nccc\ndddd\n"))
 337     (insert "eee\nfff\nggg")
 338     (should (equal (company-buffer-lines (point-min) (point-max))
 339                    '("a" "" "" "eee" "fff" "ggg")))))
 340
 341 (ert-deftest company-buffer-lines-with-multiline-after-string-at-eob ()
 342   :tags '(interactive)
 343   (with-temp-buffer
 344     (insert "a\nb\nc\n")
 345     (let ((ov (make-overlay (point-max) (point-max) nil t t)))
 346       (overlay-put ov 'after-string "~\n~\n~"))
 347     (should (equal (company-buffer-lines (point-min) (point-max))
 348                    '("a" "b" "c")))))
 349
 350 (ert-deftest company-buffer-lines-with-line-wrapping ()
 351   :tags '(interactive)
 352   (with-temp-buffer
 353     (let ((ww (company--window-width)))
 354       (insert (make-string (* 3 ww) ?a))
 355       (should (equal (company-buffer-lines (point-min) (point-max))
 356                      (list (make-string ww ?a)
 357                            (make-string ww ?a)
 358                            (make-string ww ?a)))))))
 359
 360 (ert-deftest company-modify-line ()
 361   (let ((str "-*-foobar"))
 362     (should (equal-including-properties
 363              (company-modify-line str "zz" 4)
 364              "-*-fzzbar"))
 365     (should (equal-including-properties
 366              (company-modify-line str "xx" 0)
 367              "xx-foobar"))
 368     (should (equal-including-properties
 369              (company-modify-line str "zz" 10)
 370              "-*-foobar zz"))))
 371
 372 (ert-deftest company-scrollbar-bounds ()
 373   (should (equal nil (company--scrollbar-bounds 0 3 3)))
 374   (should (equal nil (company--scrollbar-bounds 0 4 3)))
 375   (should (equal '(0 . 0) (company--scrollbar-bounds 0 1 2)))
 376   (should (equal '(1 . 1) (company--scrollbar-bounds 2 2 4)))
 377   (should (equal '(2 . 3) (company--scrollbar-bounds 7 4 12)))
 378   (should (equal '(1 . 2) (company--scrollbar-bounds 3 4 12)))
 379   (should (equal '(1 . 3) (company--scrollbar-bounds 4 5 11))))