From ddb83b1fb2d305e0c06fc067d82d6bab5458b0fd Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Fri, 30 Oct 2009 20:52:07 +0100
Subject: Add third-party XML processing libraries.

Ignore-this: 5ca28497555bf944858ca2f58bc8a62b

darcs-hash:a0b0f9baa7c9b1259e755435db1fb17123630a6c
---
 third-party/s-xml-rpc/test/test-extensions.lisp | 53 +++++++++++++++++++++++++
 1 file changed, 53 insertions(+)
 create mode 100644 third-party/s-xml-rpc/test/test-extensions.lisp

(limited to 'third-party/s-xml-rpc/test/test-extensions.lisp')

diff --git a/third-party/s-xml-rpc/test/test-extensions.lisp b/third-party/s-xml-rpc/test/test-extensions.lisp
new file mode 100644
index 0000000..a3e3eb0
--- /dev/null
+++ b/third-party/s-xml-rpc/test/test-extensions.lisp
@@ -0,0 +1,53 @@
+;;;; -*- mode: lisp -*-
+;;;;
+;;;; $Id: test-extensions.lisp,v 1.2 2006-04-19 10:22:31 scaekenberghe Exp $
+;;;;
+;;;; Unit and functional tests for xml-rpc.lisp
+;;;;
+;;;; Copyright (C) 2004 Rudi Schlatte
+;;;;
+;;;; You are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser General Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+
+(in-package :s-xml-rpc)
+
+(let* ((server-port 8080)
+       (server-process (start-xml-rpc-server :port server-port))
+       (server-args `(:port ,server-port))
+       (*xml-rpc-package* (make-package (gensym)))
+       (symbols '(|system.listMethods| |system.methodSignature|
+                  |system.methodHelp| |system.multicall|
+                  |system.getCapabilities|)))
+  (import symbols *xml-rpc-package*)
+  (sleep 1)                 ; give the server some time to come up ;-)
+  (unwind-protect
+       (progn
+         (assert
+          (equal (sort (call-xml-rpc-server server-args "system.listMethods")
+                       #'string<)
+                 (sort (mapcar #'string symbols) #'string<)))
+         (assert
+          (every #'string=
+                 (mapcar (lambda (name)
+                           (call-xml-rpc-server server-args "system.methodHelp"
+                                                name))
+                         symbols)
+                 (mapcar (lambda (name)
+                           (or (documentation name 'function) ""))
+                         symbols)))
+         (assert
+          (= 2
+             (length (call-xml-rpc-server
+                      server-args "system.multicall"
+                      (list
+                       (xml-rpc-struct "methodName"
+                                       "system.listMethods")
+                       (xml-rpc-struct "methodName"
+                                       "system.methodHelp"
+                                       "params"
+                                       (list "system.multicall"))))))))
+    (s-sysdeps:kill-process server-process)
+    (delete-package *xml-rpc-package*)))
+
+;;;; eof
\ No newline at end of file
-- 
cgit v1.2.3