aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJoão Távora2018-07-02 15:57:24 +0100
committerJoão Távora2018-07-02 17:30:35 +0100
commit332f4656b019b58fed1de6e35769e83ff190908d (patch)
treea22f02d90e7b073bcd0208d14d6e349b5bf874e6
parentee3e432300054ca488896e39fca57b10d733330a (diff)
downloademacs-332f4656b019b58fed1de6e35769e83ff190908d.tar.gz
emacs-332f4656b019b58fed1de6e35769e83ff190908d.zip
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
-rw-r--r--lisp/jsonrpc.el10
-rw-r--r--test/lisp/jsonrpc-tests.el132
2 files changed, 77 insertions, 65 deletions
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index b77db716015..add2285bbe4 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -5,11 +5,11 @@
5;; Author: João Távora <joaotavora@gmail.com> 5;; Author: João Távora <joaotavora@gmail.com>
6;; Maintainer: João Távora <joaotavora@gmail.com> 6;; Maintainer: João Távora <joaotavora@gmail.com>
7;; Keywords: processes, languages, extensions 7;; Keywords: processes, languages, extensions
8;; Package-Requires: ((emacs "26.1")) 8;; Package-Requires: ((emacs "25.1"))
9;; Version: 1.0.0 9;; Version: 1.0.0
10 10
11;; This is an Elpa :core package. Don't use functionality that is not 11;; This is an Elpa :core package. Don't use functionality that is not
12;; compatible with Emacs 26.1. 12;; compatible with Emacs 25.1.
13 13
14;; This program is free software; you can redistribute it and/or modify 14;; This program is free software; you can redistribute it and/or modify
15;; it under the terms of the GNU General Public License as published by 15;; it under the terms of the GNU General Public License as published by
@@ -132,7 +132,7 @@ immediately."
132;;; 132;;;
133(cl-defmacro jsonrpc-lambda (cl-lambda-list &body body) 133(cl-defmacro jsonrpc-lambda (cl-lambda-list &body body)
134 (declare (indent 1) (debug (sexp &rest form))) 134 (declare (indent 1) (debug (sexp &rest form)))
135 (let ((e (gensym "jsonrpc-lambda-elem"))) 135 (let ((e (cl-gensym "jsonrpc-lambda-elem")))
136 `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e)))) 136 `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e))))
137 137
138(defun jsonrpc-events-buffer (connection) 138(defun jsonrpc-events-buffer (connection)
@@ -436,7 +436,9 @@ connection object, called when the process dies .")
436(defun jsonrpc--call-deferred (connection) 436(defun jsonrpc--call-deferred (connection)
437 "Call CONNECTION's deferred actions, who may again defer themselves." 437 "Call CONNECTION's deferred actions, who may again defer themselves."
438 (when-let ((actions (hash-table-values (jsonrpc--deferred-actions connection)))) 438 (when-let ((actions (hash-table-values (jsonrpc--deferred-actions connection))))
439 (jsonrpc--debug connection `(:maybe-run-deferred ,(mapcar #'caddr actions))) 439 (jsonrpc--debug connection `(:maybe-run-deferred
440 ,(mapcar (lambda (action) (car (cdr (cdr action))))
441 actions)))
440 (mapc #'funcall (mapcar #'car actions)))) 442 (mapc #'funcall (mapcar #'car actions))))
441 443
442(defun jsonrpc--process-sentinel (proc change) 444(defun jsonrpc--process-sentinel (proc change)
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index 9395ab6ac0a..16986eb46f6 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -22,11 +22,11 @@
22;;; Commentary: 22;;; Commentary:
23 23
24;; About "deferred" tests, `jsonrpc--test-client' has a flag that we 24;; About "deferred" tests, `jsonrpc--test-client' has a flag that we
25;; test this flag in the this `jsonrpc-connection-ready-p' API method. 25;; test in its `jsonrpc-connection-ready-p' API method. It holds any
26;; It holds any `jsonrpc-request's and `jsonrpc-async-request's 26;; `jsonrpc-request's and `jsonrpc-async-request's explicitly passed
27;; explicitly passed `:deferred'. After clearing the flag, the held 27;; `:deferred'. After clearing the flag, the held requests are
28;; requests are actually sent to the server in the next opportunity 28;; actually sent to the server in the next opportunity (when receiving
29;; (when receiving or sending something to the server). 29;; or sending something to the server).
30 30
31;;; Code: 31;;; Code:
32 32
@@ -40,59 +40,65 @@
40(defclass jsonrpc--test-client (jsonrpc--test-endpoint) 40(defclass jsonrpc--test-client (jsonrpc--test-endpoint)
41 ((hold-deferred :initform t :accessor jsonrpc--hold-deferred))) 41 ((hold-deferred :initform t :accessor jsonrpc--hold-deferred)))
42 42
43(defun jsonrpc--call-with-emacsrpc-fixture (fn)
44 "Do work for `jsonrpc--with-emacsrpc-fixture'. Call FN."
45 (let* (listen-server endpoint)
46 (unwind-protect
47 (progn
48 (setq listen-server
49 (make-network-process
50 :name "Emacs RPC server" :server t :host "localhost"
51 :service 44444
52 :log (lambda (listen-server client _message)
53 (push
54 (make-instance
55 'jsonrpc--test-endpoint
56 :name (process-name client)
57 :process client
58 :request-dispatcher
59 (lambda (_endpoint method params)
60 (unless (memq method '(+ - * / vconcat append
61 sit-for ignore))
62 (signal 'jsonrpc-error
63 `((jsonrpc-error-message
64 . "Sorry, this isn't allowed")
65 (jsonrpc-error-code . -32601))))
66 (apply method (append params nil)))
67 :on-shutdown
68 (lambda (conn)
69 (setf (jsonrpc--shutdown-complete-p conn) t)))
70 (process-get listen-server 'handlers)))))
71 (setq endpoint
72 (make-instance
73 'jsonrpc--test-client
74 "Emacs RPC client"
75 :process
76 (open-network-stream "JSONRPC test tcp endpoint"
77 nil "localhost"
78 (process-contact listen-server
79 :service))
80 :on-shutdown
81 (lambda (conn)
82 (setf (jsonrpc--shutdown-complete-p conn) t))))
83 (funcall fn endpoint))
84 (unwind-protect
85 (when endpoint
86 (kill-buffer (jsonrpc--events-buffer endpoint))
87 (jsonrpc-shutdown endpoint))
88 (when listen-server
89 (cl-loop do (delete-process listen-server)
90 while (progn (accept-process-output nil 0.1)
91 (process-live-p listen-server))
92 do (jsonrpc--message
93 "test listen-server is still running, waiting"))
94 (cl-loop for handler in (process-get listen-server 'handlers)
95 do (ignore-errors (jsonrpc-shutdown handler)))
96 (mapc #'kill-buffer
97 (mapcar #'jsonrpc--events-buffer
98 (process-get listen-server 'handlers))))))))
99
43(cl-defmacro jsonrpc--with-emacsrpc-fixture ((endpoint-sym) &body body) 100(cl-defmacro jsonrpc--with-emacsrpc-fixture ((endpoint-sym) &body body)
44 (declare (indent 1) (debug t)) 101 `(jsonrpc--call-with-emacsrpc-fixture (lambda (,endpoint-sym) ,@body)))
45 (let ((server (gensym "server-")) (listen-server (gensym "listen-server-")))
46 `(let* (,server
47 (,listen-server
48 (make-network-process
49 :name "Emacs RPC server" :server t :host "localhost"
50 :service 0
51 :log (lambda (_server client _message)
52 (setq ,server
53 (make-instance
54 'jsonrpc--test-endpoint
55 :name (process-name client)
56 :process client
57 :request-dispatcher
58 (lambda (_endpoint method params)
59 (unless (memq method '(+ - * / vconcat append
60 sit-for ignore))
61 (signal 'jsonrpc-error
62 `((jsonrpc-error-message
63 . "Sorry, this isn't allowed")
64 (jsonrpc-error-code . -32601))))
65 (apply method (append params nil)))
66 :on-shutdown
67 (lambda (conn)
68 (setf (jsonrpc--shutdown-complete-p conn) t)))))))
69 (,endpoint-sym (make-instance
70 'jsonrpc--test-client
71 "Emacs RPC client"
72 :process
73 (open-network-stream "JSONRPC test tcp endpoint"
74 nil "localhost"
75 (process-contact ,listen-server
76 :service))
77 :on-shutdown
78 (lambda (conn)
79 (setf (jsonrpc--shutdown-complete-p conn) t)))))
80 (unwind-protect
81 (progn
82 (cl-assert ,endpoint-sym)
83 ,@body
84 (kill-buffer (jsonrpc--events-buffer ,endpoint-sym))
85 (when ,server
86 (kill-buffer (jsonrpc--events-buffer ,server))))
87 (unwind-protect
88 (jsonrpc-shutdown ,endpoint-sym)
89 (unwind-protect
90 (jsonrpc-shutdown ,server)
91 (cl-loop do (delete-process ,listen-server)
92 while (progn (accept-process-output nil 0.1)
93 (process-live-p ,listen-server))
94 do (jsonrpc--message
95 "test listen-server is still running, waiting"))))))))
96 102
97(ert-deftest returns-3 () 103(ert-deftest returns-3 ()
98 "A basic test for adding two numbers in our test RPC." 104 "A basic test for adding two numbers in our test RPC."
@@ -143,10 +149,10 @@
143(ert-deftest json-el-cant-serialize-this () 149(ert-deftest json-el-cant-serialize-this ()
144 "Can't serialize a response that is half-vector/half-list." 150 "Can't serialize a response that is half-vector/half-list."
145 (jsonrpc--with-emacsrpc-fixture (conn) 151 (jsonrpc--with-emacsrpc-fixture (conn)
146 (should-error 152 (should-error
147 ;; (append [1 2 3] [3 4 5]) => (1 2 3 . [3 4 5]), which can't be 153 ;; (append [1 2 3] [3 4 5]) => (1 2 3 . [3 4 5]), which can't be
148 ;; serialized 154 ;; serialized
149 (jsonrpc-request conn 'append [[1 2 3] [3 4 5]])))) 155 (jsonrpc-request conn 'append [[1 2 3] [3 4 5]]))))
150 156
151(cl-defmethod jsonrpc-connection-ready-p 157(cl-defmethod jsonrpc-connection-ready-p
152 ((conn jsonrpc--test-client) what) 158 ((conn jsonrpc--test-client) what)
@@ -231,6 +237,10 @@
231 (jsonrpc-request conn 'ignore ["third deferred"] 237 (jsonrpc-request conn 'ignore ["third deferred"]
232 :deferred "third deferred" 238 :deferred "third deferred"
233 :timeout 1) 239 :timeout 1)
240 ;; Wait another 0.5 secs just in case the success handlers of
241 ;; one of these last two requests didn't quite have a chance to
242 ;; run (Emacs 25.2 apparentely needs this).
243 (accept-process-output nil 0.5)
234 (should second-deferred-went-through-p) 244 (should second-deferred-went-through-p)
235 (should (eq 1 n-deferred-1)) 245 (should (eq 1 n-deferred-1))
236 (should (eq 2 n-deferred-2)) 246 (should (eq 2 n-deferred-2))