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

converting to trunk schemeunit

Browse Source 
svn: r14440
This commit is contained in:
Jay McCarthy 2009-04-06 22:57:20 +00:00
parent 4ebac5d343
commit afe6599e23
49 changed files with 74 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/html/test.ss
View File

@ -1,6 +1,6 @@
#lang scheme
(require (planet schematics/schemeunit:3)
(planet schematics/schemeunit:3/text-ui)
(require schemeunit
schemeunit/text-ui
net/url
(prefix-in h: html)
(prefix-in x: xml))

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

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet schematics/schemeunit:3)
(require schemeunit
"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 schematics/schemeunit:3)
(require schemeunit
"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 schematics/schemeunit:3)
(require schemeunit
(only-in mzlib/file
make-temporary-file)
web-server/configuration/configuration-table)

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

@ -1,5 +1,5 @@
#lang scheme
(require (planet schematics/schemeunit:3)
(require schemeunit
web-server/http
web-server/dispatchers/dispatch
net/url

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

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

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

@ -1,5 +1,5 @@
#lang scheme
(require (planet schematics/schemeunit:3)
(require schemeunit
(only-in mzlib/file
file-name-from-path
make-temporary-file)

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

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet schematics/schemeunit:3)
(require schemeunit
(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 schematics/schemeunit:3)
(require schemeunit
(planet "sxml.ss" ("lizorkin" "sxml.plt" 2 0))
mzlib/etc
mzlib/list

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

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet schematics/schemeunit:3)
(require schemeunit
(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 schematics/schemeunit:3)
(require schemeunit
(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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
(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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
"cookies-test.ss"
"digest-auth-test.ss")
(provide all-http-tests)

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

@ -1,5 +1,5 @@
#lang scheme
(require (planet schematics/schemeunit:3)
(require schemeunit
net/url
web-server/http/request-structs
web-server/http/response-structs

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

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

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

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

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

@ -1,5 +1,5 @@
#lang scheme
(require (planet schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
"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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
schemeunit
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 schematics/schemeunit:3)
(require schemeunit
"../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 schematics/schemeunit:3))
(require schemeunit)
(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 schematics/schemeunit:3)
(require schemeunit
"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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
(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 schematics/schemeunit:3)
(require schemeunit
web-server/private/mod-map
mzlib/serialize
"../util.ss")

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

@ -1,5 +1,5 @@
#lang scheme
(require (planet schematics/schemeunit:3)
(require schemeunit
web-server/private/connection-manager
web-server/private/timer
web-server/http/request

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

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
net/url
xml/xml
mzlib/contract

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

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet schematics/schemeunit:3/text-ui)
(require schemeunit/text-ui
"all-web-server-tests.ss")
(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 schematics/schemeunit:3)
(require schemeunit
#;(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 schematics/schemeunit:3)
(require schemeunit
"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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
web-server/servlet)
(provide helpers-tests)

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

@ -1,5 +1,5 @@
#lang scheme/base
(require (planet schematics/schemeunit:3)
(require schemeunit
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 schematics/schemeunit:3)
(require schemeunit
web-server/stuffers
web-server/private/servlet
web-server/http

40
collects/tests/xml/test-clark.ss
View File

@ -1,12 +1,14 @@
#lang scheme
(require (planet schematics/schemeunit:3)
(planet schematics/schemeunit:3/base)
(planet schematics/schemeunit:3/test-case)
(planet schematics/schemeunit:3/check)
(planet schematics/schemeunit:3/test-suite)
(planet schematics/schemeunit:3/text-ui)
(require schemeunit
schemeunit/base
schemeunit/test-case
schemeunit/check
schemeunit/test-suite
schemeunit/text-ui
xml
scheme/runtime-path)
(require/expose schemeunit/test-suite
(current-seed))
(define (validate-xml? xml)
(error 'validate-xml? "Not implemented"))
@ -19,15 +21,21 @@
(define (dir->test-suite d name path->test-case)
(make-schemeunit-test-suite
name
(parameterize
([current-test-case-around test-suite-test-case-around]
[current-check-around test-suite-check-around])
(map (lambda (p)
(path->test-case (build-path d p)))
(filter (lambda (p)
(define ext (filename-extension p))
(and ext (bytes=? #"xml" ext)))
(directory-list d))))
(lambda (fdown fup fhere seed)
(parameterize
([current-seed seed]
[current-test-case-around (test-suite-test-case-around fhere)]
[current-check-around (test-suite-check-around fhere)])
(for-each (lambda (p)
(define t (path->test-case (build-path d p)))
(if (schemeunit-test-suite? t)
(current-seed (apply-test-suite t fdown fup fhere (current-seed)))
t))
(filter (lambda (p)
(define ext (filename-extension p))
(and ext (bytes=? #"xml" ext)))
(directory-list d))))
(current-seed))
void
void))
@ -58,7 +66,7 @@
(define (valid-dir->test-suite d)
(define (path->test-case f)
(test-not-false (path->string f)
(validate-xml? (read-xml/file f))))
(validate-xml? (read-xml/file f))))
(test-suite
"Valid"
(dir->test-suite

4
collects/tests/xml/test.ss
View File

@ -1,6 +1,6 @@
#lang scheme
(require (planet schematics/schemeunit:3)
(planet schematics/schemeunit:3/text-ui)
(require schemeunit
schemeunit/text-ui
xml
xml/plist
mzlib/etc