[bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
BKNR Commits
bknr at bknr.net
Mon Feb 16 12:00:16 UTC 2009
Revision: 4255
Author: hans
URL: http://bknr.net/trac/changeset/4255
add some documentation on the testing facility
U trunk/thirdparty/hunchentoot/doc/index.xml
U trunk/thirdparty/hunchentoot/test/script-engine.lisp
U trunk/thirdparty/hunchentoot/test/script.lisp
Modified: trunk/thirdparty/hunchentoot/doc/index.xml
===================================================================
--- trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-12 23:38:00 UTC (rev 4254)
+++ trunk/thirdparty/hunchentoot/doc/index.xml 2009-02-16 12:00:15 UTC (rev 4255)
@@ -2592,12 +2592,51 @@
using <clix:ref>RAW-POST-DATA</clix:ref> instead of reading
the request body using a flexi stream. Usually, this is
automatically done right by Hunchentoot to read POST data, and
- you should only use the <clix:arg>want-stream</clix:arg> keyword argument to the
- <clix:ref>RAW-POST-DATA</clix:ref> in rare circumstances.
+ you should only use the <clix:arg>want-stream</clix:arg>
+ keyword argument to the <clix:ref>RAW-POST-DATA</clix:ref> in
+ rare circumstances.
</li>
</ul>
</clix:chapter>
+ <clix:chapter name="testing" title="Testing">
+ Hunchentoot comes with a test script that verifies that the
+ example web server responds as expected. This test script uses the
+ <a href="http://weitz.de/drakma/">Drakma</a> HTTP client library
+ and thus shares a significant amount of its base code with
+ Hunchentoot itself. Still, running the test script is a useful
+ confidence test, and it is also possible to run the script across
+ machines in order to verify a new Hunchentoot (or, for that matter
+ Drakma) port.
+ <p>
+ To run the confidence test, start
+ the <clix:ref>example</clix:ref> web server. Then, in your Lisp
+ listener, type
+<pre>(hunchentoot-test:test-hunchentoot "http://localhost:4242")</pre>
+ You will see some diagnostic output and a summary line that
+ reports whether any tests have failed.
+ </p>
+
+ <clix:function name="hunchentoot-test:test-hunchentoot">
+ <clix:lambda-list>base-url <clix:lkw>key</clix:lkw></clix:lambda-list>
+ <clix:returns>|</clix:returns>
+ <clix:description>
+ Run the built-in confidence
+ test. <clix:arg>base-url</clix:arg> is the base URL to use
+ for testing, it should not have a trailing slash. The keyword
+ arguments accepted are for future extension and should not
+ currently be used.
+ <p>
+ The script expects the Hunchentoot example test server to be
+ running at the given <clix:arg>base-url</clix:arg> and
+ retrieves various pages from that server, expecting certain
+ responses.
+ </p>
+ </clix:description>
+ </clix:function>
+
+ </clix:chapter>
+
<clix:chapter name="history" title="History">
Hunchentoot's predecessor <a href="http://weitz.de/tbnl/">TBNL</a>
Modified: trunk/thirdparty/hunchentoot/test/script-engine.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/test/script-engine.lisp 2009-02-12 23:38:00 UTC (rev 4254)
+++ trunk/thirdparty/hunchentoot/test/script-engine.lisp 2009-02-16 12:00:15 UTC (rev 4255)
@@ -47,13 +47,21 @@
(defvar *script-context* nil
"Current script context")
-(defmacro with-script-context ((&rest args &key (context-class-name 'script-context) &allow-other-keys) &body body)
+(defmacro with-script-context ((&rest args &key (context-class-name 'script-context) &allow-other-keys)
+ &body body)
`(let ((*script-context* (make-instance ',context-class-name , at args))
- (*default-pathname-defaults* *this-file*))
+ (*default-pathname-defaults* *this-file*)
+ failed)
(handler-bind
((assertion-failed (lambda (condition)
+ (push condition failed)
(format t "Assertion failed:~%~A~%" condition))))
- (progn , at body))))
+ (prog1
+ (progn , at body
+ (values))
+ (if failed
+ (format t ";; ~A assertion~:P FAILED~%" (length failed))
+ (format t ";; all tests PASSED~%"))))))
(defclass http-reply ()
((body :initarg :body)
Modified: trunk/thirdparty/hunchentoot/test/script.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-12 23:38:00 UTC (rev 4254)
+++ trunk/thirdparty/hunchentoot/test/script.lisp 2009-02-16 12:00:15 UTC (rev 4255)
@@ -33,21 +33,30 @@
(with-open-file (f pathname)
(princ-to-string (file-length f))))
+(defun say (fmt &rest args)
+ (format t "; ")
+ (apply #'format t fmt args)
+ (terpri))
+
(defun test-hunchentoot (base-url &key (make-cookie-jar (lambda () (make-instance 'drakma:cookie-jar))))
+
+ "Run the built-in confidence test. The keyword arguments accepted
+ are for future extension and should not currently be used."
+
(with-script-context (:base-url (format nil "~A/hunchentoot/test/" base-url))
- (format t "Request home page~%")
+ (say "Request home page")
(http-request "")
(http-assert 'status-code 200)
(http-assert-header :content-type "^text/html")
- (format t "Test cookies~%")
+ (say "Test cookies")
(let ((cookie-jar (funcall make-cookie-jar)))
(http-request "cookie.html" :cookie-jar cookie-jar)
(http-request "cookie.html" :cookie-jar cookie-jar)
(http-assert-body "(?ms)COOKIE-IN "pumpkin".*"barking""))
- (format t "Test session variables~%")
+ (say "Test session variables")
(let ((cookie-jar (funcall make-cookie-jar)))
(http-request "session.html" :cookie-jar cookie-jar
:method :post :parameters '(("new-foo-value" . "ABC") ("new-bar-value" . "DEF")))
@@ -56,26 +65,26 @@
(http-assert-body "\(HUNCHENTOOT-TEST::FOO . "ABC"\)")
(http-assert-body "\(HUNCHENTOOT-TEST::BAR . "DEF"\)"))
- (format t "Test GET parameters with foreign characters (Latin-1)~%")
+ (say "Test GET parameters with foreign characters (Latin-1)")
(http-request "parameter_latin1_get.html?foo=H%FChner")
(http-assert-header :content-type "text/html; charset=ISO-8859-1")
(http-assert-body "(72 252 104 110 101 114)")
(http-assert-body ""Hühner"")
- (format t "Test POST parameters with foreign characters (Latin-1)~%")
+ (say "Test POST parameters with foreign characters (Latin-1)")
(http-request "parameter_latin1_post.html"
:method :post :parameters (list (cons "foo" (format nil "H~Chner" #.(code-char 252)))))
(http-assert-header :content-type "text/html; charset=ISO-8859-1")
(http-assert-body "(72 252 104 110 101 114)")
(http-assert-body ""Hühner"")
- (format t "Test GET parameters with foreign characters (UTF-8)~%")
+ (say "Test GET parameters with foreign characters (UTF-8)")
(http-request "parameter_utf8_get.html?foo=H%C3%BChner")
(http-assert-header :content-type "text/html; charset=UTF-8")
(http-assert-body "(72 252 104 110 101 114)")
(http-assert-body ""Hühner"")
- (format t "Test POST parameters with foreign characters (UTF-8)~%")
+ (say "Test POST parameters with foreign characters (UTF-8)")
(http-request "parameter_utf8_post.html"
:method :post
:external-format-out :utf-8
@@ -84,31 +93,31 @@
(http-assert-body "(72 252 104 110 101 114)")
(http-assert-body ""Hühner"")
- (format t "Test redirection~%")
+ (say "Test redirection")
(http-request "redir.html")
(http-assert 'uri (lambda (uri)
(matches (princ-to-string uri) "info.html\\?redirected=1")))
- (format t "Test authorization~%")
+ (say "Test authorization")
(http-request "authorization.html")
(http-assert 'status-code 401)
(http-request "authorization.html"
:basic-authorization '("nanook" "igloo"))
(http-assert 'status-code 200)
- (format t "Request the Zappa image~%")
+ (say "Request the Zappa image")
(http-request "image.jpg")
(http-assert-header :content-length (file-length-string #P"fz.jpg"))
(http-assert-header :content-type "image/jpeg")
(http-assert 'body (complement #'mismatch) (file-contents #P"fz.jpg"))
- (format t "Request the Zappa image from RAM~%")
+ (say "Request the Zappa image from RAM")
(http-request "image-ram.jpg")
(http-assert-header :content-length (file-length-string #P"fz.jpg"))
(http-assert-header :content-type "image/jpeg")
(http-assert 'body (complement #'mismatch) (file-contents #P"fz.jpg"))
- (format t "Upload a file~%")
+ (say "Upload a file")
(http-request "upload.html"
:method :post :parameters '(("clean" . "doit")))
(http-request "upload.html"
More information about the Bknr-cvs
mailing list