;;; core-tests.el --- company-mode tests -*- lexical-binding: t -*-
-;; Copyright (C) 2015 Free Software Foundation, Inc.
+;; Copyright (C) 2015, 2016 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
(should (equal '("abb" "abc" "abd" "acc" "acd")
(company-call-backend 'candidates "a"))))))
+(ert-deftest company-multi-backend-handles-keyword-separate ()
+ (let ((one (lambda (command &optional _)
+ (cl-case command
+ (prefix "a")
+ (candidates '("aa" "ca" "ba")))))
+ (two (lambda (command &optional _)
+ (cl-case command
+ (prefix "a")
+ (candidates '("bb" "ab")))))
+ (tri (lambda (command &optional _)
+ (cl-case command
+ (prefix "a")
+ (sorted t)
+ (candidates '("cc" "bc" "ac"))))))
+ (let ((company-backend (list one two tri :separate)))
+ (should (company-call-backend 'sorted))
+ (should-not (company-call-backend 'duplicates))
+ (should (equal '("aa" "ba" "ca" "ab" "bb" "cc" "bc" "ac")
+ (company-call-backend 'candidates "a"))))))
+
(ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
(with-temp-buffer
(insert "a")
(company-complete-selection)
(should (string= "tea-cup" (buffer-string))))))
+(defvar ct-sorted nil)
+
+(defun ct-equal-including-properties (list1 list2)
+ (or (and (not list1) (not list2))
+ (and (ert-equal-including-properties (car list1) (car list2))
+ (ct-equal-including-properties (cdr list1) (cdr list2)))))
+
+(ert-deftest company-strips-duplicates-returns-nil ()
+ (should (null (company--preprocess-candidates nil))))
+
+(ert-deftest company-strips-duplicates-within-groups ()
+ (let* ((kvs '(("a" . "b")
+ ("a" . nil)
+ ("a" . "b")
+ ("a" . "c")
+ ("a" . "b")
+ ("b" . "c")
+ ("b" . nil)
+ ("a" . "b")))
+ (fn (lambda (kvs)
+ (mapcar (lambda (kv) (propertize (car kv) 'ann (cdr kv)))
+ kvs)))
+ (company-backend
+ (lambda (command &optional arg)
+ (pcase command
+ (`prefix "")
+ (`sorted ct-sorted)
+ (`duplicates t)
+ (`annotation (get-text-property 0 'ann arg)))))
+ (reference '(("a" . "b")
+ ("a" . nil)
+ ("a" . "c")
+ ("b" . "c")
+ ("b" . nil)
+ ("a" . "b"))))
+ (let ((ct-sorted t))
+ (should (ct-equal-including-properties
+ (company--preprocess-candidates (funcall fn kvs))
+ (funcall fn reference))))
+ (should (ct-equal-including-properties
+ (company--preprocess-candidates (funcall fn kvs))
+ (funcall fn (butlast reference))))))
+
;;; Row and column
(ert-deftest company-column-with-composition ()