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:
parent
7d47105aac
commit
191874f50f
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue
Block a user