David Krentzlin avatar David Krentzlin committed 46c17e2

replaced old testing code with the overhauled one

Comments (0)

Files changed (4)

tests/offset-test.txt

- Scheme occupies a unique niche. A research niche and an educational
-niche. It is not a language. Not R6RS, not R5RS, not R4Rs. It is an
-idea. Or a collection of ideas. It is a framework. It is a way of
-thinking. It is a mindset. All of this is embodied in an ever growing
-family of languages or dialects, not a single language. It is a
-virus. It is the ultimate programming-language virus. 
-    The cat is already out of the bag and there is no way to get it back
-in. Once someone gets the mindset, they can implement their own
-implementation, which is often a slightly different dialect. This has
-happened hundreds if not thousands of times over. (Probably hundreds
-of thousands or more if one counts all the people doing homework for
-Scheme courses.) 
-    This happens for Scheme in a way that it doesn't for any other
-language. Scheme has also served as a testbed for innovated language
-ideas more than any other language, either by fueling such innovation
-or by adopting such innovation. I'm talking about the most major
-innovations of all of computer science. Things like: scoping,
-nondeterminism, parallelism, lazy evaluation, unification, constraint
-processing, stochastic computation, quantum computation, automatic
-differentiation, genetic programming, types, automated reasoning,
-... just to name a few.  
-   -- from the R6RS Ballot of Jeffrey Mark Siskind, author of Stalin
-      and current (unofficial) maintainer of Scheme->C
-(use test tcp posix (srfi 4))
-(load "test-utils")
+;; 
+;; %%HEADER%%
+;; 
+
+(use test)
+(load "test-helper")
 (use sendfile)
-(import sendfile)
 
-(define the-server (setup))
 
