From 58ec991bd118c43c3a7d3645c8dbf0accc760585 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 19 Aug 2010 16:32:55 -0600
Subject: [PATCH] Adding WebSocket stress test and improving fit output

original commit: 5eb8f181f6993d7ba8a0281772117b1dd75e72c7
---
 collects/tests/stress/net/websocket.rkt | 32 +++++++++++++++++++++++++
 1 file changed, 32 insertions(+)
 create mode 100644 collects/tests/stress/net/websocket.rkt

diff --git a/collects/tests/stress/net/websocket.rkt b/collects/tests/stress/net/websocket.rkt
new file mode 100644
index 0000000000..da05936bd1
--- /dev/null
+++ b/collects/tests/stress/net/websocket.rkt
@@ -0,0 +1,32 @@
+#lang racket/base
+(require tests/stress/stress
+         net/websocket
+         net/url
+         racket/async-channel)
+
+(fit "websocket echo server"
+     500
+     (λ (n)
+       (define confirm (make-async-channel))
+       (define shutdown!
+         (ws-serve #:port 0
+                   #:confirmation-channel confirm
+                   (λ (wsc _)
+                     (let loop ()
+                       (define m (ws-recv wsc))
+                       (unless (eof-object? m)
+                         (ws-send! wsc m)
+                         (loop))))))
+       (define port (async-channel-get confirm))
+       
+       (define THREADS 10)
+       (define REQS n)
+       
+       (for-each thread-wait
+                 (for/list ([t (in-range THREADS)])
+                   (thread
+                    (λ ()
+                      (define conn (ws-connect (string->url (format "ws://localhost:~a" port))))
+                      (for ([r (in-range REQS)])
+                        (ws-send! conn "ping")
+                        (ws-recv conn))))))))