From bknr@bknr.net Mon Feb 16 12:02:42 2009
From: BKNR Commits <bknr@bknr.net>
To: bknr-cvs@common-lisp.net
Subject: [bknr-cvs] hans changed trunk/thirdparty/hunchentoot/
Date: Mon, 16 Feb 2009 13:00:16 +0100
Message-ID: <E1LZ292-0006lR-6r@paracetamol.bknr.net>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="===============3970739129200469983=="

--===============3970739129200469983==
Content-Type: text/plain; charset="utf-8"
Content-Transfer-Encoding: quoted-printable

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
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--- trunk/thirdparty/hunchentoot/doc/index.xml	2009-02-12 23:38:00 UTC (rev 4=
254)
+++ trunk/thirdparty/hunchentoot/doc/index.xml	2009-02-16 12:00:15 UTC (rev 4=
255)
@@ -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 arg=
ument 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>
=20
+  <clix:chapter name=3D"testing" title=3D"Testing">
+    Hunchentoot comes with a test script that verifies that the
+    example web server responds as expected.  This test script uses the
+    <a href=3D"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=3D"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=3D"history" title=3D"History">
=20
     Hunchentoot's predecessor <a href=3D"http://weitz.de/tbnl/">TBNL</a>

Modified: trunk/thirdparty/hunchentoot/test/script-engine.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--- 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")
=20
-(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~%"))))))
=20
 (defclass http-reply ()
   ((body :initarg :body)

Modified: trunk/thirdparty/hunchentoot/test/script.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--- trunk/thirdparty/hunchentoot/test/script.lisp	2009-02-12 23:38:00 UTC (re=
v 4254)
+++ trunk/thirdparty/hunchentoot/test/script.lisp	2009-02-16 12:00:15 UTC (re=
v 4255)
@@ -33,21 +33,30 @@
   (with-open-file (f pathname)
     (princ-to-string (file-length f))))
=20
+(defun say (fmt &rest args)
+  (format t "; ")
+  (apply #'format t fmt args)
+  (terpri))
+
 (defun test-hunchentoot (base-url &key (make-cookie-jar (lambda () (make-ins=
tance '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-ur=
l))
=20
-    (format t "Request home page~%")
+    (say "Request home page")
     (http-request "")
     (http-assert 'status-code 200)
     (http-assert-header :content-type "^text/html")
=20
-    (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 &quot;pumpkin&quot;.*&quot;barking&q=
uot;"))
=20
-    (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 . &quot;ABC&quot;\)")
       (http-assert-body "\(HUNCHENTOOT-TEST::BAR . &quot;DEF&quot;\)"))
=20
-    (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=3DH%FChner")
     (http-assert-header :content-type "text/html; charset=3DISO-8859-1")
     (http-assert-body "(72 252 104 110 101 114)")
     (http-assert-body "&quot;H&#xFC;hner&quot;")
=20
-    (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=3DISO-8859-1")
     (http-assert-body "(72 252 104 110 101 114)")
     (http-assert-body "&quot;H&#xFC;hner&quot;")
=20
-    (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=3DH%C3%BChner")
     (http-assert-header :content-type "text/html; charset=3DUTF-8")
     (http-assert-body "(72 252 104 110 101 114)")
     (http-assert-body "&quot;H&#xFC;hner&quot;")
=20
-    (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 "&quot;H&#xFC;hner&quot;")
=20
-    (format t "Test redirection~%")
+    (say "Test redirection")
     (http-request "redir.html")
     (http-assert 'uri (lambda (uri)
                         (matches (princ-to-string uri) "info.html\\?redirect=
ed=3D1")))
=20
-    (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)
=20
-    (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"))
=20
-    (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"))
=20
-    (format t "Upload a file~%")
+    (say "Upload a file")
     (http-request "upload.html"
                   :method :post :parameters '(("clean" . "doit")))
     (http-request "upload.html"



--===============3970739129200469983==--