-(test-begin "Chunking")
+(with-running-server
 
-(when sendfile-available
-  (test-group "sendfile"
-              (test "giving offsets"
-                    "ent (unofficial) maintainer of Scheme->C\n"
-                    (begin
-                      (with-prepared-environment
-                       offset-test-file
-                       (lambda (in out)
-                         (parameterize ((force-implementation 'sendfile))
-                           (sendfile in out offset: 1400))) #t)
-                      (file-contents test-file-out)))
-            
-              (test "giving size"
-                    " Scheme occupies a unique niche." 
-                    (begin
-                      (with-prepared-environment
-                       offset-test-file
-                       (lambda (in out)
-                         (parameterize ((force-implementation 'sendfile))
-                           (sendfile in out bytes: 32))) #t)
-                      (file-contents test-file-out)))
-            
-              (test "giving size and offset"
-                    "It is a mindset" 
-                    (begin
-                      (with-prepared-environment
-                       offset-test-file
-                       (lambda (in out)
-                         (parameterize ((force-implementation 'sendfile))
-                           (sendfile in out offset: 213 bytes: 15))) #t)
-                      (file-contents test-file-out)))
+ (let* ((mb-buffer (generate-buffer (mebibytes 1)))
+        (mb-checksum (buffer-checksum mb-buffer)))
 
-            
-              ;; (test "giving too high offset" #t #f)
-              ;; (test "giving too low offset" #t #f)
-              ;; (test "giving too high size" #t #f)
-              ;; (test "giving too low size" #t #f)
-              ))
 
+   (define (stream-mb-buffer)
+     (call-with-temporary-file/checksum
+      mb-buffer
+      (lambda (temp-file _)
+        (stream-file temp-file sendfile))))
+ 
+   (test-group "sendfile main interface"
+               
+               (test "sendfile" mb-checksum (stream-mb-buffer)))
 
-(when mmap-available
- (test-group "mmap"
-             (test "giving offsets"
-                   "ent (unofficial) maintainer of Scheme->C\n"
-                   (begin
-                     (with-prepared-environment
-                      offset-test-file
-                      (lambda (in out)
-                        (parameterize ((force-implementation 'mmapped))
-                          (sendfile in out offset: 1400))) #t)
-                     (file-contents test-file-out)))
-             (test "giving size"
-                   " Scheme occupies a unique niche." 
-                   (begin
-                     (with-prepared-environment
-                      offset-test-file
-                      (lambda (in out)
-                        (parameterize ((force-implementation 'mmapped))
-                          (sendfile in out bytes: 32))) #t)
-                     (file-contents test-file-out)))
-            
-             (test "giving size and offset"
-                   "It is a mindset" 
-                   (begin
-                     (with-prepared-environment
-                      offset-test-file
-                      (lambda (in out)
-                        (parameterize ((force-implementation 'mmapped))
-                          (sendfile in out offset: 213 bytes: 15))) #t)
-                     (file-contents test-file-out)))
+   (test-group "forcing implementation"
+               
+               (parameterize ((force-implementation 'read-write))
+                 (test "read-write" mb-checksum (stream-mb-buffer)))
 
-             ;; (test "giving offset > page-size")
-             ;; (test "giving offset > page-size and size > page-size)
-            
-             ;; (test "giving too high offset" #t #f)
-             ;; (test "giving too low offset" #t #f)
-             ;; (test "giving too high size" #t #f)
-             ;; (test "giving too low size" #t #f)
-             ))
+               (if sendfile-available
+                   (parameterize ((force-implementation 'sendfile))
+                     (test "sendfile(2)" mb-checksum (stream-mb-buffer))))
 
-(test-group "read-write-loop/fd"
-            (test "giving offsets"
-                  "ent (unofficial) maintainer of Scheme->C\n"
-                  (begin
-                    (with-prepared-environment
-                     offset-test-file
-                     (lambda (in out)
-                       (parameterize ((force-implementation 'read-write))
-                         (sendfile in out offset: 1400))) #t)
-                    (file-contents test-file-out)))
+               (if mmap-available
+                   (parameterize ((force-implementation 'mmapped))
+                     (test "mmap(2)" mb-checksum (stream-mb-buffer))))
 
-            (test "giving size"
-                  " Scheme occupies a unique niche." 
-                  (begin
-                    (with-prepared-environment
-                     offset-test-file
-                     (lambda (in out)
-                       (parameterize ((force-implementation 'read-write))
-                         (sendfile in out bytes: 32))) #t)
-                    (file-contents test-file-out)))
+               (parameterize ((force-implementation 'read-write-port))
+                 (test "read-write-port" mb-checksum (stream-mb-buffer))))
 
-            (test "giving size and offset"
-                  "It is a mindset" 
-                  (begin
-                    (with-prepared-environment
-                     offset-test-file
-                     (lambda (in out)
-                       (parameterize ((force-implementation 'read-write))
-                         (sendfile in out offset: 213 bytes: 15))) #t)
-                    (file-contents test-file-out)))
 
-            ;; test non-page-aligned offsets
-            ;; test bigger chunks
-            
-            ;; (test "giving too high offset" #t #f)
-            ;; (test "giving too low offset" #t #f)
-            ;; (test "giving too high size" #t #f)
-            ;; (test "giving too low size" #t #f)
-            
-            )
+   (test-group "read-write variations"
+               
+               (call-with-temporary-file/checksum
+                (generate-buffer (mebibytes 1))
+                (lambda (temp-file expected-checksum)
+                  (test "ports only"
+                        expected-checksum
+                        (call-with-connection-to-server
+                         (lambda (server-in server-out)
+                           (write-content-size server-out (mebibytes 1))
+                           (call-with-input-file temp-file
+                             (lambda (file-in)
+                               (sendfile file-in server-out)))
+                           (read-checksum server-in)))))))
 
 
-(test-group "read-write-loop/port"
-            (test "giving offsets"
-                  "ent (unofficial) maintainer of Scheme->C\n"
-                  (begin
-                    (with-prepared-environment
-                     offset-test-file
-                     (lambda (in out)
-                       (parameterize ((force-implementation 'read-write-port))
-                         (sendfile in out offset: 1400))) #t #f)
-                    (file-contents test-file-out)))
+   (test-group "content chunking"
+               
+      (let* ((head   (generate-buffer 20 #\a))
+             (middle (generate-buffer 20 #\b))
+             (tail   (generate-buffer 20 #\c))
+             (buffer (string-append head middle tail)))         
 
-            (test "giving size"
-                  " Scheme occupies a unique niche." 
-                  (begin
-                    (with-prepared-environment
-                     offset-test-file
-                     (lambda (in out)
-                       (parameterize ((force-implementation 'read-write-port))
-                         (sendfile in out bytes: 32))) #t #f)
-                    (file-contents test-file-out)))
+        (define (chunking-test proc) 
+         (call-with-connection-to-server
+          (lambda (server-in server-out)
+            (let ((input (open-input-string buffer)))
+              (write-content-size server-out -1)
+              (proc input server-out)
+              (close-output-port server-out)
+              (read-checksum server-in)))))
 
-            (test "giving size and offset"
-                  "It is a mindset" 
-                  (begin
-                    (with-prepared-environment
-                     offset-test-file
-                     (lambda (in out)
-                       (parameterize ((force-implementation 'read-write-port))
-                         (sendfile in out offset: 213 bytes: 15))) #t #f)
-                    (file-contents test-file-out)))
+        (define-syntax test-chunking
+          (syntax-rules ()
+            ((_ implementation)
+             (test-group implementation
+               (parameterize ((force-implementation (string->symbol implementation)))          
+                 (test "offsets"
+                       (buffer-checksum tail)
+                       (chunking-test
+                        (lambda (input output)
+                          (sendfile input output offset: 40)))
+                       )
+                 (test "size"
+                       (buffer-checksum head)
+                       (chunking-test
+                        (lambda (input output)
+                          (sendfile input output bytes: 20))))
+             
+                 (test "size and offset"
+                       (buffer-checksum middle)
+                       (chunking-test
+                        (lambda (input output)
+                          (sendfile input output offset: 20 bytes: 20)))))))))
+        
+        (when sendfile-available
+          (test-chunking "sendfile"))
 
-            
-            
-            ;; (test "giving too high offset" #t #f)
-            ;; (test "giving too low offset" #t #f)
-            ;; (test "giving too high size" #t #f)
-            ;; (test "giving too low size" #t #f)
+        (when mmap-available
+          (test-chunking "mmapped"))
 
-            )
+        (test-chunking "read-write")
+        
+        (test-chunking "read-write-port")))
 
-(test-end "Chunking")
+   (test-group "bugs"               
+               (call-with-buffer/checksum
+                (kibibytes 1)
+                (lambda (buffer checksum)
+                  (test "custom input port without fd [bug #542]"
+                        checksum
+                        (call-with-connection-to-server
+                         (lambda (server-in server-out)
+                           (write-content-size server-out (kibibytes 1))
+                           (sendfile (open-input-string buffer) server-out)
+                           (read-checksum server-in))))))
+   
+    
+               (call-with-temporary-file/checksum
+                (generate-buffer (mebibytes 2))
+                (lambda (temp-file expected-checksum)
+                  (test "send files > 1 mebibyte"
+                        expected-checksum
+                        (stream-file temp-file sendfile)))))))
 
-(test-group "read-write-loop"
-      (test "send"
-       test-file-size
-       (with-prepared-environment test-file
-        (lambda (in out)
-          (impl:read-write-loop/fd in out 0 test-file-size)) #f #f))
-      (sleep 1)
-      (test "verify"
-       test-file-checksum
-       (compute-file-checksum test-file-out)))
+(unless (zero? (test-failure-count)) (exit 1))
 
-(test-group "read-write-loop (ports-only)"
-      (test "send"
-        test-file-size
-        (with-prepared-environment test-file
-         (lambda (in out)
-             (impl:read-write-loop/port in out 0 test-file-size)) #t #f))
-      (sleep 1)
-      (test "verify"
-       test-file-checksum
-       (compute-file-checksum test-file-out)))
-
-
-(if sendfile-available
-    (test-group "sendfile-impl"
-                (test "send"
-                      test-file-size 
-                      (with-prepared-environment test-file
-                       (lambda (in out)
-                         (impl:sendfile in out 0 test-file-size)) #f #f))
-                 (sleep 1)
-                 (test "verify"
-                       test-file-checksum
-                       (compute-file-checksum test-file-out))))
-
-(if mmap-available
-    (test-group "mmapped io"
-
-                (test "send"
-                      test-file-size 
-                      (with-prepared-environment test-file
-                       (lambda (in out)
-                         (impl:mmapped in out 0 test-file-size)) #f #f))
-                (sleep 1)
-                (test "verify"
-                      test-file-checksum
-                      (compute-file-checksum test-file-out))))
-                          
-
-
-
-(test-begin "interface")
-
-(test-group "sendfile"
-      (test "send"
-            test-file-size
-            (with-prepared-environment test-file
-             (lambda (in out)
-               (sendfile in out)) #t #f))
-      (sleep 1)
-      (test "verify"
-            test-file-checksum
-            (compute-file-checksum test-file-out)))
-
-
-
-
-(test-group "custom input port without fd [bug #542]"
-            (let ((test-content "I'm content from a custom port"))
-              (test "send"
-                    (string-length test-content)
-                    (with-prepared-environment test-file
-                                               (lambda (ignored out)
-                                                 (sendfile
-                                                  (open-input-string test-content)
-                                                  out)) #t #t))))
-
-
-
-(test-end "interface")
-
-(test-begin "forcing implementation")
-
-(test "read-write-loop"
-      'read-write-loop
-      (with-prepared-environment test-file
-                                 (lambda (in out)
-                                   (parameterize ((force-implementation 'read-write))
-                                     (sendfile in out)
-                                     *last-selected-implementation*)) #t))
-
-(if sendfile-available
-    (test "sendfile"
-          'sendfile
-          (with-prepared-environment test-file
-                                     (lambda (in out)
-                                       (parameterize ((force-implementation 'sendfile))
-                                         (sendfile in out)
-                                         *last-selected-implementation*)) #t)))
-(if mmap-available
-    (test "mmapped"
-          'mmapped
-          (with-prepared-environment test-file
-                                     (lambda (in out)
-                                       (parameterize ((force-implementation 'mmapped))
-                                         (sendfile in out)
-                                         *last-selected-implementation*)) #t)))
-
-(test-end "forcing implementation")
-
-
-
-(tear-down the-server)
-  
-(unless (zero? (test-failure-count)) (exit 1))

tests/run2.scm

-;; 
-;; %%HEADER%%
-;; 
-
-(use test)
-(load "test-helper")
-(use sendfile)
-
-
-(with-running-server
-
- (let* ((mb-buffer (generate-buffer (mebibytes 1)))
-        (mb-checksum (buffer-checksum mb-buffer)))
-
-
-   (define (stream-mb-buffer)
-     (call-with-temporary-file/checksum
-      mb-buffer
-      (lambda (temp-file _)
-        (stream-file temp-file sendfile))))
- 
-   (test-group "sendfile main interface"
-               
-               (test "sendfile" mb-checksum (stream-mb-buffer)))
-
-   (test-group "forcing implementation"
-               
-               (parameterize ((force-implementation 'read-write))
-                 (test "read-write" mb-checksum (stream-mb-buffer)))
-
-               (if sendfile-available
-                   (parameterize ((force-implementation 'sendfile))
-                     (test "sendfile(2)" mb-checksum (stream-mb-buffer))))
-
-               (if mmap-available
-                   (parameterize ((force-implementation 'mmapped))
-                     (test "mmap(2)" mb-checksum (stream-mb-buffer))))
-
-               (parameterize ((force-implementation 'read-write-port))
-                 (test "read-write-port" mb-checksum (stream-mb-buffer))))
-
-
-   (test-group "read-write variations"
-               
-               (call-with-temporary-file/checksum
-                (generate-buffer (mebibytes 1))
-                (lambda (temp-file expected-checksum)
-                  (test "ports only"
-                        expected-checksum
-                        (call-with-connection-to-server
-                         (lambda (server-in server-out)
-                           (write-content-size server-out (mebibytes 1))
-                           (call-with-input-file temp-file
-                             (lambda (file-in)
-                               (sendfile file-in server-out)))
-                           (read-checksum server-in)))))))
-
-
-   (test-group "content chunking"
-               
-      (let* ((head   (generate-buffer 20 #\a))
-             (middle (generate-buffer 20 #\b))
-             (tail   (generate-buffer 20 #\c))
-             (buffer (string-append head middle tail)))         
-
-        (define (chunking-test proc) 
-         (call-with-connection-to-server
-          (lambda (server-in server-out)
-            (let ((input (open-input-string buffer)))
-              (write-content-size server-out -1)
-              (proc input server-out)
-              (close-output-port server-out)
-              (read-checksum server-in)))))
-
-        (define-syntax test-chunking
-          (syntax-rules ()
-            ((_ implementation)
-             (test-group implementation
-               (parameterize ((force-implementation (string->symbol implementation)))          
-                 (test "offsets"
-                       (buffer-checksum tail)
-                       (chunking-test
-                        (lambda (input output)
-                          (sendfile input output offset: 40)))
-                       )
-                 (test "size"
-                       (buffer-checksum head)
-                       (chunking-test
-                        (lambda (input output)
-                          (sendfile input output bytes: 20))))
-             
-                 (test "size and offset"
-                       (buffer-checksum middle)
-                       (chunking-test
-                        (lambda (input output)
-                          (sendfile input output offset: 20 bytes: 20)))))))))
-        
-        (when sendfile-available
-          (test-chunking "sendfile"))
-
-        (when mmap-available
-          (test-chunking "mmapped"))
-
-        (test-chunking "read-write")
-        
-        (test-chunking "read-write-port")))
-
-   (test-group "bugs"               
-               (call-with-buffer/checksum
-                (kibibytes 1)
-                (lambda (buffer checksum)
-                  (test "custom input port without fd [bug #542]"
-                        checksum
-                        (call-with-connection-to-server
-                         (lambda (server-in server-out)
-                           (write-content-size server-out (kibibytes 1))
-                           (sendfile (open-input-string buffer) server-out)
-                           (read-checksum server-in))))))
-   
-    
-               (call-with-temporary-file/checksum
-                (generate-buffer (mebibytes 2))
-                (lambda (temp-file expected-checksum)
-                  (test "send files > 1 mebibyte"
-                        expected-checksum
-                        (stream-file temp-file sendfile)))))))
-
-(unless (zero? (test-failure-count)) (exit 1))
-

tests/test-utils.scm

-(use srfi-69 tcp (srfi 4) posix)
-
-(define (notify fmt . args)
-  (apply printf fmt args)
-  (flush-output))
-
-(define (with-prepared-environment file proc #!optional (ports? #f)  (cleanup? #t))
-  (when cleanup?
-    (destroy-test-file-out))  
-  (parameterize ((tcp-read-timeout 3))
-    (let ((in (file-open file (bitwise-ior open/rdonly open/binary)))
-          (size (file-size file)))
-      ;; Touch or truncate file
-      (unless (file-exists? file) (with-output-to-file file void))
-      (receive (i o) (tcp-connect "localhost" (server-port))
-        (dynamic-wind
-            void
-            (lambda () (proc in (if ports? o (port->fileno o))))
-            (lambda ()
-              (close-input-port i)
-              (close-output-port o)
-              (file-close in)))))))
-
-
-;; the file that is send over the wire
-(define test-file "/tmp/sendfile-test.data")
-
-;; the server will write all data it receives to this file
-(define test-file-out "/tmp/sendfile-test.data.out")
-
-;; the size of the file to transfer in bytes
-(define wanted-test-file-size (* 1024 1024))
-
-
-;; this may differ slightly from wanted-test-file-size
-;; it is computed using (file-size)
-;; The reason for the difference is that we use a fixed-size
-;; fill-vector and this can lead to bytes being cut of as the
-;; remainder of the division if the wanted size is not a multiple of
-;; fill-chunk-size or less than fill-chunk-size
-(define test-file-size 0)
-
-(define fill-chunk-size 1024)
-
-;; the checksum of the file will be set during generation
-(define test-file-checksum #f)
-
-;; the server is started before the test-suite is run
-;; it listens on 5555 and writes anything it recieves to a fixed
-;; location
-
-(define (server-port)
-  (let ((p (get-environment-variable "SENDFILE_TEST_PORT")))
-    (if p
-        (string->number p)
-        5555)))
-
-(define (server)
-  (let ((listener (tcp-listen (server-port))))
-    (let loop ()
-      (receive (i o) (tcp-accept listener)
-        (let* ((file (open-output-file test-file-out #:binary))
-               (lock (file-lock/blocking file))
-               (vec (read-u8vector #f i)))
-          (file-write (port->fileno file) (u8vector->blob vec))
-          (file-unlock lock)
-          (close-output-port file)
-          (close-input-port i)
-          (close-output-port o)))
-      (loop))))
-
-;; in order to see if the files have changed during transfer we
-;; compute a checksum of the file
-(define (compute-file-checksum file)
-  (let* ((inp (open-input-file file #:binary))
-         (vec (read-u8vector #f inp)))
-    (close-input-port inp)
-    (hash vec)))
-
-
-;; this file is needed for a special test for a bug
-(define offset-test-file "offset-test.txt")
-
-
-(define (fill-test-file port)
-  (let ((fill (make-u8vector fill-chunk-size))
-        (rounds (if (> wanted-test-file-size fill-chunk-size) (inexact->exact (round (/ wanted-test-file-size fill-chunk-size))) 1)))
-    (do ((i 1 (+ i 1)))
-        ((= rounds i) i) (write-u8vector fill port))))
-
-(define (generate-test-files)
-  (newline)
-  (notify "Generating files")
-  (flush-output)
-  (call-with-output-file test-file fill-test-file #:binary)
-  (set! test-file-size (file-size test-file))
-  (set! test-file-checksum (compute-file-checksum test-file)))
-
-(define (destroy-test-files)
-  (if (file-exists? test-file) (delete-file test-file)))
-
-(define (destroy-test-file-out)
-  (if (file-exists? test-file-out) (delete-file test-file-out)))
-
-
-;; tests if server is allready up
-;; thanks to Peter Bex
-(define (can-connect?)
-  (handle-exceptions exn #f
-    (receive (in out)
-        (tcp-connect "localhost" (server-port))
-      (close-input-port in)
-      (close-output-port out)
-      #t)))
-
-(define (wait-for-server times)
-  (if (zero? times)
-      #f
-      (begin (sleep 1) (or (can-connect?) (wait-for-server (sub1 times))))))
-
-(define (file-contents file)
-  (let* ((in (open-input-file file))
-         (lock (file-lock/blocking in))
-         (contents (read-string #f in)))
-    (file-unlock lock)
-    (close-input-port in)
-    contents))
-
-(define (file-contents-chunk file offset length)
-  (let* ((content (file-contents file))
-         (offset-cnt (string-drop content offset)))
-    (string-take offset-cnt length)))
-
-
-(define (start-server)
-  (let ((pid (process-fork server)))
-    (unless (wait-for-server 3)
-      (notify "could not start server!!!")
-      (destroy-test-files)
-      (exit 0))
-    (flush-output)
-    (sleep 4)
-    pid))
-
-(define (stop-server pid)
-  (process-signal pid))
-
-(define (setup)
-  (generate-test-files)
-  (start-server))
-
-(define (tear-down pid)
-  (destroy-test-files)
-  (stop-server pid))
-
-
-
-
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.