Compile on CCL

with-unique-rpc-address macro

for tests

declaim special *mocked-namespace*

silence warnings

if slee-p then sleep

Fix with-unique-rpc-address

Actually make the address unique

:list now maps to type vector (not simple-vector)

See #72 (comment)

Explicitly wait for server thread to terminate

It is my understanding that bt:destroy-thread does not make a
guarantee about *when* a thread will be destroyed, only that the
destroy signal has been delivered. Or something like that. This does
seem hacky.

declaim *mocked-namespace* in the correct location

Explicitly wait for thread to be destroyed in tests (fixes CCL)

On non-CCL use the previous method of just `(bt:destroy-thread
server-thread)`

redundant concatenate -> format

Comment grammar

export with-unique-rpc-address from rpcq package

Test serialize/deserialize messages with lists

Docstring for with-unique-rpc-address

Leave FIXME note regarding thread killers

array-total-size -> length

fix

src-tests/suite.lisp

@@ -78,4 +78,22 @@
          (cloned (rpcq::deserialize (rpcq::serialize original))))
     (is (typep cloned 'rpcq::|RPCRequest|))
     (is (string= (rpcq::|RPCRequest-id| original)     (rpcq::|RPCRequest-id| cloned)))
-    (is (string= (rpcq::|RPCRequest-method| original) (rpcq::|RPCRequest-method| cloned)))))
+    (is (string= (rpcq::|RPCRequest-method| original) (rpcq::|RPCRequest-method| cloned))))
+
+  (let* ((warning (make-instance 'rpcq::|RPCWarning|
+                                 :|body| "The warning string."
+                                 :|kind| "The type of the warning raised."))
+         (original (make-instance 'rpcq::|RPCError|
+                                  :|error| "The error message."
+                                  :|id| "The RPC request id."
+                                  :|warnings| `#(,warning)))
+         (cloned (rpcq::deserialize (rpcq::serialize original))))
+    (is (typep cloned 'rpcq::|RPCError|))
+    (let ((cloned-warnings (rpcq::|RPCError-warnings| cloned)))
+      (is (typep cloned-warnings 'vector))
+      (is (= 1 (length cloned-warnings)))
+      (let ((cloned-warning (elt cloned-warnings 0)))
+        (is (string= (rpcq::|RPCWarning-body| warning)
+                     (rpcq::|RPCWarning-body| cloned-warning)))
+        (is (string= (rpcq::|RPCWarning-kind| warning)
+                     (rpcq::|RPCWarning-kind| cloned-warning)))))))

src-tests/test-rpc.lisp

@@ -7,87 +7,111 @@
 
 (defparameter *expected-response* "test-response")
 
-(defun test-method (&key (sleep 1 sleep-p))
-  (when sleep-p
+(defun test-method (&key (sleep 1 slee-p))
+  (when slee-p
     (sleep sleep))
   "test-response")
 
+;; TODO FIXME XXX The below relies on some funky/hacky/unsightly code
+;; to forcefully kill threads. See open issues
+;; https://github.com/rigetti/rpcq/issues/61
+;; https://github.com/rigetti/rpcq/issues/75
 
 (deftest test-client-server-dialogue ()
-  (let* ((server-function
-           (lambda ()
-             (let ((dt (rpcq:make-dispatch-table)))
-               (rpcq:dispatch-table-add-handler dt 'test-method)
-               (rpcq:start-server :dispatch-table dt
-                                  :listen-addresses '("inproc://RPCQ-test")))))
-         (server-thread (bt:make-thread server-function)))
-    (sleep 1)
-    (unwind-protect
-      ;; hook up the client
-      (rpcq:with-rpc-client (client "inproc://RPCQ-test")
-        ;; send a communique
-        (let ((server-response (rpcq:rpc-call client "test-method")))
-          (is (string= *expected-response* server-response))))
-      ;; kill the server thread
-      (bt:destroy-thread server-thread))))
+  (with-unique-rpc-address (addr)
+    (let* ((server-function
+             (lambda ()
+               (let ((dt (rpcq:make-dispatch-table)))
+                 (rpcq:dispatch-table-add-handler dt 'test-method)
+                 (rpcq:start-server :dispatch-table dt
+                                    :listen-addresses (list addr)))))
+           (server-thread (bt:make-thread server-function)))
+      (sleep 1)
+      (unwind-protect
+           ;; hook up the client
+           (rpcq:with-rpc-client (client addr)
+             ;; send a communique
+             (let ((server-response (rpcq:rpc-call client "test-method")))
+               (is (string= *expected-response* server-response))))
+        ;; kill the server thread
+        #+ccl
+        (loop :while (bt:thread-alive-p server-thread)
+              :do (sleep 1) (bt:destroy-thread server-thread))
+        #-ccl
+        (bt:destroy-thread server-thread)))))
 
 (deftest test-client-timeout ()
-  (let* ((server-function
-           (lambda ()
-             (let ((dt (rpcq:make-dispatch-table)))
-               (rpcq:dispatch-table-add-handler dt 'test-method)
-               (rpcq:start-server :dispatch-table dt
-                                  :listen-addresses '("inproc://RPCQ-test")))))
-         (server-thread (bt:make-thread server-function)))
-    (sleep 1)
-    (unwind-protect
-         ;; hook up the client
-         (rpcq:with-rpc-client (client "inproc://RPCQ-test" :timeout 1)
-               ;; send a communique
-               (signals sb-ext:timeout
-                 (rpcq:rpc-call client "test-method" :sleep 5)))
-      ;; kill the server thread
-      (bt:destroy-thread server-thread))))
+  (with-unique-rpc-address (addr)
+    (let* ((server-function
+             (lambda ()
+               (let ((dt (rpcq:make-dispatch-table)))
+                 (rpcq:dispatch-table-add-handler dt 'test-method)
+                 (rpcq:start-server :dispatch-table dt
+                                    :listen-addresses (list addr)))))
+           (server-thread (bt:make-thread server-function)))
+      (sleep 1)
+      (unwind-protect
+           ;; hook up the client
+           (rpcq:with-rpc-client (client addr :timeout 1)
+             ;; send a communique
+             (signals bt:timeout
+               (rpcq:rpc-call client "test-method" :sleep 5)))
+        ;; kill the server thread
+        #+ccl
+        (loop :while (bt:thread-alive-p server-thread)
+              :do (sleep 1) (bt:destroy-thread server-thread))
+        #-ccl
+        (bt:destroy-thread server-thread)))))
 
 (deftest test-server-timeout ()
-  (let* ((server-function
-           (lambda ()
-             (let ((dt (rpcq:make-dispatch-table)))
-               (rpcq:dispatch-table-add-handler dt 'test-method)
-               (rpcq:start-server :timeout 1
-                                  :dispatch-table dt
-                                  :listen-addresses '("inproc://RPCQ-test")))))
-         (server-thread (bt:make-thread server-function)))
-    (sleep 1)
-    (unwind-protect
-         ;; hook up the client
-         (rpcq:with-rpc-client (client "inproc://RPCQ-test")
-               ;; send a communique
-               (signals rpcq::rpc-error
-                 (rpcq:rpc-call client "test-method" :sleep 5)))
-      ;; kill the server thread
-      (bt:destroy-thread server-thread))))
+  (with-unique-rpc-address (addr)
+    (let* ((server-function
+             (lambda ()
+               (let ((dt (rpcq:make-dispatch-table)))
+                 (rpcq:dispatch-table-add-handler dt 'test-method)
+                 (rpcq:start-server :timeout 1
+                                    :dispatch-table dt
+                                    :listen-addresses (list addr)))))
+           (server-thread (bt:make-thread server-function)))
+      (sleep 1)
+      (unwind-protect
+           ;; hook up the client
+           (rpcq:with-rpc-client (client addr)
+             ;; send a communique
+             (signals rpcq::rpc-error
+               (rpcq:rpc-call client "test-method" :sleep 5)))
+        ;; kill the server thread
+        #+ccl
+        (loop :while (bt:thread-alive-p server-thread)
+              :do (sleep 1) (bt:destroy-thread server-thread))
+        #-ccl
+        (bt:destroy-thread server-thread)))))
 
 (defun served-method ()
   (warn "The purpose of this test is to communicate a warning.")
   "Some other reply payload.")
 
 (deftest test-server-warnings ()
-  (let* ((server-function
-           (lambda ()
-             (let ((dt (rpcq:make-dispatch-table)))
-               (rpcq:dispatch-table-add-handler dt 'served-method)
-               (rpcq:start-server :timeout 5
-                                  :dispatch-table dt
-                                  :listen-addresses '("inproc://RPCQ-test")))))
-         (server-thread (bt:make-thread server-function)))
-    (sleep 1)
-    (unwind-protect
-         ;; hook up the client
-         (rpcq:with-rpc-client (client "inproc://RPCQ-test")
-               ;; send a communique
-               (signals simple-warning
-                 (is (string= "Some other reply payload."
-                              (rpcq:rpc-call client "served-method")))))
-      ;; kill the server thread
-      (bt:destroy-thread server-thread))))
+  (with-unique-rpc-address (addr)
+    (let* ((server-function
+             (lambda ()
+               (let ((dt (rpcq:make-dispatch-table)))
+                 (rpcq:dispatch-table-add-handler dt 'served-method)
+                 (rpcq:start-server :timeout 5
+                                    :dispatch-table dt
+                                    :listen-addresses (list addr)))))
+           (server-thread (bt:make-thread server-function)))
+      (sleep 1)
+      (unwind-protect
+           ;; hook up the client
+           (rpcq:with-rpc-client (client addr)
+             ;; send a communique
+             (signals simple-warning
+               (is (string= "Some other reply payload."
+                            (rpcq:rpc-call client "served-method")))))
+        ;; kill the server thread
+        #+ccl
+        (loop :while (bt:thread-alive-p server-thread)
+              :do (sleep 1) (bt:destroy-thread server-thread))
+        #-ccl
+        (bt:destroy-thread server-thread)))))

src/package.lisp

@@ -27,6 +27,7 @@
            #:dispatch-table-add-handler
            #:start-server
            #:with-rpc-client
+           #:with-unique-rpc-address
            #:rpc-call
            ;; RPC client/server errors and error accessors
            #:not-an-rpcrequest

src/rpcq.lisp

@@ -37,7 +37,8 @@
       (t
        (cerror "Just use the \"messages\" namespace."
                "Couldn't determine a valid namespace.")
-       "messages"))))
+       "messages")))
+  (declaim (special *mocked-namespace*)))
 
 ;; store all messages defined thus far in their namespace
 (defvar *messages* (make-hash-table :test 'equal))
@@ -212,10 +213,10 @@ We distinguish between the following options for any field type:
 
     ;; handle lists
     ((eq ':list (car field-type))
-     ;; Need not check if REQUIRED as NIL is still of type list
-     ;; We use 'simple-vector rather than 'list as this maps better to
-     ;; the JSON distinction betweel null and []
-     (values 'simple-vector (coerce default 'simple-vector)))
+     ;; Need not check if REQUIRED as NIL is still of type list. We
+     ;; use 'vector rather than 'list as this maps better to the JSON
+     ;; distinction between null and []
+     (values 'vector (coerce default 'vector)))
 
     ;; handle mappings
     ((eq ':map (car field-type))

src/utilities.lisp

@@ -28,3 +28,8 @@
        (fboundp symbol)
        (not (macro-function symbol))
        (not (special-operator-p symbol))))
+
+(defmacro with-unique-rpc-address ((addr) &body body)
+  "Bind ADDR in the context of BODY to a unique address acceptable to RPCQ:START-SERVER."
+  `(let ((,addr (format nil "inproc://~a" (uuid:make-v4-uuid))))
+     ,@body))