Streamline more test suits.

original commit: 6260b4c239

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,21 +1,28 @@
-#lang scheme/base
+#lang racket/base
 
 (require tests/eli-tester
-         (prefix-in ucodec:   "uri-codec.rkt")
+         (prefix-in ucodec:    "uri-codec.rkt")
-         (prefix-in url:      "url.rkt")
+         (prefix-in url:       "url.rkt")
-         (prefix-in cgi:      "cgi.rkt")
+         (prefix-in cgi:       "cgi.rkt")
-         (prefix-in ftp:      "ftp.rkt")
+         (prefix-in ftp:       "ftp.rkt")
-         (prefix-in head:     "head.rkt")
+         (prefix-in head:      "head.rkt")
-         (prefix-in cookie:   "cookie.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))
-          "Expires: Fri, 06 Jan 2012 02:01:12 GMT"
+  (define body-proc     (entity-body inner-entity))
-          "Date: Fri, 06 Jan 2012 01:51:12 GMT")
+  (define tmp           (open-output-string))
-        (message-fields analyzed))
+  (define sub           (message-entity (car (entity-parts inner-entity))))
-  (test 1 (length parts))
+  (test (message-fields analyzed)
-  (test '() body-proc)
+        => '("Server: MochiWeb/1.1 WebMachine/1.9.0 (blah blah)"
-  (test 1 (length (entity-parts inner-entity)))
+             "Expires: Fri, 06 Jan 2012 02:01:12 GMT"
-  (define sub  (message-entity (car (entity-parts inner-entity))))
+             "Date: Fri, 06 Jan 2012 01:51:12 GMT")
-  (test 'application (entity-type sub))
+        (length parts) => 1
-  (test 'json (entity-subtype sub))
+        body-proc => '()
-  ((entity-body sub) tmp)
+        (length (entity-parts inner-entity)) => 1
-  (test "{\"date\": \"11/02/2011\"}" (get-output-string tmp)))
+        (entity-type sub) => 'application
-
+        (entity-subtype sub) => 'json
-(test 'not-there (with-handlers ([exn:fail?
+        ((entity-body sub) tmp)
-                                  (lambda (exn)
+        (get-output-string tmp) => "{\"date\": \"11/02/2011\"}"
-                                    (and (missing-multipart-boundary-parameter? exn)
+        (mime-analyze
-                                         'not-there))])
+         (open-input-string "Content-Type: multipart/mixed\r\n\r\n"))
-                   (mime-analyze
+        =error> missing-multipart-boundary-parameter?
-                    (open-input-string "Content-Type: multipart/mixed\r\n\r\n"))))
+        ))

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

@@ -45,18 +45,18 @@
     (make-tester get-pure-port/headers))
   (define get-pure/headers/redirect
     (make-tester (λ (x) (get-pure-port/headers x #:redirections 1))))
-    
+
   (test
    (get-pure
     "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n")
    =>
    "This is the data in the first chunk and this is the second one"
-   
+
    (get-pure
     "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one")
    =>
    "This is the data in the first chunk and this is the second one"
-   
+
    (get-pure
     "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
    =>
@@ -66,12 +66,12 @@
     "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n")
    =>
    "This is the data in the first chunk and this is the second one"
-   
+
    (get-pure/redirect
     "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one")
    =>
    "This is the data in the first chunk and this is the second one"
-   
+
    (get-pure/redirect
     "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
    =>
@@ -81,32 +81,32 @@
     "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n")
    =>
    "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one\r\n"
-   
+
    (get-pure/headers
     "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n")
    =>
    (values "This is the data in the first chunk and this is the second one"
            "Content-Type: text/plain\r\nTransfer-Encoding: chunked\r\n")
-   
+
    (get-pure/headers
     "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\nThis is the data in the first chunk and this is the second one")
    =>
    (values "This is the data in the first chunk and this is the second one"
            "Content-Type: text/plain\r\n")
-   
+
    (get-pure/headers
     "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
    =>
    (values "This is the data in the first chand this is the second oneXXXXXXX"
            "Content-Type: text/plain\r\nTransfer-Encoding: chunked\r\n")
-   
+
    (get-pure/headers
     "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
    =>
    (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")
    )
-  
+
   (unless skip-actual-redirect?
     (test
      (get-pure/redirect
@@ -114,18 +114,21 @@
       (string-append
        "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\n\r\n"
        "24\r\nThis is the data in the first chunk \r\n1A\r\nand this is the second one\r\n0\r\n"))
-     
+
      (get-pure/headers/redirect
       "HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\nTransfer-Encoding: chunked\r\nAnother-Header: ta-daa\r\n\r\n20\r\nThis is the data in the first ch\r\n21\r\nand this is the second oneXXXXXXX\r\n0\r\n")
      =>
      (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"))))
 
-(run-tests "http" values #f)
+(provide tests)
-(run-tests "https" (let ([ctx (ssl-make-server-context)])
+(module+ main (tests))
-                     (ssl-load-certificate-chain! ctx (collection-file-path "test.pem" "openssl"))
+(define (tests)
-                     (ssl-load-private-key! ctx (collection-file-path "test.pem" "openssl"))
+  (test
-                     (lambda (in out)
+   (run-tests "http" values #f)
-                       (ports->ssl-ports in out #:mode 'accept #:context ctx)))
+   (run-tests "https" (let ([ctx (ssl-make-server-context)])
-           #t)
+                        (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)))

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,89 +10,89 @@
 
 (define RANDOM-K 100)
 
-(test
+(provide tests)
- (for ([i (in-range RANDOM-K)])
+(module+ main (tests))
-   (define o (random 256))
+(define (tests)
-   (define t (random 256))
+  (test
-   (define bot (if (o . < . t) o t))
+   (for ([i (in-range RANDOM-K)])
-   (define top (if (o . < . t) t o))
+     (define o (random 256))
-   (define botc (integer->char bot))
+     (define t (random 256))
-   (define topc (integer->char top))
+     (define bot (if (o . < . t) o t))
-   (test #:failure-prefix (format "~a / ~a" botc topc)
+     (define top (if (o . < . t) t o))
-         (<= bot (char->integer (random-char-between botc topc)) top)))
+     (define botc (integer->char bot))
- 
+     (define topc (integer->char top))
- (for ([i (in-range RANDOM-K)])
+     (test #:failure-prefix (format "~a / ~a" botc topc)
-   (test (char-alphabetic? (random-alpha-char))))
+           (<= bot (char->integer (random-char-between botc topc)) top)))
- 
+
- (count-spaces "") => 0
+   (for ([i (in-range RANDOM-K)])
- (count-spaces "   ") => 3
+     (test (char-alphabetic? (random-alpha-char))))
- (count-spaces (make-string RANDOM-K #\space)) => RANDOM-K
+
- 
+   (count-spaces "") => 0
- (count-spaces "18x 6]8vM;54 *(5:  {   U1]8  z [  8") => 12
+   (count-spaces "   ") => 3
- (count-spaces "1_ tx7X d  <  nw  334J702) 7]o}` 0") => 10
+   (count-spaces (make-string RANDOM-K #\space)) => RANDOM-K
- 
+
- (for ([i (in-range RANDOM-K)])
+   (count-spaces "18x 6]8vM;54 *(5:  {   U1]8  z [  8") => 12
-   (define len (add1 i))
+   (count-spaces "1_ tx7X d  <  nw  334J702) 7]o}` 0") => 10
-   (define s (make-string len #\0))
+
-   (define how-many (random len))
+   (for ([i (in-range RANDOM-K)])
-   (test (count-spaces (add-spaces how-many s)) => how-many))
+     (define len (add1 i))
- 
+     (define s (make-string len #\0))
- (remove-alphas "A0A") => "0"
+     (define how-many (random len))
- (remove-alphas "0") => "0"
+     (test (count-spaces (add-spaces how-many s)) => how-many))
- (remove-alphas (make-string RANDOM-K #\A)) => ""
+
- 
+   (remove-alphas "A0A") => "0"
- (remove-alphas "18x 6]8vM;54 *(5:  {   U1]8  z [  8") => "1868545188"
+   (remove-alphas "0") => "0"
- (remove-alphas "1_ tx7X d  <  nw  334J702) 7]o}` 0") => "1733470270"
+   (remove-alphas (make-string RANDOM-K #\A)) => ""
- 
+
- (for ([i (in-range RANDOM-K)])
+   (remove-alphas "18x 6]8vM;54 *(5:  {   U1]8  z [  8") => "1868545188"
-   (define s (number->string i))
+   (remove-alphas "1_ tx7X d  <  nw  334J702) 7]o}` 0") => "1733470270"
-   (test (remove-alphas (add-alphas s)) => s))
+
- 
+   (for ([i (in-range RANDOM-K)])
- (key->number "18x 6]8vM;54 *(5:  {   U1]8  z [  8") => 155712099
+     (define s (number->string i))
- (key->number "1_ tx7X d  <  nw  334J702) 7]o}` 0") => 173347027
+     (test (remove-alphas (add-alphas s)) => s))
- 
+
- (for ([i (in-range RANDOM-K)])
+   (key->number "18x 6]8vM;54 *(5:  {   U1]8  z [  8") => 155712099
-   (test (key->number (number->key i)) => i))
+   (key->number "1_ tx7X d  <  nw  334J702) 7]o}` 0") => 173347027
- 
+
- (for ([i (in-range RANDOM-K)])
+   (for ([i (in-range RANDOM-K)])
-   (define-values (k1 k2 k3 ans) (generate-key))
+     (test (key->number (number->key i)) => i))
-   (test (handshake-solution k1 k2 k3) => ans))
+
- 
+   (for ([i (in-range RANDOM-K)])
- (handshake-solution "18x 6]8vM;54 *(5:  {   U1]8  z [  8"
+     (define-values (k1 k2 k3 ans) (generate-key))
-                     "1_ tx7X d  <  nw  334J702) 7]o}` 0"
+     (test (handshake-solution k1 k2 k3) => ans))
-                     #"Tm[K T2u")
+
- =>
+   (handshake-solution "18x 6]8vM;54 *(5:  {   U1]8  z [  8"
- #"fQJ,fN/4F4!~K~MH"
+                       "1_ tx7X d  <  nw  334J702) 7]o}` 0"
- 
+                       #"Tm[K T2u")
- (local [(define (test-echo-server)
+   => #"fQJ,fN/4F4!~K~MH"
-           (define conn #f)
+
-           (define r (number->string (random 1000)))
+   (local [(define (test-echo-server)
-           (define shutdown! #f)
+             (define conn #f)
-           (define p #f)
+             (define r (number->string (random 1000)))
-           (define confirm (make-async-channel))
+             (define shutdown! #f)
-           
+             (define p #f)
-           (test (set! shutdown!
+             (define confirm (make-async-channel))
-                       (ws-serve #:port 0
+             (test (set! shutdown!
-                                 #:confirmation-channel confirm
+                         (ws-serve #:port 0
-                                 (λ (wsc _)
+                                   #:confirmation-channel confirm
-                                   (let loop ()
+                                   (λ (wsc _)
-                                     (define m (ws-recv wsc))
+                                     (let loop ()
-                                     (unless (eof-object? m)
+                                       (define m (ws-recv wsc))
-                                       (ws-send! wsc m)
+                                       (unless (eof-object? m)
-                                       (loop))))))
+                                         (ws-send! wsc m)
-                 shutdown!
+                                         (loop))))))
-                 (set! p (async-channel-get confirm))
+                   shutdown!
-                 p
+                   (set! p (async-channel-get confirm))
-                 (set! conn (ws-connect (string->url (format "ws://localhost:~a" p))))
+                   p
-                 conn
+                   (set! conn (ws-connect (string->url (format "ws://localhost:~a" p))))
-                 (ws-send! conn r)
+                   conn
-                 (ws-recv conn) => r
+                   (ws-send! conn r)
-                 (ws-send! conn "a")
+                   (ws-recv conn) => r
-                 (ws-recv conn) => "a"
+                   (ws-send! conn "a")
-                 (ws-close! conn)
+                   (ws-recv conn) => "a"
-                 (shutdown!)))]
+                   (ws-close! conn)
-   (test
+                   (shutdown!)))]
-    #:failure-prefix "old"
+     (test #:failure-prefix "old"
-    (parameterize ([framing-mode 'old]) (test-echo-server))
+           (parameterize ([framing-mode 'old]) (test-echo-server))
-    #:failure-prefix "new"
+           #:failure-prefix "new"
-    (parameterize ([framing-mode 'new]) (test-echo-server)))))
+           (parameterize ([framing-mode 'new]) (test-echo-server))))))