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

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]
+    (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
  (contract-out

collects/tests/racket/thread.rktl

@@ -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)])