second attempt at removing reliance on tcp. available has been greatly simplified because it relied on the behavior the thread.rktl test is actually testing

original commit: f16e76ca32
This commit is contained in:
Jay McCarthy 2012-10-26 15:26:39 -06:00
parent 7d47105aac
commit 191874f50f

View File

@ -5,75 +5,19 @@
racket/port racket/port
racket/contract) racket/contract)
(define to-client #"0")
(define to-server #"1")
(define (tcp-localhost-available?) (define (tcp-localhost-available?)
(with-handlers (with-handlers
([exn? (λ (x) #f)]) ([exn? (λ (x) #f)])
(define the-listener (define the-listener
(tcp-listen 0 4 #t #f)) (tcp-listen 0 5 #t))
(define-values (local-host port end-host end-port) (define-values (local-host port end-host end-port)
(tcp-addresses the-listener #t)) (tcp-addresses the-listener #t))
(let loop ([listener the-listener] (thread
[sip #f] [sop #f] (λ ()
[connected? #f] (tcp-accept the-listener)
[cip #f] [cop #f]) (tcp-close the-listener)))
(if (and (not listener) (tcp-connect "localhost" port)
(not sip) #t))
(not sop)
connected?
(not cip)
(not cop))
#t
(sync
(if listener
(handle-evt
(tcp-accept-evt listener)
(match-lambda
[(list sip sop)
(tcp-close listener)
(loop #f sip sop connected? cip cop)]))
never-evt)
(if sop
(handle-evt
(write-bytes-avail-evt to-client sop)
(λ (written-bs-n)
(tcp-abandon-port sop)
(loop #f sip #f connected? cip cop)))
never-evt)
(if sip
(handle-evt
(read-bytes-evt 1 sip)
(λ (read-bs)
(unless (bytes=? to-server read-bs)
(error 'wrong))
(tcp-abandon-port sip)
(loop #f #f sop connected? cip cop)))
never-evt)
(if connected?
never-evt
(handle-evt
always-evt
(λ (_)
(define-values (cip cop)
(tcp-connect "localhost" port))
(loop listener sip sop #t cip cop))))
(if cop
(handle-evt
(write-bytes-avail-evt to-server cop)
(λ (written-bs-n)
(tcp-abandon-port cop)
(loop listener sip sop connected? cip #f)))
never-evt)
(if cip
(handle-evt
(read-bytes-evt 1 cip)
(λ (read-bs)
(unless (bytes=? to-client read-bs)
(error 'wrong))
(tcp-abandon-port cip)
(loop listener sip sop connected? #f cop)))
never-evt))))))
(provide (provide
(contract-out (contract-out