Removing obsolete tests
svn: r6584
This commit is contained in:
Jay McCarthy
parent
4480a1308a
commit
8d47684c09
|
|
@ -1,12 +0,0 @@
|
|||
(module a-module mzscheme
|
||||
(provide interface-version timeout start)
|
||||
|
||||
(define interface-version 'v1)
|
||||
|
||||
(define timeout +inf.0)
|
||||
|
||||
; start : request -> response
|
||||
(define (start initial-request)
|
||||
`(html (head (title "A Test Page"))
|
||||
(body ([bgcolor "white"])
|
||||
(p "A simple module servlet works.")))))
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
(module bad-xexpr mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start initial-request)
|
||||
(send/back
|
||||
`(html (a ([href url])
|
||||
"Title")))))
|
||||
|
|
@ -1,46 +0,0 @@
|
|||
(module counter-cells mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define interface-version 'v1)
|
||||
(define timeout 60)
|
||||
(define (start _)
|
||||
(main-page))
|
||||
|
||||
(define the-counter (make-web-cell 0))
|
||||
(define the-header (make-web-cell (box "Main page")))
|
||||
|
||||
(define (counter)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (h2 ,(number->string (web-cell-ref the-counter)))
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
(web-cell-shadow the-counter
|
||||
(add1 (web-cell-ref the-counter)))
|
||||
(counter)))])
|
||||
"Increment")
|
||||
(br)
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
'exit))])
|
||||
"Exit")))))
|
||||
|
||||
(define (main-page)
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (h2 ,(unbox (web-cell-ref the-header)))
|
||||
(form ([method "POST"]
|
||||
[action ,(embed/url
|
||||
(lambda (req)
|
||||
(set-box! (web-cell-ref the-header)
|
||||
(extract-binding/single 'header (request-bindings req)))
|
||||
(main-page)))])
|
||||
(input ([type "text"] [name "header"]))
|
||||
(input ([type "submit"])))
|
||||
(br)
|
||||
(a ([href ,(embed/url
|
||||
(lambda _
|
||||
(counter)
|
||||
(main-page)))])
|
||||
"View Counter"))))))
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
(module cust mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define servlet-cust (current-custodian))
|
||||
(define timeout 30)
|
||||
(define interface-version 'v1)
|
||||
|
||||
(define (start ir)
|
||||
`(html
|
||||
(head (title "Custodian test"))
|
||||
(body
|
||||
(p ,(if (eq? (current-custodian) servlet-cust)
|
||||
"It didn't work."
|
||||
"It did work."))))))
|
||||
|
|
@ -1,55 +0,0 @@
|
|||
; purpose: to test send/suspend, send/forward, send/back, and send/finish
|
||||
(module cut-module mzscheme
|
||||
(provide interface-version timeout start)
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
|
||||
(define interface-version 'v1)
|
||||
|
||||
(define timeout (* 7 24 60 60))
|
||||
|
||||
; : request -> response
|
||||
(define (start initial-request)
|
||||
(let ([order (extract-binding/single
|
||||
'order
|
||||
(request-bindings
|
||||
(send/suspend (let ([question "Place your order"])
|
||||
(lambda (k-url)
|
||||
`(html (head (title ,question))
|
||||
(body (form ([action ,k-url] [method "post"])
|
||||
,question
|
||||
(input ([type "text"] [name "order"]))))))))))])
|
||||
(if (string=? "coconut" order)
|
||||
(continue-shopping)
|
||||
(retry-order))))
|
||||
|
||||
; : -> doesn't
|
||||
(define (continue-shopping)
|
||||
(let* ([next-request
|
||||
(send/forward
|
||||
(lambda (k-url)
|
||||
`(html (head (title "Keep shopping"))
|
||||
(body (form ([action ,k-url] [method "post"])
|
||||
(p "Your order has shipped to a random location. You may not go back.")
|
||||
(p (input ([type "submit"] [name "go"] [value "Keep Shopping"])))
|
||||
(p (input ([type "submit"] [name "stop"] [value "Logout"]))))))))]
|
||||
[next (request-bindings next-request)])
|
||||
(cond
|
||||
[(exists-binding? 'go next)
|
||||
(start next-request)]
|
||||
[(exists-binding? 'stop next)
|
||||
(send/finish goodbye-page)]
|
||||
[else
|
||||
(send/finish
|
||||
`(html (head (title "Oops"))
|
||||
(body ([bgcolor "white"])
|
||||
(p "Oops " ,(format "next = ~v" next)))))])))
|
||||
|
||||
; : -> doesn't
|
||||
(define (retry-order)
|
||||
(send/back '(html (head (title "oops"))
|
||||
(body (p "This store only sells coconuts. Please click the browser's back button and type "
|
||||
(code "coconut") " in the field.")))))
|
||||
|
||||
(define goodbye-page
|
||||
`(html (head (title "Goodbye"))
|
||||
(body (p "Thank you for shopping.")))))
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
(module expiration mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
|
||||
(define timeout (* 60 3))
|
||||
(define interface-version 'v1)
|
||||
|
||||
(define (start initial-request)
|
||||
(parameterize ([current-servlet-continuation-expiration-handler
|
||||
(lambda (request-for-expired)
|
||||
(send/back
|
||||
`(html (body (p "You lose! (Default)")))))])
|
||||
(let loop ([request initial-request])
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html
|
||||
(head (title "Expiration demo"))
|
||||
(body (p "Open each of the links below in a new window. Then click the link in 'Forget' window. Then reload each window.")
|
||||
(p (a ([href ,(embed/url loop)])
|
||||
"Loop"))
|
||||
(p (a ([href ,(embed/url
|
||||
loop
|
||||
(lambda (request-for-expired)
|
||||
(send/back
|
||||
`(html (head (title "Expiration demo"))
|
||||
(body (p "You win! (Special)"))))))])
|
||||
"Loop w/ Expiration"))
|
||||
(p (a ([href ,(embed/url
|
||||
(lambda (request)
|
||||
(loop
|
||||
(send/forward
|
||||
(lambda (k-url)
|
||||
`(html (head (title "Expiration demo"))
|
||||
(body (p (a ([href ,k-url]) "Forget the past.")))))))))])
|
||||
"Prepare to forget the past."))))))))))
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
(module mime mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
`("text/uber-format"
|
||||
"uber uber uber"
|
||||
"-de-doo")))
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
(define title "A Test of Direct Responses")
|
||||
|
||||
`(html (head (title ,title))
|
||||
(body (h2 ,title)
|
||||
(p "This is only a test.")))
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
(module ssd mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide (all-defined))
|
||||
(define interface-version 'v1)
|
||||
(define timeout 120)
|
||||
(define (start ir)
|
||||
(printf "X~n")
|
||||
(send/suspend/dispatch
|
||||
(lambda (embed/url)
|
||||
`(html (head)
|
||||
(body
|
||||
(ul
|
||||
,@(map (lambda (i)
|
||||
`(li (a ([href ,(embed/url
|
||||
(lambda (r)
|
||||
`(html (head) (body ,i))))])
|
||||
,(number->string i))))
|
||||
`(1 2 3 4 5 6 7 8 9 0)))))))))
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
(module static mzscheme
|
||||
(require (lib "servlet.ss" "web-server"))
|
||||
(provide interface-version timeout start)
|
||||
(define interface-version 'v1)
|
||||
(define timeout +inf.0)
|
||||
(define (start initial-request)
|
||||
(list
|
||||
#"text/html"
|
||||
"<html><head></head><body>Foo</body><html>")))
|
||||
Loading…
Reference in New Issue
Block a user