1 files changed, 176 insertions, 0 deletions
diff --git a/third-party/s-xml-rpc/test/test-xml-rpc.lisp b/third-party/s-xml-rpc/test/test-xml-rpc.lisp
new file mode 100644
index 0000000..3933a88
--- /dev/null
+++ b/third-party/s-xml-rpc/test/test-xml-rpc.lisp
@@ -0,0 +1,176 @@
+;;;; -*- mode: lisp -*-
+;;;;
+;;;; $Id: test-xml-rpc.lisp,v 1.4 2008-02-15 15:42:40 scaekenberghe Exp $
+;;;;
+;;;; Unit and functional tests for xml-rpc.lisp
+;;;;
+;;;; Copyright (C) 2002, 2004 Sven Van Caekenberghe, Beta Nine BVBA.
+;;;;
+;;;; 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)
+
+(assert
+ (let ((now (get-universal-time)))
+   (equal (iso8601->universal-time (universal-time->iso8601 now))
+	  now)))
+
+(assert
+ (equal (with-input-from-string (in (encode-xml-rpc-call "add" 1 2))
+	  (decode-xml-rpc in))
+	'("add" 1 2)))
+
+(assert
+ (equal (with-input-from-string (in (encode-xml-rpc-result '(1 2)))
+	  (car (decode-xml-rpc in)))
+	'(1 2)))
+
+(let ((condition (with-input-from-string (in (encode-xml-rpc-fault "Fatal Error" 100))
+		   (decode-xml-rpc in))))
+  (assert (typep condition 'xml-rpc-fault))
+  (assert (equal (xml-rpc-fault-string condition) "Fatal Error"))
+  (assert (equal (xml-rpc-fault-code condition) 100)))
+
+(assert
+ (xml-rpc-time-p (xml-rpc-call (encode-xml-rpc-call "currentTime.getCurrentTime")
+			       :host "time.xmlrpc.com")))
+
+(assert
+ (equal (xml-rpc-call (encode-xml-rpc-call "examples.getStateName" 41)
+		      :host "betty.userland.com")
+	"South Dakota"))
+
+(assert
+ (equal (call-xml-rpc-server '(:host "betty.userland.com") "examples.getStateName" 41)
+	"South Dakota"))
+
+#-clisp
+(assert
+ (let ((server-process (start-xml-rpc-server :port 8080)))
+   (import 's-xml-rpc::xml-rpc-implementation-version :s-xml-rpc-exports)
+   (sleep 1) ; give the server some time to come up ;-)
+   (unwind-protect
+       (equal (xml-rpc-call (encode-xml-rpc-call "XML-RPC-IMPLEMENTATION-VERSION") :port 8080)
+	      (xml-rpc-implementation-version))
+     (s-sysdeps:kill-process server-process)
+     (unintern 's-xml-rpc::xml-rpc-implementation-version :s-xml-rpc-exports))))
+
+(assert
+    (let* ((struct-in (xml-rpc-struct :foo 100 :bar ""))
+           (xml (with-output-to-string (out)
+                  (encode-xml-rpc-value struct-in out)))
+           (struct-out (with-input-from-string (in xml)
+                         (decode-xml-rpc in))))
+      (xml-rpc-struct-equal struct-in struct-out)))
+
+;; testing whitespace handling
+
+(assert (null (decode-xml-rpc (make-string-input-stream 
+"<array>
+  <data>  
+  </data>
+</array>")))) 
+
+(assert (equalp (decode-xml-rpc (make-string-input-stream
+"<params>
+  <param>
+    <value>
+       foo
+    </value>
+  </param>
+  <param>
+    <value>
+      <array>
+        <data>
+          <value><i4>12</i4></value>
+          <value><string>Egypt</string></value>
+          <value><boolean>1</boolean></value>
+          <value> <string>      </string> </value>
+          <value>   </value>
+          <value> fgo </value>
+          <value><i4>-31</i4></value>
+          <value></value>
+          <double>		-12.214 </double>
+          <dateTime.iso8601>
+                 19980717T14:08:55 </dateTime.iso8601>
+          <base64>eW91IGNhbid0IHJlYWQgdGhpcyE=</base64>
+        </data>
+      </array>
+    </value>
+  </param>
+</params>"))
+`("
+       foo
+    " 
+  (12 
+   "Egypt" 
+   T 
+   "      " 
+   "   " 
+   " fgo " 
+   -31 
+   "" 
+   -12.214D0 
+   ,(xml-rpc-time (iso8601->universal-time  "19980717T14:08:55")) 
+   #(121 111 117 32 99 97 110 39 116 32 114 101 97 100 32 116 104 105 115 33)))))
+
+(assert (equalp (decode-xml-rpc (make-string-input-stream 
+"<array>
+  <data>
+    <value></value>
+  </data>
+</array>"))
+'("")))
+
+(assert (equalp (decode-xml-rpc (make-string-input-stream 
+"<array>
+  <data>
+    <value>
+      <string>XYZ</string>
+    </value>
+  </data>
+</array>"))
+'("XYZ")))
+
+;; double decoding
+
+(assert (< (abs (- (decode-xml-rpc (make-string-input-stream "<value><double>3.141592653589793</double></value>"))
+                   pi))
+           0.000000000001D0))
+
+;; string decoding
+
+(assert (equal (decode-xml-rpc (make-string-input-stream "<value><string>foo</string></value>"))
+               "foo"))
+
+(assert (equal (decode-xml-rpc (make-string-input-stream "<value>foo</value>"))
+               "foo"))
+
+(assert (equal (decode-xml-rpc (make-string-input-stream "<value><string></string></value>"))
+               ""))
+
+(assert (equal (decode-xml-rpc (make-string-input-stream "<value></value>"))
+               ""))
+
+;; boolean encoding
+
+(assert (equal (with-output-to-string (out)
+                 (encode-xml-rpc-value t out))
+               "<value><boolean>1</boolean></value>"))
+
+(assert (equal (with-output-to-string (out)
+                 (encode-xml-rpc-value nil out))
+               "<value><boolean>0</boolean></value>"))
+
+
+;; boolean decoding
+
+(assert (equal (decode-xml-rpc (make-string-input-stream "<value><boolean>1</boolean></value>"))
+               t))
+
+(assert (equal (decode-xml-rpc (make-string-input-stream "<value><boolean>0</boolean></value>"))
+               nil))
+
+;;;; eof