diff options
| author | Glenn Morris | 2016-06-07 20:50:35 -0700 |
|---|---|---|
| committer | Glenn Morris | 2016-06-07 20:50:35 -0700 |
| commit | 378f5776fce0b4d6df95aa65be2ef6276e7bc610 (patch) | |
| tree | 62712838d251690dc0a365fa836f2859cebae636 | |
| parent | 3db521ccaf3a5b6892bf23ea1305c7cfe9aa1cce (diff) | |
| download | emacs-378f5776fce0b4d6df95aa65be2ef6276e7bc610.tar.gz emacs-378f5776fce0b4d6df95aa65be2ef6276e7bc610.zip | |
Try to avoid hangs and stray procs in network-stream-tests. (Bug#23560)
* test/lisp/net/network-stream-tests.el (connect-to-tls-ipv4-wait)
(connect-to-tls-ipv4-nowait, connect-to-tls-ipv6-nowait):
Ensure gnutls-serv process gets killed.
(echo-server-nowait, connect-to-tls-ipv4-nowait):
Limit the amount of time we might wait.
| -rw-r--r-- | test/lisp/net/network-stream-tests.el | 136 |
1 files changed, 74 insertions, 62 deletions
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index 9e21420dbbc..afffeeb1932 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el | |||
| @@ -146,10 +146,13 @@ | |||
| 146 | :host "localhost" | 146 | :host "localhost" |
| 147 | :nowait t | 147 | :nowait t |
| 148 | :family 'ipv4 | 148 | :family 'ipv4 |
| 149 | :service port))) | 149 | :service port)) |
| 150 | (times 0)) | ||
| 150 | (should (eq (process-status proc) 'connect)) | 151 | (should (eq (process-status proc) 'connect)) |
| 151 | (while (eq (process-status proc) 'connect) | 152 | (while (and (eq (process-status proc) 'connect) |
| 153 | (< (setq times (1+ times)) 10)) | ||
| 152 | (sit-for 0.1)) | 154 | (sit-for 0.1)) |
| 155 | (should-not (eq (process-status proc) 'connect)) | ||
| 153 | (with-current-buffer (process-buffer proc) | 156 | (with-current-buffer (process-buffer proc) |
| 154 | (process-send-string proc "echo foo") | 157 | (process-send-string proc "echo foo") |
| 155 | (sleep-for 0.1) | 158 | (sleep-for 0.1) |
| @@ -174,24 +177,26 @@ | |||
| 174 | (let ((server (make-tls-server 44332)) | 177 | (let ((server (make-tls-server 44332)) |
| 175 | (times 0) | 178 | (times 0) |
| 176 | proc status) | 179 | proc status) |
| 177 | (sleep-for 1) | 180 | (unwind-protect |
| 178 | (with-current-buffer (process-buffer server) | 181 | (progn |
| 179 | (message "gnutls-serv: %s" (buffer-string))) | 182 | (sleep-for 1) |
| 183 | (with-current-buffer (process-buffer server) | ||
| 184 | (message "gnutls-serv: %s" (buffer-string))) | ||
| 180 | 185 | ||
| 181 | ;; It takes a while for gnutls-serv to start. | 186 | ;; It takes a while for gnutls-serv to start. |
| 182 | (while (and (null (ignore-errors | 187 | (while (and (null (ignore-errors |
| 183 | (setq proc (make-network-process | 188 | (setq proc (make-network-process |
| 184 | :name "bar" | 189 | :name "bar" |
| 185 | :buffer (generate-new-buffer "*foo*") | 190 | :buffer (generate-new-buffer "*foo*") |
| 186 | :host "localhost" | 191 | :host "localhost" |
| 187 | :service 44332)))) | 192 | :service 44332)))) |
| 188 | (< (setq times (1+ times)) 10)) | 193 | (< (setq times (1+ times)) 10)) |
| 189 | (sit-for 0.1)) | 194 | (sit-for 0.1)) |
| 190 | (should proc) | 195 | (should proc) |
| 191 | (gnutls-negotiate :process proc | 196 | (gnutls-negotiate :process proc |
| 192 | :type 'gnutls-x509pki | 197 | :type 'gnutls-x509pki |
| 193 | :hostname "localhost") | 198 | :hostname "localhost")) |
| 194 | (delete-process server) | 199 | (if (process-live-p server) (delete-process server))) |
| 195 | (setq status (gnutls-peer-status proc)) | 200 | (setq status (gnutls-peer-status proc)) |
| 196 | (should (consp status)) | 201 | (should (consp status)) |
| 197 | (delete-process proc) | 202 | (delete-process proc) |
| @@ -210,28 +215,33 @@ | |||
| 210 | (let ((server (make-tls-server 44331)) | 215 | (let ((server (make-tls-server 44331)) |
| 211 | (times 0) | 216 | (times 0) |
| 212 | proc status) | 217 | proc status) |
| 213 | (sleep-for 1) | 218 | (unwind-protect |
| 214 | (with-current-buffer (process-buffer server) | 219 | (progn |
| 215 | (message "gnutls-serv: %s" (buffer-string))) | 220 | (sleep-for 1) |
| 221 | (with-current-buffer (process-buffer server) | ||
| 222 | (message "gnutls-serv: %s" (buffer-string))) | ||
| 216 | 223 | ||
| 217 | ;; It takes a while for gnutls-serv to start. | 224 | ;; It takes a while for gnutls-serv to start. |
| 218 | (while (and (null (ignore-errors | 225 | (while (and (null (ignore-errors |
| 219 | (setq proc (make-network-process | 226 | (setq proc (make-network-process |
| 220 | :name "bar" | 227 | :name "bar" |
| 221 | :buffer (generate-new-buffer "*foo*") | 228 | :buffer (generate-new-buffer "*foo*") |
| 222 | :nowait t | 229 | :nowait t |
| 223 | :tls-parameters | 230 | :tls-parameters |
| 224 | (cons 'gnutls-x509pki | 231 | (cons 'gnutls-x509pki |
| 225 | (gnutls-boot-parameters | 232 | (gnutls-boot-parameters |
| 226 | :hostname "localhost")) | 233 | :hostname "localhost")) |
| 227 | :host "localhost" | 234 | :host "localhost" |
| 228 | :service 44331)))) | 235 | :service 44331)))) |
| 229 | (< (setq times (1+ times)) 10)) | 236 | (< (setq times (1+ times)) 10)) |
| 230 | (sit-for 0.1)) | 237 | (sit-for 0.1)) |
| 231 | (should proc) | 238 | (should proc) |
| 232 | (while (eq (process-status proc) 'connect) | 239 | (setq times 0) |
| 233 | (sit-for 0.1)) | 240 | (while (and (eq (process-status proc) 'connect) |
| 234 | (delete-process server) | 241 | (< (setq times (1+ times)) 10)) |
| 242 | (sit-for 0.1)) | ||
| 243 | (should-not (eq (process-status proc) 'connect))) | ||
| 244 | (if (process-live-p server) (delete-process server))) | ||
| 235 | (setq status (gnutls-peer-status proc)) | 245 | (setq status (gnutls-peer-status proc)) |
| 236 | (should (consp status)) | 246 | (should (consp status)) |
| 237 | (delete-process proc) | 247 | (delete-process proc) |
| @@ -248,29 +258,31 @@ | |||
| 248 | (let ((server (make-tls-server 44333)) | 258 | (let ((server (make-tls-server 44333)) |
| 249 | (times 0) | 259 | (times 0) |
| 250 | proc status) | 260 | proc status) |
| 251 | (sleep-for 1) | 261 | (unwind-protect |
| 252 | (with-current-buffer (process-buffer server) | 262 | (progn |
| 253 | (message "gnutls-serv: %s" (buffer-string))) | 263 | (sleep-for 1) |
| 264 | (with-current-buffer (process-buffer server) | ||
| 265 | (message "gnutls-serv: %s" (buffer-string))) | ||
| 254 | 266 | ||
| 255 | ;; It takes a while for gnutls-serv to start. | 267 | ;; It takes a while for gnutls-serv to start. |
| 256 | (while (and (null (ignore-errors | 268 | (while (and (null (ignore-errors |
| 257 | (setq proc (make-network-process | 269 | (setq proc (make-network-process |
| 258 | :name "bar" | 270 | :name "bar" |
| 259 | :buffer (generate-new-buffer "*foo*") | 271 | :buffer (generate-new-buffer "*foo*") |
| 260 | :family 'ipv6 | 272 | :family 'ipv6 |
| 261 | :nowait t | 273 | :nowait t |
| 262 | :tls-parameters | 274 | :tls-parameters |
| 263 | (cons 'gnutls-x509pki | 275 | (cons 'gnutls-x509pki |
| 264 | (gnutls-boot-parameters | 276 | (gnutls-boot-parameters |
| 265 | :hostname "localhost")) | 277 | :hostname "localhost")) |
| 266 | :host "::1" | 278 | :host "::1" |
| 267 | :service 44333)))) | 279 | :service 44333)))) |
| 268 | (< (setq times (1+ times)) 10)) | 280 | (< (setq times (1+ times)) 10)) |
| 269 | (sit-for 0.1)) | 281 | (sit-for 0.1)) |
| 270 | (should proc) | 282 | (should proc) |
| 271 | (while (eq (process-status proc) 'connect) | 283 | (while (eq (process-status proc) 'connect) |
| 272 | (sit-for 0.1)) | 284 | (sit-for 0.1))) |
| 273 | (delete-process server) | 285 | (if (process-live-p server) (delete-process server))) |
| 274 | (setq status (gnutls-peer-status proc)) | 286 | (setq status (gnutls-peer-status proc)) |
| 275 | (should (consp status)) | 287 | (should (consp status)) |
| 276 | (delete-process proc) | 288 | (delete-process proc) |