diff options
Diffstat (limited to 'third-party/s-xml-rpc/test/test-xml-rpc.lisp')
-rw-r--r-- | third-party/s-xml-rpc/test/test-xml-rpc.lisp | 176 |
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 |