suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Removing old tests in prep for real unit tests

Browse Source 
svn: r6580
This commit is contained in:
Jay McCarthy 2007-06-12 01:39:13 +00:00
parent 81d4758f08
commit 0a7e47e495
30 changed files with 0 additions and 543 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/web-server/default-web-root/servlets/tests/bus-error.ss
View File

@ -1,14 +0,0 @@
(module bus-error mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 120)
(define (end request)
`(html (body "End")))
(define (start request)
(send/suspend/callback
`(html (body (p (a ([href ,start]) "Forward"))
(p (a ([href ,end]) "End")))))))

9
collects/web-server/default-web-root/servlets/tests/button.ss
View File

@ -1,9 +0,0 @@
(module button mzscheme
(require (lib "mred.ss" "mred")
(lib "class.ss"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(let ([b (new button% (label "Button"))])
(list #"text/plain" "Button"))))

36
collects/web-server/default-web-root/servlets/tests/counter-cps.ss
View File

@ -1,36 +0,0 @@
(module counter-cps 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-parameter 0))
(define (counter k)
(send/suspend/dispatch
(lambda (embed/url)
`(html (h2 ,(number->string (the-counter)))
(a ([href ,(embed/url
(lambda _
(parameterize ([the-counter (add1 (the-counter))])
(counter k))))])
"Increment")
(br)
(a ([href ,(embed/url
(lambda _
(k 'exit)))])
"Exit")))))
(define (main-page)
(send/suspend/dispatch
(lambda (embed/url)
`(html (h2 "Main page")
(a ([href ,(embed/url
(lambda _
(counter
(lambda (v)
(main-page)))))])
"View Counter"))))))

35
collects/web-server/default-web-root/servlets/tests/counter.ss
View File

@ -1,35 +0,0 @@
(module counter 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-parameter 0))
(define (counter)
(send/suspend/dispatch
(lambda (embed/url)
`(html (h2 ,(number->string (the-counter)))
(a ([href ,(embed/url
(lambda _
(parameterize ([the-counter (add1 (the-counter))])
(counter))))])
"Increment")
(br)
(a ([href ,(embed/url
(lambda _
'exit))])
"Exit")))))
(define (main-page)
(send/suspend/dispatch
(lambda (embed/url)
`(html (h2 "Main page")
(a ([href ,(embed/url
(lambda _
(counter)
(main-page)))])
"View Counter"))))))

11
collects/web-server/default-web-root/servlets/tests/error.ss
View File

@ -1,11 +0,0 @@
(module error mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(with-errors-to-browser
send/finish
(lambda ()
(error 'error "I am an error, do you see me?")))))

12
collects/web-server/default-web-root/servlets/tests/fault.ss
View File

@ -1,12 +0,0 @@
(module fault mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 30)
(define X 0)
(define (start request)
(send/suspend
(lambda (k-url)
`(a ([href ,k-url]) "Click")))
(set! X (add1 X))
(format "~a" "fault")))

28
collects/web-server/default-web-root/servlets/tests/form.ss
View File

@ -1,28 +0,0 @@
(module form mzscheme
(require (lib "servlet.ss" "web-server")
(lib "pretty.ss"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 60)
(define (start _)
(define req
(send/suspend
(lambda (k-url)
`(html
(body
(form ([action ,k-url] [method "POST"])
(input ([type "checkbox"] [name "checkbox"]))
(input ([type "text"] [name "text"]))
(input ([type "submit"] [name "submit"]))))))))
(define binds
(request-bindings req))
(define sport
(open-output-string))
(define pp
(parameterize ([current-output-port sport])
(pretty-print binds)))
`(html
(body
(pre
,(get-output-string sport))))))

24
collects/web-server/default-web-root/servlets/tests/fupload.ss
View File

@ -1,24 +0,0 @@
(module fupload mzscheme
(require (lib "servlet.ss" "web-server")
(lib "plt-match.ss"))
(provide (all-defined))
(define timeout 60)
(define interface-version 'v1)
(define (start initial-request)
(send/suspend/callback
`(html (head)
(body
(form ([action
,(lambda (request)
(define b (request-bindings/raw request))
(match (bindings-assq #"file" b)
[(struct binding:file (_ filename _))
`(html
(body
,(bytes->string/utf-8 filename)))]))]
[method "post"]
[enctype "multipart/form-data"])
(h3 "Submit for an Assignment")
(input ([name "file"] [type "file"] [size "30"]))
(input ([type "submit"] [value "Submit"]))))))))

15
collects/web-server/default-web-root/servlets/tests/hang.ss
View File

@ -1,15 +0,0 @@
(module hang mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 60)
(define (start initial-request)
(send/suspend
(lambda (k-url)
`(html (a ([href ,k-url]) "Next"))))
(send/suspend
(lambda (k-url)
`(html (a ([href ,k-url]) "Error"))))
(/ 1 0)))

19
collects/web-server/default-web-root/servlets/tests/hod-0618.ss
View File

@ -1,19 +0,0 @@
(module hod-0618 mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 30)
(define (start _)
`(html
(body
,(extract-binding/single
'test:case
(request-bindings
(send/suspend
(lambda (k-url)
`(html
(body
(form ([method "POST"]
[action ,k-url])
(input ([type "text"] [name "test:case"]))
(input ([type "submit"])))))))))))))

15
collects/web-server/default-web-root/servlets/tests/incremental.ss
View File

@ -1,15 +0,0 @@
(module incremental mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout +inf.0)
(define (start initial-request)
(send/finish
(make-response/incremental
200 "Okay" (current-seconds) #"text/html" '()
(lambda (output-chunk)
(output-chunk "<html><head><title>"
"my-title</title></head>\n")
(output-chunk "<body><p>The first paragraph</p>\n")
(sleep 4)
(output-chunk "<p>The second paragraph</p></body></html>\n"))))))

13
collects/web-server/default-web-root/servlets/tests/inf-essence.ss
View File

@ -1,13 +0,0 @@
(module inf-essence mzscheme
(define a (alarm-evt +inf.0))
(let loop ()
(sync
(handle-evt a
(lambda _
(printf "Infinity has passed.~n")))
(handle-evt (alarm-evt (+ (current-inexact-milliseconds)
(* 1000 1)))
(lambda _
(printf "One second has passed.~n"))))
(loop)))

12
collects/web-server/default-web-root/servlets/tests/inf.ss
View File

@ -1,12 +0,0 @@
(module inf 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 "This is a simple module servlet.")))))

24
collects/web-server/default-web-root/servlets/tests/instance-expiration-2.ss
View File

@ -1,24 +0,0 @@
(module instance-expiration-2 mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define timeout 5)
(define interface-version 'v2)
(define (instance-expiration-handler expired-request)
; Not allowed to call any (lib "servlet.ss" "web-server") methods
; (I can't enforce this, however, so if you accidentally do weird things will happen.)
(send/suspend (lambda (k)
`(html (head (title "You win.")) (body "You win.")))))
(define (start initial-request)
(send/suspend/dispatch
(lambda (embed/url)
`(html
(head (title "Instance expiration demo"))
(body (p (a ([href ,(embed/url
(lambda (request)
`(html (head (title "Instance expiration demo"))
(body (p "Reload in a few minutes.")
(p "(or change the instance id to something made up.")))))])
"Click this link."))))))))

23
collects/web-server/default-web-root/servlets/tests/instance-expiration.ss
View File

@ -1,23 +0,0 @@
(module instance-expiration mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define timeout 5)
(define interface-version 'v2)
(define (instance-expiration-handler expired-request)
; Not allowed to call any (lib "servlet.ss" "web-server") methods
; (I can't enforce this, however, so if you accidentally do weird things will happen.)
`(html (head (title "You win.")) (body "You win.")))
(define (start initial-request)
(send/suspend/dispatch
(lambda (embed/url)
`(html
(head (title "Instance expiration demo"))
(body (p (a ([href ,(embed/url
(lambda (request)
`(html (head (title "Instance expiration demo"))
(body (p "Reload in a few minutes.")
(p "(or change the instance id to something made up.")))))])
"Click this link."))))))))

9
collects/web-server/default-web-root/servlets/tests/jas01-param.ss
View File

@ -1,9 +0,0 @@
(module jas01-param mzscheme
(provide get-time)
(define load-time (make-parameter #f))
(define (get-time)
(load-time))
(load-time (current-seconds)))

10
collects/web-server/default-web-root/servlets/tests/jas01-test.ss
View File

@ -1,10 +0,0 @@
(module jas01-test mzscheme
(define start #f)
(thread-wait
(thread
(lambda ()
(set! start (dynamic-require "jas01.ss" 'start)))))
(thread-wait
(thread
(lambda ()
(printf "~S~n" (start 'foo))))))

24
collects/web-server/default-web-root/servlets/tests/lock.ss
View File

@ -1,24 +0,0 @@
(module lock mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v2-transitional)
(define timeout 60)
(define (instance-expiration-handler _)
`(html (body "Error")))
(define (start _)
(send/suspend/dispatch
(lambda (embed/url)
`(html (body
(p (a ([href ,(embed/url
(lambda _
(sleep 5)
(second "Slow")))])
"Slow"))
(p (a ([href ,(embed/url
(lambda _
(second "Fast")))])
"Fast")))))))
(define (second label)
`(html (body ,label
,(number->string (current-seconds))))))

29
collects/web-server/default-web-root/servlets/tests/module-suspended-init.ss
View File

@ -1,29 +0,0 @@
(module module-suspended-init 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 ([name (extract-binding/single
'name
(request-bindings
(send/suspend (let ([question "What is your name?"])
(lambda (k-url)
`(html (head (title ,question))
(body (form ([action ,k-url] [method "post"])
,question
(input ([type "text"] [name "order"]))))))))))])
`(html (head (title "Hi " ,name "!"))
(body (p "Hello, " ,name "! Don't you feel special now?")))))
(send/suspend
(lambda (k-url)
`(html (head (title "Module Init"))
(body (form ([action ,k-url] [method "post"])
(p "Maybe calling send/suspend during the module initialization is not a good idea.")
(p "This call to send/suspend fails in the development environment since the parameter is #f")
(p "It fails in the server because the instance id is not yet installed into the table.")))))))

10
collects/web-server/default-web-root/servlets/tests/none-test.ss
View File

@ -1,10 +0,0 @@
(module none-test mzscheme
(require (lib "none.ss" "web-server" "managers"))
(provide (all-defined))
(define interface-version 'v2-transitional)
(define manager (create-none-manager
(lambda (failed-request)
`(html (body (h2 "Error"))))))
(define (start initial-request)
`(html (body (h2 "Look Ma, No Instance!")))))

28
collects/web-server/default-web-root/servlets/tests/plus.ss
View File

@ -1,28 +0,0 @@
(module plus mzscheme
(require (lib "servlet.ss" "web-server")
(lib "pretty.ss"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 60)
(define (start _)
(define req
(send/suspend
(lambda (k-url)
`(html
(body
(form ([action ,k-url] [method "POST"])
(input ([type "checkbox"] [name "checkbox"]))
(input ([type "text"] [name "text+foo"]))
(input ([type "submit"] [name "submit"]))))))))
(define binds
(request-bindings req))
(define sport
(open-output-string))
(define pp
(parameterize ([current-output-port sport])
(pretty-print binds)))
`(html
(body
(pre
,(get-output-string sport))))))

8
collects/web-server/default-web-root/servlets/tests/pr5490.ss
View File

@ -1,8 +0,0 @@
(module pr5490 mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 120)
(define (start ireq)
(send/finish '(("paul") "..."))))

12
collects/web-server/default-web-root/servlets/tests/pr7359.ss
View File

@ -1,12 +0,0 @@
(module pr7359 mzscheme
(require (lib "serialize.ss")
(lib "servlet.ss" "web-server"))
(provide interface-version timeout start)
(define interface-version 'v1)
(define timeout +inf.0)
(define-serializable-struct foo ())
(define (start req)
(deserialize (serialize (make-foo)))
`(html (body "Made it"))))

19
collects/web-server/default-web-root/servlets/tests/pr7533.ss
View File

@ -1,19 +0,0 @@
(module pr7533 mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 60)
(define (start initial-request)
(define start-time (current-seconds))
(let loop ((last-time start-time))
(let ((time (current-seconds)))
(send/suspend
(lambda (k)
`(html
(form ((action ,k) (method "post"))
(p ,(format "It has been ~a seconds since starting (~a seconds since last iteration)."
(- time start-time)
(- time last-time)))
(input ((type "submit")))))))
(loop time)))))

23
collects/web-server/default-web-root/servlets/tests/size.ss
View File

@ -1,23 +0,0 @@
(module size mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout +inf.0)
(define line-size 80)
(define (build-a-str n)
(list->string (let loop ([n n])
(cond
[(zero? n) (list #\newline)]
[else (cons #\a (loop (sub1 n)))]))))
(define line (build-a-str (sub1 line-size)))
(define html-overhead 68)
(define (start initial-request)
(define bindings (request-bindings initial-request))
(define size (- (string->number (cdr (assq 'size bindings))) html-overhead))
(define nlines (quotient size line-size))
(define extra (remainder size line-size))
`(html (head (title "A Page"))
(body (p ,@(vector->list (make-vector nlines line))
,(build-a-str extra))))))

21
collects/web-server/default-web-root/servlets/tests/suspended-module.ss
View File

@ -1,21 +0,0 @@
(module suspended-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 ([name (extract-binding/single
'name
(request-bindings
(send/suspend (let ([question "What is your name?"])
(lambda (k-url)
`(html (head (title ,question))
(body (form ([action ,k-url] [method "post"])
,question
(input ([type "text"] [name "order"]))))))))))])
`(html (head (title "Hi " ,name "!"))
(body (p "Hello, " ,name "! Don't you feel special now?"))))))

17
collects/web-server/default-web-root/servlets/tests/test.ss
View File

@ -1,17 +0,0 @@
(module test mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout +inf.0)
(define count 0)
(define (start initial-request)
(with-handlers ([void (lambda (exn) `(html (body (p ,(exn-message exn)))))])
(set! count (add1 count))
`(html (head (title "Testing 1...2...3"))
(body (p "This is a generated web page.")
(p ,(format "Here are the bindings:~n~s~n" (request-bindings initial-request))
(br)
"Count = " ,(number->string count)
(br)
,(format "Here are the headers:~n~s~n" (request-headers initial-request))))))))

11
collects/web-server/default-web-root/servlets/tests/update.ss
View File

@ -1,11 +0,0 @@
(module update mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define timeout 60)
(define interface-version 'v1)
(define (start initial-request)
(send/back
`(html (head)
(body
(h1 "Hey"))))))

15
collects/web-server/default-web-root/servlets/tests/url.ss
View File

@ -1,15 +0,0 @@
(module url mzscheme
(require (lib "servlet.ss" "web-server")
(lib "url.ss" "net"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout +inf.0)
(define count 0)
(define (start initial-request)
(set! count (add1 count))
`(html (head (title "URL Test"))
(body (p "The method requested is: " ,(format "~s" (request-method initial-request)))
(p "The URL requested is: " ,(url->string (request-uri initial-request)))
(p "count is: " ,(number->string count))))))

17
collects/web-server/default-web-root/servlets/tests/utf8.ss
View File

@ -1,17 +0,0 @@
(module utf8 mzscheme
(require (lib "servlet.ss" "web-server"))
(provide (all-defined))
(define interface-version 'v1)
(define timeout 60)
(define (start initial-request)
(extract-binding/single
'name
(request-bindings
(send/suspend
(lambda (k-url)
`(html
(body
(form ([action ,k-url])
(input ([type "text"] [name "name"]))
(input ([type "submit"])))))))))))