test,serve: adjust kill test to pass in ci

Author: Bogdanp

.github/workflows/ci.yml

@@ -5,6 +5,7 @@ jobs:
     name: "Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }})"
     runs-on: ubuntu-latest
     strategy:
+      fail-fast: false
       matrix:
         racket-version: ["8.0", "8.1", "current"]
         racket-variant: ["BC", "CS"]

web-server-test/tests/web-server/serve-tests.rkt

@@ -5,6 +5,7 @@
          racket/port
          racket/promise
          rackunit
+         version/utils
          web-server/http
          web-server/safety-limits
          web-server/servlet-dispatch
@@ -107,36 +108,48 @@
             (http-conn-close! hc)))
          (check-duration stop 1 3 5))))
 
-    (test-case "kills the server if stop is called twice"
-      (define started?-sema
-        (make-semaphore))
-      (call-with-web-server
-       (lambda (_req)
-         (response/output
-          (lambda (out)
-            (displayln "start" out)
-            (semaphore-post started?-sema)
-            (sleep 100)
-            (displayln "end" out))))
-       (lambda (port stop)
-         (define hc (http-conn-open "127.0.0.1" #:port port))
-         (define-values (status _headers in)
-           (http-conn-sendrecv! hc "/"))
-         (check-equal? status #"HTTP/1.1 200 OK")
-         (define data-promise
-           (delay/thread
-            (port->bytes in)))
-         (semaphore-wait started?-sema)
-         (define stop-thds
-           (for/list ([_ (in-range 2)])
-             (thread stop)))
-         (check-duration
-          (lambda ()
-            (for-each thread-wait stop-thds))
-          0 1 2)
-         (check-equal?
-          (force data-promise)
-          #"start\n")))))))
+    ;; On versions prior to [1], net/http-client writes to standard
+    ;; error when reading from the connection's input port goes wrong.
+    ;; This makes raco test fail in --drdr mode, so avoid running this
+    ;; test on versions before 8.17.0.6.
+    ;;
+    ;; [1]: https://github.com/racket/racket/pull/5296
+    (when (version<=? "8.17.0.6" (version))
+      (test-case "kills the server if stop is called twice"
+        (define started?-sema
+          (make-semaphore))
+        (call-with-web-server
+         (lambda (_req)
+           (response/output
+            (lambda (out)
+              (displayln "start" out)
+              (semaphore-post started?-sema)
+              (sleep 100)
+              (displayln "end" out))))
+         (lambda (port stop)
+           (define hc (http-conn-open "127.0.0.1" #:port port))
+           (define-values (status _headers in)
+             (http-conn-sendrecv! hc "/"))
+           (check-equal? status #"HTTP/1.1 200 OK")
+           (define data-promise
+             (delay/thread
+              (with-handlers ([(lambda (e)
+                                 (and (exn:fail? e)
+                                      (regexp-match? #rx"input port is closed" (exn-message e))))
+                               (lambda (_)
+                                 #"")])
+                (port->bytes in))))
+           (semaphore-wait started?-sema)
+           (define stop-thds
+             (for/list ([_ (in-range 2)])
+               (thread stop)))
+           (check-duration
+            (lambda ()
+              (for-each thread-wait stop-thds))
+            0 1 2)
+           (check-match
+            (force data-promise)
+            (or #"" #"start\n")))))))))
 
 (module+ test
   (require rackunit/text-ui)