source: project/release/3/sendfile/trunk/tests/test-utils.scm @ 11816

Last change on this file since 11816 was 11816, checked in by certainty, 12 years ago

cleaned up the source
added a ports-only version of read-write-loop and adjusted the main-interface to choose this version
if a port is passed that has no underlying fd.
adjusted unit-tests and added new test for ports-only version
The last selected implementation is no set by the implementations instead of the dispatcher.
This simplified the source.

File size: 1.7 KB
Line 
1(use srfi-69)
2
3(define (compute-file-checksum file)
4  (let* ((inp (open-input-file file #:binary))
5         (vec (read-u8vector #f inp)))
6    (close-input-port inp)
7    (hash vec)))
8
9
10(define test-file-out "outfile.data")
11(define big-test-file "sicp.pdf")
12(define test-file "testfile.jpg")
13(define test-file-size (file-size test-file))
14(define big-test-file-size (file-size big-test-file))
15(define test-file-checksum (compute-file-checksum test-file))
16(define big-test-file-checksum (compute-file-checksum big-test-file))
17
18(define (with-prepared-environment file proc #!optional (ports? #f))
19  (let ((in (file-open file (bitwise-ior open/rdonly open/binary)))
20        (size (file-size file)))
21    (receive (i o) (tcp-connect "localhost" 5555)
22      (if (file-exists? test-file-out) (delete-file test-file-out))
23      (let ((res (proc in (if ports? o (port->fileno o)))))
24        (close-input-port i)
25        (close-output-port o)
26        (file-close in)
27        res))))
28
29
30(define (server)
31  (let ((listener (tcp-listen 5555)))
32    (let loop ()
33      (receive (i o) (tcp-accept listener)
34        (let ((vec (read-u8vector #f i))
35              (file (open-output-file test-file-out #:binary)))
36          (file-write (port->fileno file) (u8vector->blob vec))
37          (close-output-port file)
38          (close-input-port i)
39          (close-output-port o)))
40      (loop))))
41
42
43;; tests if server is allready up
44;; thanks to Peter Bex
45(define (can-connect?)
46  (handle-exceptions exn #f
47    (receive (in out)
48        (tcp-connect "localhost" 5555)
49      (close-input-port in)
50      (close-output-port out)
51      #t)))
52
53(define (wait-for-server times)
54  (if (zero? times)
55      #f
56      (begin (sleep 1) (or (can-connect?) (wait-for-server (sub1 times))))))
57     
Note: See TracBrowser for help on using the repository browser.