From 332f4656b019b58fed1de6e35769e83ff190908d Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Mon, 2 Jul 2018 15:57:24 +0100 Subject: [PATCH] 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 b77db716015..add2285bbe4 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -5,11 +5,11 @@ ;; Author: João Távora ;; Maintainer: João Távora ;; 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 9395ab6ac0a..16986eb46f6 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)) -- 2.39.2