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
This commit is contained in:
parent
7f23a85e15
commit
f16e76ca32
|
@ -5,75 +5,19 @@
|
|||
racket/port
|
||||
racket/contract)
|
||||
|
||||
(define to-client #"0")
|
||||
(define to-server #"1")
|
||||
(define (tcp-localhost-available?)
|
||||
(with-handlers
|
||||
([exn? (λ (x) #f)])
|
||||
(define the-listener
|
||||
(tcp-listen 0 4 #t #f))
|
||||
(tcp-listen 0 5 #t))
|
||||
(define-values (local-host port end-host end-port)
|
||||
(tcp-addresses the-listener #t))
|
||||
(let loop ([listener the-listener]
|
||||
[sip #f] [sop #f]
|
||||
[connected? #f]
|
||||
[cip #f] [cop #f])
|
||||
(if (and (not listener)
|
||||
(not sip)
|
||||
(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))))))
|
||||
(thread
|
||||
(λ ()
|
||||
(tcp-accept the-listener)
|
||||
(tcp-close the-listener)))
|
||||
(tcp-connect "localhost" port)
|
||||
#t))
|
||||
|
||||
(provide
|
||||
(contract-out
|
||||
|
|
|
@ -613,6 +613,8 @@
|
|||
(test #f semaphore-try-wait? s)
|
||||
(test #f semaphore-try-wait? s2))))
|
||||
|
||||
(require tests/net/available)
|
||||
(when (tcp-localhost-available?)
|
||||
(define (listen-port x)
|
||||
(let-values ([(la lp pa pp) (tcp-addresses x #t)])
|
||||
lp))
|
||||
|
@ -720,7 +722,7 @@
|
|||
|
||||
(close-output-port cw)
|
||||
(test sr sync s t l sr))))
|
||||
(tcp-close l)))
|
||||
(tcp-close l))))
|
||||
|
||||
;; Test limited pipe output waiting:
|
||||
(let-values ([(r w) (make-pipe 5000)])
|
||||
|
|
Loading…
Reference in New Issue
Block a user