Changeset 33903 in project for release


Ignore:
Timestamp:
03/21/17 21:54:33 (18 months ago)
Author:
sjamaan
Message:

http-client: Globally set tcp timeouts, not just in the test server

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/http-client/trunk/tests/testlib.scm

    r33902 r33903  
    3030                    (tcp-connect "localhost" server-port)) )
    3131
     32(tcp-read-timeout 10)
     33(tcp-write-timeout 10)
     34
    3235;; Set up a number of fake connections to a "server", with predefined
    3336;; responses for each (expected) request.
     
    3942          (thread-start!
    4043           (lambda ()
    41              (parameterize ((tcp-read-timeout 10)
    42                             (tcp-write-timeout 10))
    43                (let lp ()
    44                  (if (null? responses)
    45                      (tcp-close listener)
    46                      (receive (in out) (tcp-accept listener)
    47                        (let* ((req (read-request in))
    48                               (h (request-headers req))
    49                               (log (make-log req #f))
    50                               (response (car responses)))
     44             (let lp ()
     45               (if (null? responses)
     46                   (tcp-close listener)
     47                   (receive (in out) (tcp-accept listener)
     48                     (let* ((req (read-request in))
     49                            (h (request-headers req))
     50                            (log (make-log req #f))
     51                            (response (car responses)))
    5152
    52                          (when ((request-has-message-body?) req)
    53                            (let* ((len (header-value 'content-length h))
    54                                   (body (read-string len (request-port req))))
    55                              (log-body-set! log body)))
    56                          (set! logs (cons log logs))
    57                          (set! responses (cdr responses))
    58                          (display response out)
    59                          (close-output-port out)
    60                          (lp))))))))))
     53                       (when ((request-has-message-body?) req)
     54                         (let* ((len (header-value 'content-length h))
     55                                (body (read-string len (request-port req))))
     56                           (log-body-set! log body)))
     57                       (set! logs (cons log logs))
     58                       (set! responses (cdr responses))
     59                       (display response out)
     60                       (close-output-port out)
     61                       (lp)))))))))
    6162
    6263    (set! server-port (tcp-listener-port listener))
Note: See TracChangeset for help on using the changeset viewer.