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

Moved to SU3

Browse Source 
svn: r13712
This commit is contained in:
Jay McCarthy 2009-02-17 22:11:39 +00:00
parent acef860a60
commit 76853279c3
46 changed files with 63 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/web-server/all-web-server-tests.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
"configuration/all-configuration-tests.ss"
"dispatchers/all-dispatchers-tests.ss"
"lang/all-lang-tests.ss"

2
collects/tests/web-server/configuration/all-configuration-tests.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
"configuration-table-test.ss")
(provide all-configuration-tests)

2
collects/tests/web-server/configuration/configuration-table-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
(only-in mzlib/file
make-temporary-file)
web-server/configuration/configuration-table)

2
collects/tests/web-server/dispatchers/all-dispatchers-tests.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
"dispatch-passwords-test.ss"
"dispatch-files-test.ss"
"dispatch-servlets-test.ss"

16
collects/tests/web-server/dispatchers/dispatch-files-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
#lang scheme
(require (planet schematics/schemeunit:3)
(only-in mzlib/file
file-name-from-path
make-temporary-file)
@ -45,10 +45,14 @@
(test-case
"read-range-header: missing and badly formed headers"
(check-false (files:read-range-header (list (make-header #"Ranges" #"bytes=1-10"))) "check 1")
(check-false (files:read-range-header (list (make-header #"Range" #"completely wrong"))) "check 2")
(check-false (files:read-range-header (list (make-header #"Range" #"byte=1-10"))) "check 3")
(check-false (files:read-range-header (list (make-header #"Range" #"bytes=a-10"))) "check 4")
(check-false (files:read-range-header (list (make-header #"Range" #"bytes=1-1.0"))) "check 5"))
(check-false (parameterize ([current-error-port (open-output-nowhere)])
(files:read-range-header (list (make-header #"Range" #"completely wrong")))) "check 2")
(check-false (parameterize ([current-error-port (open-output-nowhere)])
(files:read-range-header (list (make-header #"Range" #"byte=1-10")))) "check 3")
(check-false (parameterize ([current-error-port (open-output-nowhere)])
(files:read-range-header (list (make-header #"Range" #"bytes=a-10")))) "check 4")
(check-false (parameterize ([current-error-port (open-output-nowhere)])
(files:read-range-header (list (make-header #"Range" #"bytes=1-1.0")))) "check 5"))
(test-case
"read-range-header: single range"

3
collects/tests/web-server/dispatchers/dispatch-host-test.ss
View File

@ -1,6 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
(only-in mzlib/file
make-temporary-file)
net/url

2
collects/tests/web-server/dispatchers/dispatch-lang-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
(planet "sxml.ss" ("lizorkin" "sxml.plt" 2 0))
mzlib/etc
mzlib/list

3
collects/tests/web-server/dispatchers/dispatch-passwords-test.ss
View File

@ -1,6 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
(only-in mzlib/file
make-temporary-file)
net/url

2
collects/tests/web-server/dispatchers/dispatch-servlets-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
(planet "sxml.ss" ("lizorkin" "sxml.plt" 2 0))
mzlib/etc
mzlib/list

2
collects/tests/web-server/dispatchers/filesystem-map-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
net/url
web-server/private/util
web-server/dispatchers/filesystem-map)

2
collects/tests/web-server/dispatchers/servlet-test-util.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
(planet "sxml.ss" ("lizorkin" "sxml.plt" 2 0))
mzlib/list
web-server/http

2
collects/tests/web-server/formlets-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
net/url
web-server/http
web-server/formlets

2
collects/tests/web-server/http/all-http-tests.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
"cookies-test.ss"
"digest-auth-test.ss")
(provide all-http-tests)

6
collects/tests/web-server/http/cookies-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
net/url
web-server/http/request-structs
web-server/http/response-structs
@ -57,11 +57,11 @@
"xexpr-response/cookies"
(test-equal? "Simple"
(response/full-body (xexpr-response/cookies empty `(html)))
(list #"<html></html>"))
(list #"<html />"))
(test-equal? "One (body)"
(response/full-body (xexpr-response/cookies (list (make-cookie "name" "value")) `(html)))
(list #"<html></html>"))
(list #"<html />"))
(test-equal? "One (headers)"
(map (lambda (h) (cons (header-field h) (header-value h)))

2
collects/tests/web-server/http/digest-auth-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/http
net/url)
(provide digest-auth-tests)

4
collects/tests/web-server/lang-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
"util.ss")
(provide lang-tests)
@ -240,7 +240,7 @@
(let* ([first-key (table-01-eval '(dispatch-start start 'foo))]
[second-key (table-01-eval `(dispatch lookup-k '(,first-key 1)))]
[third-key (table-01-eval `(dispatch lookup-k '(,first-key -7)))])
(printf "~S~n" (list first-key second-key third-key))
#;(printf "~S~n" (list first-key second-key third-key))
(check = 3 (table-01-eval `(dispatch lookup-k '(,second-key 2))))
(check = 4 (table-01-eval `(dispatch lookup-k '(,second-key 3))))
(check-true (zero? (table-01-eval `(dispatch lookup-k '(,second-key -1)))))

3
collects/tests/web-server/lang/abort-resume-test.ss
View File

@ -1,6 +1,5 @@
#lang scheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/lang/abort-resume)
(require/expose web-server/lang/abort-resume (web-prompt))
(provide abort-resume-tests)

2
collects/tests/web-server/lang/all-lang-tests.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
"abort-resume-test.ss"
"anormal-test.ss"
"defun-test.ss"

2
collects/tests/web-server/lang/anormal-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/lang/anormal
web-server/lang/util)
(provide anormal-tests)

2
collects/tests/web-server/lang/defun-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/lang/defun
web-server/lang/util)
(provide defun-tests)

2
collects/tests/web-server/lang/file-box-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/lang/file-box
(only-in mzlib/file make-temporary-file))
(provide file-box-tests)

2
collects/tests/web-server/lang/labels-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/lang/labels)
(provide labels-tests)

2
collects/tests/web-server/lang/stuff-url-test.ss
View File

@ -1,7 +1,7 @@
#lang scheme/base
(require web-server/lang/stuff-url
web-server/stuffers
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet schematics/schemeunit:3)
net/url
mzlib/serialize
"../util.ss")

2
collects/tests/web-server/lang/web-param-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
"../util.ss")
(provide web-param-tests)

2
collects/tests/web-server/managers/all-managers-tests.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2)))
(require (planet schematics/schemeunit:3))
(provide all-managers-tests)
(define all-managers-tests

2
collects/tests/web-server/private/all-private-tests.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
"request-test.ss"
"cache-table-test.ss"
"response-test.ss"

2
collects/tests/web-server/private/cache-table-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/private/cache-table)
(provide cache-table-tests)

2
collects/tests/web-server/private/connection-manager-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/private/connection-manager)
(provide connection-manager-tests)

2
collects/tests/web-server/private/define-closure-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
mzlib/serialize
mzlib/match
web-server/private/define-closure)

2
collects/tests/web-server/private/gzip-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/private/gzip)
(provide gzip-tests)

2
collects/tests/web-server/private/mime-types-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
(only-in mzlib/file make-temporary-file)
web-server/http
web-server/private/mime-types)

2
collects/tests/web-server/private/mod-map-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/private/mod-map
mzlib/serialize
"../util.ss")

3
collects/tests/web-server/private/request-test.ss
View File

@ -1,6 +1,5 @@
#lang scheme
(require (planet "util.ss" ("schematics" "schemeunit.plt" 2))
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/private/connection-manager
web-server/private/timer
web-server/http)

3
collects/tests/web-server/private/response-test.ss
View File

@ -1,6 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
xml/xml
(only-in mzlib/file
make-temporary-file)

2
collects/tests/web-server/private/session-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
mzlib/list
net/url
web-server/private/session)

2
collects/tests/web-server/private/url-param-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
net/url
web-server/private/url-param)
(provide url-param-tests)

2
collects/tests/web-server/private/util-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
net/url
xml/xml
mzlib/contract

5
collects/tests/web-server/run-all-tests.ss
View File

@ -1,6 +1,5 @@
#lang scheme/base
(require (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2))
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3/text-ui)
"all-web-server-tests.ss")
(test/graphical-ui all-web-server-tests)
(run-tests all-web-server-tests)

2
collects/tests/web-server/servlet-env-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
#;(only (planet "ssax.ss" ("lizorkin" "ssax.plt" 1 3))
ssax:xml->sxml)
#;(planet "sxml.ss" ("lizorkin" "sxml.plt" 1 4))

2
collects/tests/web-server/servlet/all-servlet-tests.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
"bindings-test.ss"
"basic-auth-test.ss"
"helpers-test.ss"

2
collects/tests/web-server/servlet/basic-auth-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/http
net/url)
(provide basic-auth-tests)

2
collects/tests/web-server/servlet/bindings-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
mzlib/list
net/url
web-server/http

2
collects/tests/web-server/servlet/helpers-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/servlet)
(provide helpers-tests)

3
collects/tests/web-server/servlet/web-test.ss
View File

@ -1,6 +1,5 @@
#lang scheme/base
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
net/url
web-server/servlet/web)
(require/expose web-server/servlet/web

2
collects/tests/web-server/stuffers-test.ss
View File

@ -1,5 +1,5 @@
#lang scheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(require (planet schematics/schemeunit:3)
web-server/stuffers
web-server/private/servlet
web-server/http

8
collects/tests/web-server/util.ss
View File

@ -23,7 +23,7 @@
(match (regexp-match #"^.+\r\n\r\n(.+)$" bs)
[(list _ s)
(define sx (ssax:xml->sxml (open-input-bytes s) empty))
(pretty-print sx)
#;(pretty-print sx)
sx]
[_
(error 'html "Given ~S~n" bs)]))
@ -107,7 +107,8 @@
(eval '(require 'm-id)))
(lambda (s-expr)
(parameterize ([current-namespace ns])
(parameterize ([current-namespace ns]
[current-output-port (open-output-nowhere)])
(eval s-expr))))]
[else
(raise-syntax-error #f "make-module-evel: dropped through" m-expr)]))
@ -121,5 +122,6 @@
(namespace-require 'mzlib/serialize)
(namespace-require pth))
(lambda (expr)
(parameterize ([current-namespace ns])
(parameterize ([current-namespace ns]
[current-output-port (open-output-nowhere)])
(eval expr)))))