Servlet env test

svn: r6592

collects/web-server/docs/reference/servlet-env.scrbl

@@ -8,14 +8,19 @@ The @web-server provides a means of running Scheme servlets
 from within DrScheme, or any other REPL.
 
 @file{servlet-env.ss} provides the servlet API from @file{servlet.ss}
-as well as the following special forms:
+as well as the following:
+
+@defthing[send-url (parameter/c ([url string?] [separate-window? boolean?] . -> . void))]{ 
+ Should open @scheme[url]. In another window if @scheme[separate-window?] is true.
+ By default this is from @scheme[(lib "sendurl.ss" "net")].
+}
 
 @defform[(on-web servlet-expr)]{This expands to @scheme[(on-web 8000 servlet-expr)].}
 
 @defform[(on-web port servlet-expr)]{
  This constructs a small servlet, where the body of the @scheme[start] procedure is
- @scheme[servlet-expr], runs the @web-server on port @scheme[port], and opens
- a browser to a URL accessing the constructed servlet. The call blocks until the
+ @scheme[servlet-expr], runs the @web-server on port @scheme[port], and calls
+ @scheme[send-url] with a URL for the constructed servlet. The call blocks until the
  servlet finishes its computation, i.e. @scheme[servlet-expr] is evaluated, and
  returns its result. @scheme[servlet-expr] may use the entire Scheme servlet API.
  (See @secref["servlet"].)

collects/web-server/servlet-env.ss

@@ -1,5 +1,5 @@
 (module servlet-env mzscheme
-  (require (lib "sendurl.ss" "net")
+  (require (prefix net: (lib "sendurl.ss" "net"))
            (lib "unit.ss"))
   (require "web-server.ss"
            "web-config-unit.ss"
@@ -10,8 +10,11 @@
            "private/cache-table.ss")
   (require "servlet.ss")
   (provide (rename on-web:syntax on-web)
+           send-url
            (all-from "servlet.ss"))
   
+  (define send-url (make-parameter net:send-url))
+  
   ; XXX Change to setup temporary file and special dispatcher  
   (define-syntax (on-web:syntax stx)
     (syntax-case stx ()
@@ -45,7 +48,7 @@
                            (body (p "This servlet has ended, please return to the interaction window."))))))]
            [shutdown-server
             (serve/web-config@ (build-standalone-servlet-configuration the-port the-path new-servlet))])
-      (send-url standalone-url #t)
+      ((send-url) standalone-url #t)
       ; Wait for final call
       (semaphore-wait sema)
       ; XXX: Find a way to wait for final HTML to be sent

collects/web-server/tests/servlet-env-test.ss

@@ -1,13 +1,35 @@
 (module servlet-env-test mzscheme
   (require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
+           (only (planet "ssax.ss" ("lizorkin" "ssax.plt" 1 3))
+                 ssax:xml->sxml)
+           (planet "sxml.ss" ("lizorkin" "sxml.plt" 1 4))
+           (lib "etc.ss")
+           (lib "list.ss")
+           (lib "pretty.ss")
+           (lib "url.ss" "net")
            (lib "servlet-env.ss" "web-server"))
   (provide servlet-env-tests)
   
+  (define (call u bs)
+    (define sx (ssax:xml->sxml (get-pure-port (string->url u)) empty))
+    (pretty-print sx)
+    sx)
+  
   (define servlet-env-tests
     (test-suite
-     "Servlet Environment"))
-
-  ; XXX Turn below into tests
+     "Servlet Environment"
+     
+     (test-not-exn "Add two numbers"
+                   (lambda () 
+                     (sleep 2)
+                     (parameterize ([send-url
+                                     (lambda (a-url sep?)
+                                       (let* ([k0 (first ((sxpath "//form/@action/text()") (call a-url empty)))]
+                                              [k1 (first ((sxpath "//form/@action/text()") (call k0 (list (make-binding:form #"number" #"23")))))]
+                                              [n (first ((sxpath "//p/text()") (call k1 (list (make-binding:form #"number" #"12")))))])
+                                         n)
+                                       (void))])
+                       (example))))))
   
   ; request-number : str -> num
   (define (request-number which-number)
@@ -25,11 +47,10 @@
                          "Enter the " ,which-number " number to add: "
                          (input ([type "text"] [name "number"] [value ""]))
                          (input ([type "submit"] [name "enter"] [value "Enter"])))))))
-  #;(on-web
+  (define (example)
+    (on-web
+     9999
      `(html (head (title "Sum"))
             (body ([bgcolor "white"])
                   (p "The sum is "
-                     ,(number->string (+ (request-number "first") (request-number "second")))))))
-  
-  (define (test)
-    (on-web 9000 (+ (request-number "first") (request-number "second")))))
+                     ,(number->string (+ (request-number "first") (request-number "second")))))))))