diff options
| author | João Távora | 2018-07-02 15:57:24 +0100 |
|---|---|---|
| committer | João Távora | 2018-07-02 17:30:35 +0100 |
| commit | 332f4656b019b58fed1de6e35769e83ff190908d (patch) | |
| tree | a22f02d90e7b073bcd0208d14d6e349b5bf874e6 | |
| parent | ee3e432300054ca488896e39fca57b10d733330a (diff) | |
| download | emacs-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.el | 10 | ||||
| -rw-r--r-- | test/lisp/jsonrpc-tests.el | 132 |
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)) |