Streamline more test suits.

collects/tests/file/gzip.rkt

@@ -1,5 +1,5 @@
-#lang scheme/base
+#lang racket/base
-(require file/gzip file/gunzip scheme/file tests/eli-tester)
+(require file/gzip file/gunzip racket/file tests/eli-tester)
 
 (define ((io->str-op io) buf [check-ratio #f])
   (let* ([b? (bytes? buf)]
@@ -42,6 +42,7 @@
      (gzip-through-ports in (open-output-bytes) "defalte-me.dat" (current-seconds)))))
 
 (provide tests)
+(module+ main (tests))
 (define (tests) (test do (run-tests)))
 
 

collects/tests/file/main.rkt

@@ -1,10 +1,11 @@
-#lang scheme/base
+#lang racket/base
 
 (require tests/eli-tester
          (prefix-in gzip: "gzip.rkt")
          (prefix-in md5:  "md5.rkt"))
 
 (define (tests)
-  (test do (begin (gzip:tests) (md5:tests))))
+  (test do (gzip:tests)
+        do (md5:tests)))
 
 (tests)

collects/tests/file/md5.rkt

@@ -1,7 +1,10 @@
-#lang scheme/base
+#lang racket/base
 (require file/md5 tests/eli-tester)
 
-(define (run-tests)
+(provide tests)
+
+(module+ main (tests))
+(define (tests)
   (test
    (md5 #"")
    => #"d41d8cd98f00b204e9800998ecf8427e"
@@ -24,6 +27,3 @@
    (md5 #"" #f)
    => #"\324\35\214\331\217\0\262\4\351\200\t\230\354\370B~"
    ))
-
-(provide tests)
-(define (tests) (test do (run-tests)))

collects/tests/net/cgi.rkt

@@ -8,6 +8,7 @@
     (get-bindings)))
 
 (provide tests)
+(module+ main (tests))
 (define (tests)
   (putenv "REQUEST_METHOD" "GET")
   (test (test-bindings 'amp-or-semi "key1=value1&key2=value2;key3=value3")

collects/tests/net/cookie.rkt

@@ -4,6 +4,7 @@
 ;; cookie tests --- JBM, 2006-12-01
 
 (provide tests)
+(module+ main (tests))
 (define (tests)
   ;; cookie-test : (cookie -> cookie) string -> test
   (define (cookie-test fn expected)

collects/tests/net/encoders.rkt

@@ -69,6 +69,7 @@
     (for-each (check-same-file encode decode line-rx max-w) files)))
 
 (provide tests)
+(module+ main (tests))
 (define (tests)
   (test
    do (check-same-all (lambda (i o) (qp-encode-stream i o))

collects/tests/net/ftp.rkt

@@ -23,6 +23,7 @@
   (values thd (port->splitstr port)))
 
 (provide tests)
+(module+ main (tests))
 (define (tests)
   (define cop (open-output-string))
   (define-values [pasv1-thd pasv1-port] (tcp-serve* (current-output-port) DIRLIST))

collects/tests/net/head.rkt

@@ -4,6 +4,7 @@
 ;; a few tests of head.rkt -- JBC, 2006-07-31
 
 (provide tests)
+(module+ main (tests))
 (define (tests)
   (define test-header
     (string-append "From: abc\r\nTo: field is\r\n continued\r\n"

collects/tests/net/main.rkt

@@ -1,4 +1,4 @@
-#lang scheme/base
+#lang racket/base
 
 (require tests/eli-tester
          (prefix-in ucodec:    "uri-codec.rkt")
@@ -7,15 +7,22 @@
          (prefix-in ftp:       "ftp.rkt")
          (prefix-in head:      "head.rkt")
          (prefix-in cookie:    "cookie.rkt")
-         (prefix-in encoders: "encoders.rkt"))
+         (prefix-in encoders:  "encoders.rkt")
+         (prefix-in mime:      "mime.rkt")
+         (prefix-in url-port:  "url-port.rkt")
+         (prefix-in websocket: "websocket.rkt"))
 
 (define (tests)
-  (test do (begin (url:tests)
+  (test do (url:tests)
-                  (ucodec:tests)
+        do (ucodec:tests)
-                  (cgi:tests)
+        do (ucodec:noels-tests)
-                  (ftp:tests)
+        do (cgi:tests)
-                  (head:tests)
+        do (ftp:tests)
-                  (cookie:tests)
+        do (head:tests)
-                  (encoders:tests))))
+        do (cookie:tests)
+        do (encoders:tests)
+        do (mime:tests)
+        do (url-port:tests)
+        do (websocket:tests)))
 
 (tests)

collects/tests/net/mime.rkt

@@ -1,10 +1,6 @@
 #lang racket/base
-(require net/mime)
 
-(define-syntax-rule (test expect expr)
+(require tests/eli-tester net/mime)
-  (let ([val expr])
-    (unless (equal? expect val)
-      (error 'test "failed at ~s: ~e" 'expr val))))
 
 ;; This test is based on an example from Jordan Schatz
 
@@ -12,7 +8,7 @@
   (open-input-string
    (regexp-replace* #rx"(\r\n|\n)"
 #<<EOS
-Server: MochiWeb/1.1 WebMachine/1.9.0 (someone had painted it blue)
+Server: MochiWeb/1.1 WebMachine/1.9.0 (blah blah)
 Expires: Fri, 06 Jan 2012 02:01:12 GMT
 Date: Fri, 06 Jan 2012 01:51:12 GMT
 Content-Type: multipart/mixed; boundary=9nbsYRvJBLRyuL4VOuuejw9LcAy
@@ -37,29 +33,29 @@ Last-Modified: Wed, 04 Jan 2012 17:12:32 GMT
 EOS
 "\r\n")))
 
-(let* ([analyzed (mime-analyze ip)]
+(provide tests)
-       [our-entity (message-entity analyzed)]
+(module+ main (tests))
-       [parts (entity-parts our-entity)]
+(define (tests)
-       [inner-message (car parts)]
+  (define analyzed      (mime-analyze ip))
-       [inner-entity (message-entity inner-message)]
+  (define our-entity    (message-entity analyzed))
-       [body-proc (entity-body inner-entity)]
+  (define parts         (entity-parts our-entity))
-       [tmp (open-output-string)]) 
+  (define inner-message (car parts))
-  (test '("Server: MochiWeb/1.1 WebMachine/1.9.0 (someone had painted it blue)"
+  (define inner-entity  (message-entity inner-message))
+  (define body-proc     (entity-body inner-entity))
+  (define tmp           (open-output-string))
+  (define sub           (message-entity (car (entity-parts inner-entity))))
+  (test (message-fields analyzed)
+        => '("Server: MochiWeb/1.1 WebMachine/1.9.0 (blah blah)"
              "Expires: Fri, 06 Jan 2012 02:01:12 GMT"
              "Date: Fri, 06 Jan 2012 01:51:12 GMT")
-        (message-fields analyzed))
+        (length parts) => 1
-  (test 1 (length parts))
+        body-proc => '()
-  (test '() body-proc)
+        (length (entity-parts inner-entity)) => 1
-  (test 1 (length (entity-parts inner-entity)))
+        (entity-type sub) => 'application
-  (define sub  (message-entity (car (entity-parts inner-entity))))
+        (entity-subtype sub) => 'json
-  (test 'application (entity-type sub))
-  (test 'json (entity-subtype sub))
         ((entity-body sub) tmp)
-  (test "{\"date\": \"11/02/2011\"}" (get-output-string tmp)))
+        (get-output-string tmp) => "{\"date\": \"11/02/2011\"}"
-
-(test 'not-there (with-handlers ([exn:fail?
-                                  (lambda (exn)
-                                    (and (missing-multipart-boundary-parameter? exn)
-                                         'not-there))])
         (mime-analyze
-                    (open-input-string "Content-Type: multipart/mixed\r\n\r\n"))))
+         (open-input-string "Content-Type: multipart/mixed\r\n\r\n"))
+        =error> missing-multipart-boundary-parameter?
+        ))

collects/tests/net/uri-codec.rkt

@@ -2,6 +2,7 @@
 (require net/uri-codec tests/eli-tester)
 
 (provide tests)
+(module+ main (tests))
 (define (tests)
   (define sepmode current-alist-separator-mode)
   (test (uri-decode "%Pq") => "%Pq"
@@ -72,6 +73,8 @@
         ))
 
 ;; tests adapted from Noel Welsh's original test suite
+(provide noels-tests)
+(module+ main (noels-tests))
 (define (noels-tests)
   (define (pad2 str)
     (if (= (string-length str) 1) (string-append "0" str) str))

collects/tests/net/url-port.rkt

@@ -121,11 +121,14 @@
      (values "This is the data in the first chand this is the second oneXXXXXXX"
              "Content-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n"))))
 
+(provide tests)
+(module+ main (tests))
+(define (tests)
+  (test
    (run-tests "http" values #f)
    (run-tests "https" (let ([ctx (ssl-make-server-context)])
                         (ssl-load-certificate-chain! ctx (collection-file-path "test.pem" "openssl"))
                         (ssl-load-private-key! ctx (collection-file-path "test.pem" "openssl"))
                         (lambda (in out)
                           (ports->ssl-ports in out #:mode 'accept #:context ctx)))
-           #t)
+              #t)))
-

collects/tests/net/url.rkt

@@ -1,4 +1,4 @@
-#lang scheme
+#lang racket
 (require net/url tests/eli-tester
          (only-in net/uri-codec current-alist-separator-mode))
 
@@ -354,4 +354,5 @@
   )
 
 (provide tests)
+(module+ main (tests))
 (define (tests) (test do (run-tests)))

collects/tests/net/websocket.rkt

@@ -10,6 +10,9 @@
 
 (define RANDOM-K 100)
 
+(provide tests)
+(module+ main (tests))
+(define (tests)
   (test
    (for ([i (in-range RANDOM-K)])
      (define o (random 256))
@@ -61,8 +64,7 @@
    (handshake-solution "18x 6]8vM;54 *(5:  {   U1]8  z [  8"
                        "1_ tx7X d  <  nw  334J702) 7]o}` 0"
                        #"Tm[K T2u")
- =>
+   => #"fQJ,fN/4F4!~K~MH"
- #"fQJ,fN/4F4!~K~MH"
 
    (local [(define (test-echo-server)
              (define conn #f)
@@ -70,7 +72,6 @@
              (define shutdown! #f)
              (define p #f)
              (define confirm (make-async-channel))
-           
              (test (set! shutdown!
                          (ws-serve #:port 0
                                    #:confirmation-channel confirm
@@ -91,8 +92,7 @@
                    (ws-recv conn) => "a"
                    (ws-close! conn)
                    (shutdown!)))]
-   (test
+     (test #:failure-prefix "old"
-    #:failure-prefix "old"
            (parameterize ([framing-mode 'old]) (test-echo-server))
            #:failure-prefix "new"
-    (parameterize ([framing-mode 'new]) (test-echo-server)))))
+           (parameterize ([framing-mode 'new]) (test-echo-server))))))

collects/tests/profile/main.rkt

@@ -1,108 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require tests/eli-tester profile/structs profile/analyzer
+(require tests/eli-tester "topsort.rkt" "analyze.rkt")
-         scheme/match scheme/list "topsort.rkt")
 
-(define A '(A . #f))
+(test do (topological-sort-tests)
-(define B '(B . #f))
+      do (analyze-tests))
-(define C '(C . #f))
-
-(define (analyze cpu+lists)
-  (profile->sexpr
-   (analyze-samples
-    (cons (car cpu+lists)
-          (map (lambda (x) (append (take x 2) (reverse (drop x 2))))
-               (reverse (cdr cpu+lists)))))))
-
-(define (profile->sexpr prof)
-  (define (node-id* node)
-    (or (node-id node) (if (node-src node) '??? '*)))
-  (define (edges->sexprs node get get-time)
-    (for/list ([edge (get node)])
-      `(,(node-id* (edge-caller edge)) -> ,(node-id* (edge-callee edge))
-        time=  ,(get-time edge)
-        total= ,(edge-total edge))))
-  (define (node->sexpr node)
-    `(,(node-id* node)
-          total=   ,(node-total node)
-          self=    ,(node-self node)
-          callers: ,@(edges->sexprs node node-callers edge-caller-time)
-          callees: ,@(edges->sexprs node node-callees edge-callee-time)
-          threads= ,(node-thread-ids node)))
-  `(total=   ,(profile-total-time    prof)
-    samples= ,(profile-sample-number prof)
-    cpu=     ,(profile-cpu-time      prof)
-    thread-times= ,(profile-thread-times prof)
-    ,@(map node->sexpr (cons (profile-*-node prof) (profile-nodes prof)))))
-
-(test
-
- do (topological-sort-tests)
-
- (match (analyze `(10
-                   [0 0 ,A]
-                   [0 1 ,A]))
-   [`(total= 2 samples= 2 cpu= 10 thread-times= ([0 . 2])
-      [* total= 2 self= 0
-         callers: [A -> * time= 2 total= 2]
-         callees: [* -> A time= 2 total= 2]
-         threads= ()]
-      [A total= 2 self= 2
-         callers: [* -> A time= 2 total= 2]
-         callees: [A -> * time= 2 total= 2]
-         threads= (0)])
-    'ok]
-   [bad (error 'test ">>> ~s" bad)])
-
- ;; demonstrates different edge-caller/lee-times
- (match (analyze `(10
-                   [0 0 ,A ,B ,A]
-                   [0 1 ,A ,B ,A]))
-   [`(total= 2 samples= 2 cpu= 10 thread-times= ([0 . 2])
-      [* total= 2 self= 0
-         callers: [A -> * time= 2 total= 2]
-         callees: [* -> A time= 2 total= 2]
-         threads= ()]
-      [A total= 2 self= 2
-         callers: [B -> A time= 2/2 total= 2]
-                  [* -> A time= 2/2 total= 2]
-         callees: [A -> B time= 2/2 total= 2]
-                  [A -> * time= 2/2 total= 2]
-         threads= (0)]
-      [B total= 2 self= 0
-         callers: [A -> B time= 2 total= 2]
-         callees: [B -> A time= 2 total= 2]
-         threads= (0)])
-    'ok]
-   [bad (error 'test ">>> ~s" bad)])
-
- (match (analyze `(10
-                   [0 0 ,A ,B ,A]
-                   [0 1 ,A ,C ,A]
-                   [0 2 ,A ,C ,A]
-                   [0 3 ,A ,C ,A]))
-   [`(total= 4 samples= 4 cpu= 10 thread-times= ([0 . 4])
-      [* total= 4 self= 0
-         callers: [A -> * time= 4 total= 4]
-         callees: [* -> A time= 4 total= 4]
-         threads= ()]
-      [A total= 4 self= 4
-         callers: [* -> A time= 4/2 total= 4]
-                  [C -> A time= 3/2 total= 3]
-                  [B -> A time= 1/2 total= 1]
-         callees: [A -> * time= 4/2 total= 4]
-                  [A -> C time= 3/2 total= 3]
-                  [A -> B time= 1/2 total= 1]
-         threads= (0)]
-      [C total= 3 self= 0
-         callers: [A -> C time= 3 total= 3]
-         callees: [C -> A time= 3 total= 3]
-         threads= (0)]
-      [B total= 1 self= 0
-         callers: [A -> B time= 1 total= 1]
-         callees: [B -> A time= 1 total= 1]
-         threads= (0)])
-    'ok]
-   [bad (error 'test ">>> ~s" bad)])
-
- )

collects/tests/profile/topsort.rkt

@@ -1,7 +1,7 @@
-#lang scheme/base
+#lang racket/base
 
 (require tests/eli-tester profile/structs profile/utils
-         scheme/list scheme/match)
+         racket/list racket/match)
 
 (define arrow-sym->times
   ;; arrows with caller/callee times
@@ -67,6 +67,7 @@
 ;; to see a result: (sort-graph '(* -> A)) (exit)
 
 (provide topological-sort-tests)
+(module+ main (topological-sort-tests))
 (define (topological-sort-tests)
   (test