Update of /project/s-xml-rpc/cvsroot/s-xml-rpc/test
In directory clnet:/tmp/cvs-serv18313/test
Modified Files:
test-extensions.lisp test-xml-rpc.lisp
Log Message:
* changes due to reporting and initial fixes by Alain Picard
* added support for whitespace handling
* iso8601->universal-time now accepts leading & trailing whitespace
* encode-xml-rpc-value now encodes t and nil correctly as boolean 1 and 0
* parsing doubles (using read-from-string) with reader macros disabled for security
* decode-xml-rpc now handles whitespace more correctly in <data> and <value> tags
* added several test cases and fixed older stop-server problem
--- /project/s-xml-rpc/cvsroot/s-xml-rpc/test/test-extensions.lisp 2004/06/17 19:43:11 1.1
+++ /project/s-xml-rpc/cvsroot/s-xml-rpc/test/test-extensions.lisp 2006/04/19 10:22:31 1.2
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: test-extensions.lisp,v 1.1 2004/06/17 19:43:11 rschlatte Exp $
+;;;; $Id: test-extensions.lisp,v 1.2 2006/04/19 10:22:31 scaekenberghe Exp $
;;;;
;;;; Unit and functional tests for xml-rpc.lisp
;;;;
@@ -13,7 +13,7 @@
(in-package :s-xml-rpc)
(let* ((server-port 8080)
- (server-process-name (start-xml-rpc-server :port server-port))
+ (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|
@@ -47,7 +47,7 @@
"system.methodHelp"
"params"
(list "system.multicall"))))))))
- (stop-server server-process-name)
+ (s-sysdeps:kill-process server-process)
(delete-package *xml-rpc-package*)))
;;;; eof
\ No newline at end of file
--- /project/s-xml-rpc/cvsroot/s-xml-rpc/test/test-xml-rpc.lisp 2005/02/11 11:04:45 1.2
+++ /project/s-xml-rpc/cvsroot/s-xml-rpc/test/test-xml-rpc.lisp 2006/04/19 10:22:31 1.3
@@ -1,6 +1,6 @@
;;;; -*- mode: lisp -*-
;;;;
-;;;; $Id: test-xml-rpc.lisp,v 1.2 2005/02/11 11:04:45 scaekenberghe Exp $
+;;;; $Id: test-xml-rpc.lisp,v 1.3 2006/04/19 10:22:31 scaekenberghe Exp $
;;;;
;;;; Unit and functional tests for xml-rpc.lisp
;;;;
@@ -48,13 +48,13 @@
#-clisp
(assert
- (let ((server-process-name (start-xml-rpc-server :port 8080)))
+ (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))
- (stop-server server-process-name)
+ (s-sysdeps:kill-process server-process)
(unintern 's-xml-rpc::xml-rpc-implementation-version :s-xml-rpc-exports))))
(assert
@@ -64,5 +64,84 @@
(struct-out (with-input-from-string (in xml)
(decode-xml-rpc in))))
(xml-rpc-struct-equal struct-in struct-out)))
-
-;;;; eof
\ No newline at end of file
+
+;; 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.214
+ ,(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")))
+
+;; 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>"))
+
+;;;; eof
