Added a `file' "test suite", with only tests for inflate/deflate.

svn: r14147

collects/tests/file/gzip.ss

@@ -0,0 +1,37 @@
+#lang scheme/base
+(require file/gzip file/gunzip scheme/file tests/eli-tester)
+
+(define ((io->str-op io) buf [check-ratio #f])
+  (let* ([b? (bytes? buf)]
+         [i (if b? (open-input-bytes buf) (open-input-string buf))]
+         [o (if b? (open-output-bytes)    (open-output-string))])
+    (io i o)
+    (let ([res (if b? (get-output-bytes o) (get-output-string o))])
+      (when check-ratio
+        (if b?
+          (check-ratio (bytes-length  buf) (bytes-length  res))
+          (check-ratio (string-length buf) (string-length res))))
+      res)))
+
+(define deflate* (io->str-op deflate))
+(define inflate* (io->str-op inflate))
+
+(define (id* buf [ratio #f])
+  (test (inflate* (deflate* buf (and ratio (lambda (i o)
+                                             (test (< (/ o i) ratio))))))
+        => buf))
+
+(define (test-big-file)
+  (define big-file
+    (build-path (collection-path "drscheme/private") "unit.ss"))
+  ;; should be around 6 times smaller
+  (id* (file->bytes big-file) 4))
+
+(define (run-tests)
+  (define (rand-bytes)
+    (list->bytes (for/list ([j (in-range (random 1000))]) (random 256))))
+  (test-big-file)
+  (for ([i (in-range 100)]) (id* (rand-bytes))))
+
+(provide tests)
+(define (tests) (test do (run-tests)))

collects/tests/file/main.ss

@@ -0,0 +1,9 @@
+#lang scheme/base
+
+(require tests/eli-tester
+         (prefix-in gzip: "gzip.ss"))
+
+(define (tests)
+  (test do (begin (gzip:tests))))
+
+(tests)

collects/tests/net/cgi.ss

@@ -1,5 +1,6 @@
 #lang scheme
-(require net/cgi net/uri-codec tests/eli-tester)
+(require net/cgi (only-in net/uri-codec current-alist-separator-mode)
+         tests/eli-tester)
 
 (define (test-bindings mode query-string)
   (parameterize ([current-alist-separator-mode mode])

collects/tests/run-automated-tests.ss

@@ -39,6 +39,7 @@
     [require "lazy/main.ss"]
     [require "scribble/main.ss"]
     [require "net/main.ss"]
+    [require "file/main.ss"]
     ))