diff --git a/collects/tests/net/available.rkt b/collects/tests/net/available.rkt index 9fc245f2c9..3b67aa85f2 100644 --- a/collects/tests/net/available.rkt +++ b/collects/tests/net/available.rkt @@ -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