[Emacs-diffs] master 332f465: Make lisp/jsonrpc.el work with Emacs 25.1

[João Távora]

branch: master
commit 332f4656b019b58fed1de6e35769e83ff190908d
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    Make lisp/jsonrpc.el work with Emacs 25.1
    
    * jsonrpc.el (Package-Requires): Require Emacs 25.1
    (jsonrpc-lambda): Use cl-gensym.
    (jsonrpc--call-deferred): Caddr doesn't exist in
    emacs 25.1.
    
    * jsonrpc-tests.el
    (jsonrpc--call-with-emacsrpc-fixture): New function.
    (jsonrpc--with-emacsrpc-fixture): Use it.
    (deferred-action-complex-tests): Adjust test for Emacs 25.1
---
 lisp/jsonrpc.el            |  10 ++--
 test/lisp/jsonrpc-tests.el | 132 ++++++++++++++++++++++++---------------------
 2 files changed, 77 insertions(+), 65 deletions(-)

diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index b77db71..add2285 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -5,11 +5,11 @@
 ;; Author: João Távora <address@hidden>
 ;; Maintainer: João Távora <address@hidden>
 ;; Keywords: processes, languages, extensions
-;; Package-Requires: ((emacs "26.1"))
+;; Package-Requires: ((emacs "25.1"))
 ;; Version: 1.0.0
 
 ;; This is an Elpa :core package.  Don't use functionality that is not
