|
5 | 5 | racket/port
|
6 | 6 | racket/promise
|
7 | 7 | rackunit
|
| 8 | + version/utils |
8 | 9 | web-server/http
|
9 | 10 | web-server/safety-limits
|
10 | 11 | web-server/servlet-dispatch
|
|
52 | 53 | (fail-check "timed out"))
|
53 | 54 | (check-true
|
54 | 55 | (real-time . >= . lo)
|
55 |
| - (format "took more than ~a seconds to run" lo)) |
| 56 | + (format "took less than ~a seconds to run" lo)) |
56 | 57 | (check-true
|
57 | 58 | (real-time . <= . hi)
|
58 |
| - (format "took less than ~a seconds to run" hi))) |
| 59 | + (format "took more than ~a seconds to run" hi))) |
59 | 60 |
|
60 | 61 | (define serve-tests
|
61 | 62 | (test-suite
|
|
71 | 72 | (lambda (_port stop)
|
72 | 73 | (check-duration stop 0 1 5))))
|
73 | 74 |
|
74 |
| - (test-case "waits for in-progress requests to finish" |
75 |
| - (call-with-web-server |
76 |
| - (lambda (_req) |
77 |
| - (response/output |
78 |
| - (lambda (out) |
79 |
| - (for ([idx (in-range 2)]) |
80 |
| - (displayln idx out) |
81 |
| - (sleep 1))))) |
82 |
| - (lambda (port stop) |
83 |
| - (define hc (http-conn-open "127.0.0.1" #:port port)) |
84 |
| - (define-values (status _headers in) |
85 |
| - (http-conn-sendrecv! hc "/")) |
86 |
| - (check-equal? status #"HTTP/1.1 200 OK") |
87 |
| - (check-duration stop 2 6 6) |
88 |
| - (check-equal? (port->bytes in) #"0\n1\n")))) |
| 75 | + ;; On versions prior to [1], net/http-client writes to standard |
| 76 | + ;; error when reading from the connection's input port goes wrong. |
| 77 | + ;; This makes raco test fail in --drdr mode, so avoid running these |
| 78 | + ;; test on versions before 8.17.0.6. |
| 79 | + ;; |
| 80 | + ;; [1]: https://github.com/racket/racket/pull/5296 |
| 81 | + (when (version<=? "8.17.0.6" (version)) |
| 82 | + (test-case "waits for in-progress requests to finish" |
| 83 | + (call-with-web-server |
| 84 | + (lambda (_req) |
| 85 | + (response/output |
| 86 | + (lambda (out) |
| 87 | + (for ([idx (in-range 2)]) |
| 88 | + (displayln idx out) |
| 89 | + (sleep 1))))) |
| 90 | + (lambda (port stop) |
| 91 | + (define hc (http-conn-open "127.0.0.1" #:port port)) |
| 92 | + (define-values (status _headers in) |
| 93 | + (http-conn-sendrecv! hc "/")) |
| 94 | + (check-equal? status #"HTTP/1.1 200 OK") |
| 95 | + (check-duration stop 2 6 6) |
| 96 | + (check-equal? (port->bytes in) #"0\n1\n")))) |
89 | 97 |
|
90 |
| - (test-case "stops when in-progress requests stop" |
91 |
| - (call-with-web-server |
92 |
| - (lambda (_req) |
93 |
| - (response/output |
94 |
| - (lambda (out) |
95 |
| - (for ([idx (in-range 10)]) |
96 |
| - (displayln idx out) |
97 |
| - (sleep 1))))) |
98 |
| - (lambda (port stop) |
99 |
| - (define hc (http-conn-open "127.0.0.1" #:port port)) |
100 |
| - (define-values (status _headers in) |
101 |
| - (http-conn-sendrecv! hc "/")) |
102 |
| - (check-equal? status #"HTTP/1.1 200 OK") |
103 |
| - (thread |
104 |
| - (lambda () |
105 |
| - (read-line in) |
106 |
| - (close-input-port in) |
107 |
| - (http-conn-close! hc))) |
108 |
| - (check-duration stop 1 3 5)))) |
| 98 | + (test-case "stops when in-progress requests stop" |
| 99 | + (call-with-web-server |
| 100 | + (lambda (_req) |
| 101 | + (response/output |
| 102 | + (lambda (out) |
| 103 | + (for ([idx (in-range 10)]) |
| 104 | + (displayln idx out) |
| 105 | + (sleep 1))))) |
| 106 | + (lambda (port stop) |
| 107 | + (define hc (http-conn-open "127.0.0.1" #:port port)) |
| 108 | + (define-values (status _headers in) |
| 109 | + (http-conn-sendrecv! hc "/")) |
| 110 | + (check-equal? status #"HTTP/1.1 200 OK") |
| 111 | + (thread |
| 112 | + (lambda () |
| 113 | + (read-line in) |
| 114 | + (close-input-port in) |
| 115 | + (http-conn-close! hc))) |
| 116 | + (check-duration stop 1 3 5)))) |
109 | 117 |
|
110 |
| - (test-case "kills the server if stop is called twice" |
111 |
| - (define started?-sema |
112 |
| - (make-semaphore)) |
113 |
| - (call-with-web-server |
114 |
| - (lambda (_req) |
115 |
| - (response/output |
116 |
| - (lambda (out) |
117 |
| - (displayln "start" out) |
118 |
| - (semaphore-post started?-sema) |
119 |
| - (sleep 100) |
120 |
| - (displayln "end" out)))) |
121 |
| - (lambda (port stop) |
122 |
| - (define hc (http-conn-open "127.0.0.1" #:port port)) |
123 |
| - (define-values (status _headers in) |
124 |
| - (http-conn-sendrecv! hc "/")) |
125 |
| - (check-equal? status #"HTTP/1.1 200 OK") |
126 |
| - (define data-promise |
127 |
| - (delay/thread |
128 |
| - (port->bytes in))) |
129 |
| - (semaphore-wait started?-sema) |
130 |
| - (define stop-thds |
131 |
| - (for/list ([_ (in-range 2)]) |
132 |
| - (thread stop))) |
133 |
| - (check-duration |
134 |
| - (lambda () |
135 |
| - (for-each thread-wait stop-thds)) |
136 |
| - 0 1 2) |
137 |
| - (check-equal? |
138 |
| - (force data-promise) |
139 |
| - #"start\n"))))))) |
| 118 | + (test-case "kills the server if stop is called twice" |
| 119 | + (define started?-sema |
| 120 | + (make-semaphore)) |
| 121 | + (call-with-web-server |
| 122 | + (lambda (_req) |
| 123 | + (response/output |
| 124 | + (lambda (out) |
| 125 | + (displayln "start" out) |
| 126 | + (semaphore-post started?-sema) |
| 127 | + (sleep 100) |
| 128 | + (displayln "end" out)))) |
| 129 | + (lambda (port stop) |
| 130 | + (define hc (http-conn-open "127.0.0.1" #:port port)) |
| 131 | + (define-values (status _headers in) |
| 132 | + (http-conn-sendrecv! hc "/")) |
| 133 | + (check-equal? status #"HTTP/1.1 200 OK") |
| 134 | + (define data-promise |
| 135 | + (delay/thread |
| 136 | + (with-handlers ([(lambda (e) |
| 137 | + (and (exn:fail? e) |
| 138 | + (regexp-match? #rx"input port is closed" (exn-message e)))) |
| 139 | + (lambda (_) |
| 140 | + #"")]) |
| 141 | + (port->bytes in)))) |
| 142 | + (semaphore-wait started?-sema) |
| 143 | + (define stop-thds |
| 144 | + (for/list ([_ (in-range 2)]) |
| 145 | + (thread stop))) |
| 146 | + (check-duration |
| 147 | + (lambda () |
| 148 | + (for-each thread-wait stop-thds)) |
| 149 | + 0 1 2) |
| 150 | + (check-match |
| 151 | + (force data-promise) |
| 152 | + (or #"" #"start\n"))))))))) |
140 | 153 |
|
141 | 154 | (module+ test
|
142 | 155 | (require rackunit/text-ui)
|
|
0 commit comments