suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Correct test usage of port

Browse Source
This commit is contained in:
Jay McCarthy 2010-08-30 06:30:30 -06:00
parent 9b657ad53a
commit 6a43e379e1
1 changed files with 65 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
collects/tests/web-server/pr/11125.rkt
View File

@ -5,62 +5,69 @@
web-server/servlet-env
tests/eli-tester)
(define PORT 8999)
(define (do-the-test PORT #:connection-close? connection-close?)
(define tc (make-thread-cell 0))
(define (start req)
(thread-cell-set! tc (add1 (thread-cell-ref tc)))
(number->string (thread-cell-ref tc)))
(define-values (pipe-read-p pipe-write-p)
(make-pipe))
(define server-t
(thread
(λ ()
(parameterize ([current-output-port pipe-write-p])
(serve/servlet start
#:launch-browser? #f
#:connection-close? connection-close?
#:quit? #f
#:listen-ip #f
#:port PORT
#:servlet-path "/")))))
; Wait for server to start
(void (read-line pipe-read-p)
(read-line pipe-read-p))
(define-values (http-read-p http-write-p)
(tcp-connect "localhost" PORT))
(define (get-tc/err http-read-p http-write-p)
(with-handlers
([exn?
(λ (x)
(define-values (new-http-read-p new-http-write-p)
(tcp-connect "localhost" PORT))
(set! http-read-p new-http-read-p)
(set! http-write-p new-http-write-p)
(get-tc http-read-p http-write-p))])
(get-tc http-read-p http-write-p)))
(define (get-tc http-read-p http-write-p)
(fprintf http-write-p "GET / HTTP/1.1\r\n\r\n")
(flush-output http-write-p)
(read-line http-read-p)
(read-headers http-read-p)
(string->number (string (read-char http-read-p))))
(define (do-the-test #:connection-close? connection-close?)
(define cust (make-custodian))
(begin0
(list (get-tc/err http-read-p http-write-p)
(get-tc/err http-read-p http-write-p))
(parameterize ([current-custodian cust])
(define tc (make-thread-cell 0))
(kill-thread server-t)))
(define (start req)
(thread-cell-set! tc (add1 (thread-cell-ref tc)))
(number->string (thread-cell-ref tc)))
(define-values (pipe-read-p pipe-write-p)
(make-pipe))
(define server-t
(thread
(λ ()
(parameterize ([current-output-port pipe-write-p])
(serve/servlet start
#:launch-browser? #f
#:connection-close? connection-close?
#:quit? #f
#:listen-ip #f
#:port 0
#:servlet-path "/")))))
; Wait for server to start
(define port-embedded-line (read-line pipe-read-p))
(match-define (regexp #rx"Your Web application is running at http://localhost:([0-9]+)\\."
(list _ port-string))
port-embedded-line)
(define port (string->number port-string))
(void (read-line pipe-read-p))
(define-values (http-read-p http-write-p)
(tcp-connect "localhost" port))
(define (get-tc/err http-read-p http-write-p)
(with-handlers
([exn?
(λ (x)
(define-values (new-http-read-p new-http-write-p)
(tcp-connect "localhost" port))
(set! http-read-p new-http-read-p)
(set! http-write-p new-http-write-p)
(get-tc http-read-p http-write-p))])
(get-tc http-read-p http-write-p)))
(define (get-tc http-read-p http-write-p)
(fprintf http-write-p "GET / HTTP/1.1\r\n\r\n")
(flush-output http-write-p)
(read-line http-read-p)
(read-headers http-read-p)
(string->number (string (read-char http-read-p))))
(begin0
(list (get-tc/err http-read-p http-write-p)
(get-tc/err http-read-p http-write-p))
(kill-thread server-t)))
(custodian-shutdown-all cust)))
(test
(do-the-test #:connection-close? #f) => (list 1 2)
(do-the-test #:connection-close? #t) => (list 1 1))
(test
(do-the-test PORT #:connection-close? #f) => (list 1 2)
(do-the-test (add1 PORT) #:connection-close? #t) => (list 1 1))