company--merge-async: Handle mixed sync/async and immediate callbacks better

Fixes #315

diff --git a/company.el b/company.el
index af4671ecf1d2f8dec0d96273042572ab73c2c8f7..ce0b5a46c8103fc5ab412d9b994593a6cb4c5063 100644 (file)
--- a/company.el
+++ b/company.el
@@ -5,7 +5,7 @@
 ;; Author: Nikolaj Schumacher
 ;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
 ;; URL: http://company-mode.github.io/
-;; Version: 0.8.11
+;; Version: 0.8.12
 ;; Keywords: abbrev, convenience, matching
 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
 
@@ -934,26 +934,26 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
       (cons
        :async
        (lambda (callback)
-         (let* (lst pending
+         (let* (lst
+                (pending (mapcar #'car pairs))
                 (finisher (lambda ()
                             (unless pending
                               (funcall callback
                                        (funcall merger
                                                 (nreverse lst)))))))
            (dolist (pair pairs)
-             (let ((val (car pair))
-                   (mapper (cdr pair)))
+             (push nil lst)
+             (let* ((cell lst)
+                    (val (car pair))
+                    (mapper (cdr pair))
+                    (this-finisher (lambda (res)
+                                     (setq pending (delq val pending))
+                                     (setcar cell (funcall mapper res))
+                                     (funcall finisher))))
                (if (not (eq :async (car-safe val)))
-                   (push (funcall mapper val) lst)
-                 (push nil lst)
-                 (let ((cell lst)
-                       (fetcher (cdr val)))
-                   (push fetcher pending)
-                   (funcall fetcher
-                            (lambda (res)
-                              (setq pending (delq fetcher pending))
-                              (setcar cell (funcall mapper res))
-                              (funcall finisher)))))))))))))
+                   (funcall this-finisher val)
+                 (let ((fetcher (cdr val)))
+                   (funcall fetcher this-finisher)))))))))))
 
 (defun company--prefix-str (prefix)
   (or (car-safe prefix) prefix))

diff --git a/test/async-tests.el b/test/async-tests.el
index 5d8be3e837372f07c42b038467680f9aad920607..c548898514453e7f0f4aa94bf8bf998f6480f57c 100644 (file)
--- a/test/async-tests.el
+++ b/test/async-tests.el
@@ -159,3 +159,59 @@
                      (company-call-backend 'candidates "foo")))
       (let ((company-backend (list immediate)))
         (should (equal '("f") (company-call-backend 'candidates "foo")))))))
+
+(ert-deftest company-multi-backend-merges-deferred-candidates-2 ()
+  (with-temp-buffer
+    (let ((company-backend (list (lambda (command &optional _)
+                                   (pcase command
+                                     (`prefix "foo")
+                                     (`candidates
+                                      (cons :async
+                                            (lambda (cb) (funcall cb '("a" "b")))))))
+                                 (lambda (command &optional _)
+                                   (pcase command
+                                     (`prefix "foo")
+                                     (`candidates
+                                      (cons :async
+                                            (lambda (cb) (funcall cb '("c" "d")))))))
+                                 (lambda (command &optional _)
+                                   (pcase command
+                                     (`prefix "foo")
+                                     (`candidates
+                                      (cons :async
+                                            (lambda (cb) (funcall cb '("e" "f"))))))))))
+      (should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
+      (should (equal '("a" "b" "c" "d" "e" "f")
+                     (company-call-backend 'candidates "foo"))))))
+
+(ert-deftest company-multi-backend-merges-deferred-candidates-3 ()
+  (with-temp-buffer
+    (let ((company-backend (list (lambda (command &optional _)
+                                   (pcase command
+                                     (`prefix "foo")
+                                     (`candidates
+                                      (cons :async
+                                            (lambda (cb) (funcall cb '("a" "b")))))))
+                                 (lambda (command &optional _)
+                                   (pcase command
+                                     (`prefix "foo")
+                                     (`candidates
+                                      (cons :async
+                                            (lambda (cb)
+                                              (run-with-timer
+                                               0.01 nil
+                                               (lambda ()
+                                                 (funcall cb '("c" "d")))))))))
+                                 (lambda (command &optional _)
+                                   (pcase command
+                                     (`prefix "foo")
+                                     (`candidates
+                                      (cons :async
+                                            (lambda (cb)
+                                              (run-with-timer
+                                               0.01 nil
+                                               (lambda ()
+                                                 (funcall cb '("e" "f"))))))))))))
+      (should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
+      (should (equal '("a" "b" "c" "d" "e" "f")
+                     (company-call-backend 'candidates "foo"))))))