Commit 76523866 authored by João Távora's avatar João Távora

Add lisp/jsonrpc.el

* lisp/jsonrpc.el: New file

* test/lisp/jsonrpc-tests.el: New file
parent 08594a97
Pipeline #19 failed with stage
This diff is collapsed.
;;; jsonrpc-tests.el --- tests for jsonrpc.el -*- lexical-binding: t; -*-
;; Copyright (C) 2018 Free Software Foundation, Inc.
;; Author: João Távora <>
;; Maintainer: João Távora <>
;; Keywords: tests
;; 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
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <>.
;;; 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).
;;; Code:
(require 'ert)
(require 'jsonrpc)
(require 'eieio)
(defclass jsonrpc--test-endpoint (jsonrpc-process-connection)
((scp :accessor jsonrpc--shutdown-complete-p)))
(defclass jsonrpc--test-client (jsonrpc--test-endpoint)
((hold-deferred :initform t :accessor jsonrpc--hold-deferred)))
(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
:name "Emacs RPC server" :server t :host "localhost"
:service 0
:log (lambda (_server client _message)
(setq ,server
:name (process-name client)
:process client
(lambda (_endpoint method params)
(unless (memq method '(+ - * / vconcat append
sit-for ignore))
(signal 'jsonrpc-error
. "Sorry, this isn't allowed")
(jsonrpc-error-code . -32601))))
(apply method (append params nil)))
(lambda (conn)
(setf (jsonrpc--shutdown-complete-p conn) t)))))))
(,endpoint-sym (make-instance
"Emacs RPC client"
(open-network-stream "JSONRPC test tcp endpoint"
nil "localhost"
(process-contact ,listen-server
(lambda (conn)
(setf (jsonrpc--shutdown-complete-p conn) t)))))
(cl-assert ,endpoint-sym)
(kill-buffer (jsonrpc--events-buffer ,endpoint-sym))
(when ,server
(kill-buffer (jsonrpc--events-buffer ,server))))
(jsonrpc-shutdown ,endpoint-sym)
(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"))))))))
(ert-deftest returns-3 ()
"A basic test for adding two numbers in our test RPC."
(jsonrpc--with-emacsrpc-fixture (conn)
(should (= 3 (jsonrpc-request conn '+ [1 2])))))
(ert-deftest errors-with--32601 ()
"Errors with -32601"
(jsonrpc--with-emacsrpc-fixture (conn)
(condition-case err
(jsonrpc-request conn 'delete-directory "~/tmp")
(ert-fail "A `jsonrpc-error' should have been signalled!"))
(should (= -32601 (cdr (assoc 'jsonrpc-error-code (cdr err)))))))))
(ert-deftest signals-an--32603-JSONRPC-error ()
"Signals an -32603 JSONRPC error."
(jsonrpc--with-emacsrpc-fixture (conn)
(condition-case err
(jsonrpc-request conn '+ ["a" 2])
(ert-fail "A `jsonrpc-error' should have been signalled!"))
(should (= -32603 (cdr (assoc 'jsonrpc-error-code (cdr err)))))))))
(ert-deftest times-out ()
"Request for 3-sec sit-for with 1-sec timeout times out."
(jsonrpc--with-emacsrpc-fixture (conn)
(jsonrpc-request conn 'sit-for [3] :timeout 1))))
(ert-deftest doesnt-time-out ()
:tags '(:expensive-test)
"Request for 1-sec sit-for with 2-sec timeout succeeds."
(jsonrpc--with-emacsrpc-fixture (conn)
(jsonrpc-request conn 'sit-for [1] :timeout 2)))
(ert-deftest stretching-it-but-works ()
"Vector of numbers or vector of vector of numbers are serialized."
(jsonrpc--with-emacsrpc-fixture (conn)
;; (vconcat [1 2 3] [3 4 5]) => [1 2 3 3 4 5] which can be
;; serialized.
(should (equal
[1 2 3 3 4 5]
(jsonrpc-request conn 'vconcat [[1 2 3] [3 4 5]])))))
(ert-deftest json-el-cant-serialize-this ()
"Can't serialize a response that is half-vector/half-list."
(jsonrpc--with-emacsrpc-fixture (conn)
;; (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)
(and (cl-call-next-method)
(or (not (string-match "deferred" what))
(not (jsonrpc--hold-deferred conn)))))
(ert-deftest deferred-action-toolate ()
:tags '(:expensive-test)
"Deferred request fails because noone clears the flag."
(jsonrpc--with-emacsrpc-fixture (conn)
(jsonrpc-request conn '+ [1 2]
:deferred "deferred-testing" :timeout 0.5)
:type 'jsonrpc-error)
(= 3 (jsonrpc-request conn '+ [1 2]
:timeout 0.5)))))
(ert-deftest deferred-action-intime ()
:tags '(:expensive-test)
"Deferred request barely makes it after event clears a flag."
;; Send an async request, which returns immediately. However the
;; success fun which sets the flag only runs after some time.
(jsonrpc--with-emacsrpc-fixture (conn)
(jsonrpc-async-request conn
'sit-for [0.5]
(lambda (_result)
(setf (jsonrpc--hold-deferred conn) nil)))
;; Now wait for an answer to this request, which should be sent as
;; soon as the previous one is answered.
(= 3 (jsonrpc-request conn '+ [1 2]
:deferred "deferred"
:timeout 1)))))
(ert-deftest deferred-action-complex-tests ()
:tags '(:expensive-test)
"Test a more complex situation with deferred requests."
(jsonrpc--with-emacsrpc-fixture (conn)
(let (n-deferred-1
;; This returns immediately
'sit-for [0.1]
(lambda (_result)
;; this only gets runs after the "first deferred" is stashed.
(setq n-deferred-1
(hash-table-count (jsonrpc--deferred-actions conn)))))
;; This stashes the request and waits. It will error because
;; no-one clears the "hold deferred" flag.
(jsonrpc-request conn 'ignore ["first deferred"]
:deferred "first deferred"
:timeout 0.5)
:type 'jsonrpc-error)
;; The error means the deferred actions stash is now empty
(should (zerop (hash-table-count (jsonrpc--deferred-actions conn))))
;; Again, this returns immediately.
'sit-for [0.1]
(lambda (_result)
;; This gets run while "third deferred" below is waiting for
;; a reply. Notice that we clear the flag in time here.
(setq n-deferred-2 (hash-table-count (jsonrpc--deferred-actions conn)))
(setf (jsonrpc--hold-deferred conn) nil)))
;; This again stashes a request and returns immediately.
(jsonrpc-async-request conn 'ignore ["second deferred"]
:deferred "second deferred"
:timeout 1
(lambda (_result)
(setq second-deferred-went-through-p t)))
;; And this also stashes a request, but waits. Eventually the
;; flag is cleared in time and both requests go through.
(jsonrpc-request conn 'ignore ["third deferred"]
:deferred "third deferred"
:timeout 1)
(should second-deferred-went-through-p)
(should (eq 1 n-deferred-1))
(should (eq 2 n-deferred-2))
(should (eq 0 (hash-table-count (jsonrpc--deferred-actions conn)))))))
(provide 'jsonrpc-tests)
;;; jsonrpc-tests.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment