Moved to SU3

svn: r13712

collects/tests/web-server/all-web-server-tests.ss

@@ -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"

collects/tests/web-server/configuration/all-configuration-tests.ss

@@ -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)
 

collects/tests/web-server/configuration/configuration-table-test.ss

@@ -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)

collects/tests/web-server/dispatchers/all-dispatchers-tests.ss

@@ -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"

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

@@ -1,5 +1,5 @@
-#lang scheme/base
+#lang scheme
-(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
+(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 (parameterize ([current-error-port (open-output-nowhere)])
-    (check-false (files:read-range-header (list (make-header #"Range" #"byte=1-10"))) "check 3")
+                   (files:read-range-header (list (make-header #"Range" #"completely wrong")))) "check 2")
-    (check-false (files:read-range-header (list (make-header #"Range" #"bytes=a-10"))) "check 4")
+    (check-false (parameterize ([current-error-port (open-output-nowhere)])
-    (check-false (files:read-range-header (list (make-header #"Range" #"bytes=1-1.0"))) "check 5"))
+                   (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"

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

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

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

@@ -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

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

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

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

@@ -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

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

@@ -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)

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

@@ -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

collects/tests/web-server/formlets-test.ss

@@ -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

collects/tests/web-server/http/all-http-tests.ss

@@ -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)

collects/tests/web-server/http/cookies-test.ss

@@ -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)))

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

@@ -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)

collects/tests/web-server/lang-test.ss

@@ -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)))))

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

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

collects/tests/web-server/lang/all-lang-tests.ss

@@ -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"

collects/tests/web-server/lang/anormal-test.ss

@@ -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)

collects/tests/web-server/lang/defun-test.ss

@@ -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)

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

@@ -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)

collects/tests/web-server/lang/labels-test.ss

@@ -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)
 

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

@@ -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")

collects/tests/web-server/lang/web-param-test.ss

@@ -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)
 

collects/tests/web-server/managers/all-managers-tests.ss

@@ -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

collects/tests/web-server/private/all-private-tests.ss

@@ -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"

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

@@ -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)
 

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

@@ -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)
 

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

@@ -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)

collects/tests/web-server/private/gzip-test.ss

@@ -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)
 

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

@@ -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)

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

@@ -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")

collects/tests/web-server/private/request-test.ss

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

collects/tests/web-server/private/response-test.ss

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

collects/tests/web-server/private/session-test.ss

@@ -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)

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

@@ -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)

collects/tests/web-server/private/util-test.ss

@@ -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

collects/tests/web-server/run-all-tests.ss

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

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

@@ -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))

collects/tests/web-server/servlet/all-servlet-tests.ss

@@ -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"

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

@@ -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)

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

@@ -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

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

@@ -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)
 

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

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

collects/tests/web-server/stuffers-test.ss

@@ -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

collects/tests/web-server/util.ss

@@ -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)))))