Permalink
Browse files

Streamline more test suits.

  • Loading branch information...
1 parent 482214e commit 6260b4c2398829dead24869eb8fcbbcf149576b8 @elibarzilay elibarzilay committed May 24, 2012
@@ -1,5 +1,5 @@
-#lang scheme/base
-(require file/gzip file/gunzip scheme/file tests/eli-tester)
+#lang racket/base
+(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)))
@@ -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)
@@ -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)))
@@ -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")
@@ -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)
@@ -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))
@@ -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))
@@ -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"
@@ -1,21 +1,28 @@
-#lang scheme/base
+#lang racket/base
(require tests/eli-tester
- (prefix-in ucodec: "uri-codec.rkt")
- (prefix-in url: "url.rkt")
- (prefix-in cgi: "cgi.rkt")
- (prefix-in ftp: "ftp.rkt")
- (prefix-in head: "head.rkt")
- (prefix-in cookie: "cookie.rkt")
- (prefix-in encoders: "encoders.rkt"))
+ (prefix-in ucodec: "uri-codec.rkt")
+ (prefix-in url: "url.rkt")
+ (prefix-in cgi: "cgi.rkt")
+ (prefix-in ftp: "ftp.rkt")
+ (prefix-in head: "head.rkt")
+ (prefix-in cookie: "cookie.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)
- (ucodec:tests)
- (cgi:tests)
- (ftp:tests)
- (head:tests)
- (cookie:tests)
- (encoders:tests))))
+ (test do (url:tests)
+ do (ucodec:tests)
+ do (ucodec:noels-tests)
+ do (cgi:tests)
+ do (ftp:tests)
+ do (head:tests)
+ do (cookie:tests)
+ do (encoders:tests)
+ do (mime:tests)
+ do (url-port:tests)
+ do (websocket:tests)))
(tests)
@@ -1,18 +1,14 @@
#lang racket/base
-(require net/mime)
-(define-syntax-rule (test expect expr)
- (let ([val expr])
- (unless (equal? expect val)
- (error 'test "failed at ~s: ~e" 'expr val))))
+(require tests/eli-tester net/mime)
;; This test is based on an example from Jordan Schatz
(define ip
(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)]
- [our-entity (message-entity analyzed)]
- [parts (entity-parts our-entity)]
- [inner-message (car parts)]
- [inner-entity (message-entity inner-message)]
- [body-proc (entity-body inner-entity)]
- [tmp (open-output-string)])
- (test '("Server: MochiWeb/1.1 WebMachine/1.9.0 (someone had painted it blue)"
- "Expires: Fri, 06 Jan 2012 02:01:12 GMT"
- "Date: Fri, 06 Jan 2012 01:51:12 GMT")
- (message-fields analyzed))
- (test 1 (length parts))
- (test '() body-proc)
- (test 1 (length (entity-parts inner-entity)))
- (define sub (message-entity (car (entity-parts inner-entity))))
- (test 'application (entity-type sub))
- (test 'json (entity-subtype sub))
- ((entity-body sub) tmp)
- (test "{\"date\": \"11/02/2011\"}" (get-output-string tmp)))
-
-(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"))))
+(provide tests)
+(module+ main (tests))
+(define (tests)
+ (define analyzed (mime-analyze ip))
+ (define our-entity (message-entity analyzed))
+ (define parts (entity-parts our-entity))
+ (define inner-message (car parts))
+ (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")
+ (length parts) => 1
+ body-proc => '()
+ (length (entity-parts inner-entity)) => 1
+ (entity-type sub) => 'application
+ (entity-subtype sub) => 'json
+ ((entity-body sub) tmp)
+ (get-output-string tmp) => "{\"date\": \"11/02/2011\"}"
+ (mime-analyze
+ (open-input-string "Content-Type: multipart/mixed\r\n\r\n"))
+ =error> missing-multipart-boundary-parameter?
+ ))
@@ -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))
@@ -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,51 +81,54 @@
"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
"HTTP/1.1 301 Moved Permanently\r\nLocation: http://localhost:9002/whatever\r\n\r\nstuff"
(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)
-(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)
-
+(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)))
@@ -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)))
Oops, something went wrong.

0 comments on commit 6260b4c

Please sign in to comment.