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:refRAW-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:argwant-stream</clix:arg> keyword argument to the - clix:refRAW-POST-DATA</clix:ref> in rare circumstances. + you should only use the clix:argwant-stream</clix:arg> + keyword argument to the clix:refRAW-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:refexample</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-listbase-url clix:lkwkey</clix:lkw></clix:lambda-list> + clix:returns|</clix:returns> + clix:description + Run the built-in confidence + test. clix:argbase-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:argbase-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 ,@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 ,@body)))) + (prog1 + (progn ,@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"
-
BKNR Commits