-;; compatible with Emacs 26.1.
+;; compatible with Emacs 25.1.
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -132,7 +132,7 @@ immediately."
 ;;;
 (cl-defmacro jsonrpc-lambda (cl-lambda-list &body body)
   (declare (indent 1) (debug (sexp &rest form)))
-  (let ((e (gensym "jsonrpc-lambda-elem")))
+  (let ((e (cl-gensym "jsonrpc-lambda-elem")))
     `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e))))
 
 (defun jsonrpc-events-buffer (connection)
@@ -436,7 +436,9 @@ connection object, called when the process dies .")
 (defun jsonrpc--call-deferred (connection)
   "Call CONNECTION's deferred actions, who may again defer themselves."
   (when-let ((actions (hash-table-values (jsonrpc--deferred-actions 
connection))))
-    (jsonrpc--debug connection `(:maybe-run-deferred ,(mapcar #'caddr 
actions)))
+    (jsonrpc--debug connection `(:maybe-run-deferred
+                                 ,(mapcar (lambda (action) (car (cdr (cdr 
action))))
+                                          actions)))
     (mapc #'funcall (mapcar #'car actions))))
 
 (defun jsonrpc--process-sentinel (proc change)
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index 9395ab6..16986eb 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -22,11 +22,11 @@
 ;;; Commentary:
 
 ;; About "deferred" tests, `jsonrpc--test-client' has a flag that we
-;; test this flag in the this `jsonrpc-connection-ready-p' API method.
-;; It holds any `jsonrpc-request's and `jsonrpc-async-request's
-;; explicitly passed `:deferred'.  After clearing the flag, the held
-;; requests are actually sent to the server in the next opportunity
-;; (when receiving or sending something to the server).
+;; test in its `jsonrpc-connection-ready-p' API method.  It holds any
+;; `jsonrpc-request's and `jsonrpc-async-request's explicitly passed
+;; `:deferred'.  After clearing the flag, the held requests are
+;; actually sent to the server in the next opportunity (when receiving
+;; or sending something to the server).
 
 ;;; Code:
 
@@ -40,59 +40,65 @@
 (defclass jsonrpc--test-client (jsonrpc--test-endpoint)
   ((hold-deferred :initform t :accessor jsonrpc--hold-deferred)))
 
+(defun jsonrpc--call-with-emacsrpc-fixture (fn)
+  "Do work for `jsonrpc--with-emacsrpc-fixture'.  Call FN."
+  (let* (listen-server endpoint)
+    (unwind-protect
+        (progn
+          (setq listen-server
+                (make-network-process
+                 :name "Emacs RPC server" :server t :host "localhost"
+                 :service 44444
+                 :log (lambda (listen-server client _message)
+                        (push
+                         (make-instance
+                          'jsonrpc--test-endpoint
+                          :name (process-name client)
+                          :process client
+                          :request-dispatcher
+                          (lambda (_endpoint method params)
+                            (unless (memq method '(+ - * / vconcat append
+                                                     sit-for ignore))
+                              (signal 'jsonrpc-error
+                                      `((jsonrpc-error-message
+                                         . "Sorry, this isn't allowed")
+                                        (jsonrpc-error-code . -32601))))
+                            (apply method (append params nil)))
+                          :on-shutdown
+                          (lambda (conn)
+                            (setf (jsonrpc--shutdown-complete-p conn) t)))
+                         (process-get listen-server 'handlers)))))
+          (setq endpoint
+                (make-instance
+                 'jsonrpc--test-client
+                 "Emacs RPC client"
+                 :process
+                 (open-network-stream "JSONRPC test tcp endpoint"
+                                      nil "localhost"
+                                      (process-contact listen-server
+                                                       :service))
+                 :on-shutdown
+                 (lambda (conn)
+                   (setf (jsonrpc--shutdown-complete-p conn) t))))
+          (funcall fn endpoint))
+      (unwind-protect
+          (when endpoint
+            (kill-buffer (jsonrpc--events-buffer endpoint))
+            (jsonrpc-shutdown endpoint))
+        (when listen-server
+          (cl-loop do (delete-process listen-server)
+                   while (progn (accept-process-output nil 0.1)
+                                (process-live-p listen-server))
+                   do (jsonrpc--message
+                       "test listen-server is still running, waiting"))
+          (cl-loop for handler in (process-get listen-server 'handlers)
+                   do (ignore-errors (jsonrpc-shutdown handler)))
+          (mapc #'kill-buffer
+                (mapcar #'jsonrpc--events-buffer
+                        (process-get listen-server 'handlers))))))))
+
 (cl-defmacro jsonrpc--with-emacsrpc-fixture ((endpoint-sym) &body body)
-  (declare (indent 1) (debug t))
-  (let ((server (gensym "server-")) (listen-server (gensym "listen-server-")))
-    `(let* (,server
-            (,listen-server
-             (make-network-process
-              :name "Emacs RPC server" :server t :host "localhost"
-              :service 0
-              :log (lambda (_server client _message)
-                     (setq ,server
-                           (make-instance
-                            'jsonrpc--test-endpoint
-                            :name (process-name client)
-                            :process client
-                            :request-dispatcher
-                            (lambda (_endpoint method params)
-                              (unless (memq method '(+ - * / vconcat append
-                                                       sit-for ignore))
-                                (signal 'jsonrpc-error
-                                        `((jsonrpc-error-message
-                                           . "Sorry, this isn't allowed")
-                                          (jsonrpc-error-code . -32601))))
-                              (apply method (append params nil)))
-                            :on-shutdown
-                            (lambda (conn)
-                              (setf (jsonrpc--shutdown-complete-p conn) 
t)))))))
-            (,endpoint-sym (make-instance
-                            'jsonrpc--test-client
-                            "Emacs RPC client"
-                            :process
-                            (open-network-stream "JSONRPC test tcp endpoint"
-                                                 nil "localhost"
-                                                 (process-contact 
,listen-server
-                                                                  :service))
-                            :on-shutdown
-                            (lambda (conn)
-                              (setf (jsonrpc--shutdown-complete-p conn) t)))))
-       (unwind-protect
-           (progn
-             (cl-assert ,endpoint-sym)
-             ,@body
-             (kill-buffer (jsonrpc--events-buffer ,endpoint-sym))
-             (when ,server
-               (kill-buffer (jsonrpc--events-buffer ,server))))
-         (unwind-protect
-             (jsonrpc-shutdown ,endpoint-sym)
-           (unwind-protect
-               (jsonrpc-shutdown ,server)
-             (cl-loop do (delete-process ,listen-server)
-                      while (progn (accept-process-output nil 0.1)
-                                   (process-live-p ,listen-server))
-                      do (jsonrpc--message
-                          "test listen-server is still running, 
waiting"))))))))
+  `(jsonrpc--call-with-emacsrpc-fixture (lambda (,endpoint-sym) ,@body)))
 
 (ert-deftest returns-3 ()
   "A basic test for adding two numbers in our test RPC."
@@ -143,10 +149,10 @@
 (ert-deftest json-el-cant-serialize-this ()
   "Can't serialize a response that is half-vector/half-list."
   (jsonrpc--with-emacsrpc-fixture (conn)
-    (should-error
-     ;; (append [1 2 3] [3 4 5]) => (1 2 3 . [3 4 5]), which can't be
-     ;; serialized
-     (jsonrpc-request conn 'append [[1 2 3] [3 4 5]]))))
+                                  (should-error
+                                   ;; (append [1 2 3] [3 4 5]) => (1 2 3 . [3 
4 5]), which can't be
+                                   ;; serialized
+                                   (jsonrpc-request conn 'append [[1 2 3] [3 4 
5]]))))
 
 (cl-defmethod jsonrpc-connection-ready-p
   ((conn jsonrpc--test-client) what)
@@ -231,6 +237,10 @@
       (jsonrpc-request conn 'ignore ["third deferred"]
                        :deferred "third deferred"
                        :timeout 1)
+      ;; Wait another 0.5 secs just in case the success handlers of
+      ;; one of these last two requests didn't quite have a chance to
+      ;; run (Emacs 25.2 apparentely needs this).
+      (accept-process-output nil 0.5)
       (should second-deferred-went-through-p)
       (should (eq 1 n-deferred-1))
       (should (eq 2 n-deferred-2))