From 7d47105aaca7614366d59a5c3ae905a53b4342db Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Tue, 23 Oct 2012 11:27:08 -0600
Subject: [PATCH] Test localhost tcp before running echo server test

original commit: 552fe0f755b30ce298aa0be0044eb6ae68209873
---
 collects/tests/net/available.rkt | 83 ++++++++++++++++++++++++++++++++
 collects/tests/net/websocket.rkt | 21 ++++----
 2 files changed, 94 insertions(+), 10 deletions(-)
 create mode 100644 collects/tests/net/available.rkt

diff --git a/collects/tests/net/available.rkt b/collects/tests/net/available.rkt
new file mode 100644
index 0000000000..9fc245f2c9
--- /dev/null
+++ b/collects/tests/net/available.rkt
@@ -0,0 +1,83 @@
+#lang racket/base
+(require racket/tcp
+         racket/list
+         racket/match
+         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))
+    (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))))))
+
+(provide
+ (contract-out
+  [tcp-localhost-available? (-> boolean?)]))
+
+(module+ main
+  (tcp-localhost-available?))
diff --git a/collects/tests/net/websocket.rkt b/collects/tests/net/websocket.rkt
index 51373a3351..cc90765581 100644
--- a/collects/tests/net/websocket.rkt
+++ b/collects/tests/net/websocket.rkt
@@ -6,6 +6,7 @@
          racket/async-channel
          net/url
          rackunit
+         tests/net/available
          tests/eli-tester)
 
 (define RANDOM-K 100)
@@ -81,14 +82,14 @@
              (define p (async-channel-get confirm))
              (define conn
                (ws-connect (string->url (format "ws://localhost:~a" p))))
-             (when conn
-               (test (ws-send! conn r)
-                     (ws-recv conn) => r
-                     (ws-send! conn "a")
-                     (ws-recv conn) => "a"
-                     (ws-close! conn)))
+             (test (ws-send! conn r)
+                   (ws-recv conn) => r
+                   (ws-send! conn "a")
+                   (ws-recv conn) => "a"
+                   (ws-close! conn))
              (test (shutdown!)))]
-     (test #:failure-prefix "old"
-           (parameterize ([framing-mode 'old]) (test-echo-server))
-           #:failure-prefix "new"
-           (parameterize ([framing-mode 'new]) (test-echo-server))))))
+          (when (tcp-localhost-available?)
+            (test #:failure-prefix "old"
+                  (parameterize ([framing-mode 'old]) (test-echo-server))
+                  #:failure-prefix "new"
+                  (parameterize ([framing-mode 'new]) (test-echo-server)))))))