ADDED   rpctest/rpctest.scm
Index: rpctest/rpctest.scm
==================================================================
--- /dev/null
+++ rpctest/rpctest.scm
@@ -0,0 +1,71 @@
+;;;; rpc-demo.scm
+;;;; Simple database server / client
+
+(require-extension (srfi 18) extras tcp rpc sqlite3)
+
+;;; Common things
+
+(define operation (string->symbol (car (command-line-arguments))))
+(define param (cadr (command-line-arguments)))
+(print "Operation: " operation ", param: " param)
+
+(define rpc:listener
+  (if (eq? operation 'server)
+      (tcp-listen (rpc:default-server-port))
+      (tcp-listen 0)))
+
+;; Start server thread
+(define rpc:server
+  (make-thread
+   (cute (rpc:make-server rpc:listener) "rpc:server")
+   'rpc:server))
+
+(thread-start! rpc:server)
+
+;;; Server side
+
+(define (server)
+  (rpc:publish-procedure!
+   'change-response-port
+   (lambda (port)
+     (rpc:default-server-port port))
+   #f)
+  (let ((db (open-database param)))
+    (set-finalizer! db finalize!)
+    (rpc:publish-procedure!
+     'query
+     (lambda (sql callback)
+       (print "Executing query '" sql "' ...")
+       (for-each-row
+	callback
+	db sql))))
+  (thread-join! rpc:server))
+
+;;; Client side
+
+(define (callback1 . columns)
+  (let loop ((c columns) (i 0))
+    (unless (null? c)
+      (printf "~a=~s " i (car c))
+      (loop (cdr c) (+ i 1))))
+  (newline))
+
+(define callback2-results '())
+
+(define (callback2 . columns)
+  (set! callback2-results (cons columns callback2-results)))
+
+(define (client)
+  ((rpc:procedure 'change-response-port "localhost")
+   (tcp-listener-port rpc:listener))
+  ((rpc:procedure 'query "localhost") param callback1)
+  (rpc:publish-procedure! 'callback2 callback2)
+  ((rpc:procedure 'query "localhost") param callback2)
+  (pp callback2-results))
+
+;;; Run it
+
+(if (eq? operation 'server)
+    (server)
+    (client))
+