suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

try to make a network ::1 test adapt to an uncooperative environment

Browse Source
This commit is contained in:
Matthew Flatt 2017-11-10 06:54:01 -07:00
parent 77d904839a
commit b54ea8c5b1
1 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
pkgs/racket-test-core/tests/racket/file.rktl
View File

@ -1490,8 +1490,8 @@
;; TCP ;; TCP
(let ([do-once (let ([do-once
(lambda (evt? localhost) (lambda (evt? localhost [serve-localhost #f])
(let* ([l (tcp-listen 0 5 #t)] (let* ([l (tcp-listen 0 5 #t serve-localhost)]
[pn (listen-port l)]) [pn (listen-port l)])
(let-values ([(r1 w1) (tcp-connect localhost pn)] (let-values ([(r1 w1) (tcp-connect localhost pn)]
[(r2 w2) (if evt? [(r2 w2) (if evt?
@ -1518,13 +1518,20 @@
(do-once #f "localhost") (do-once #f "localhost")
(do-once #t "localhost") (do-once #t "localhost")
(with-handlers ([exn:fail:network:errno? (lambda (e) (with-handlers ([exn:fail:network:errno? (lambda (e)
;; catch forms of non-suport for IPv6: ;; Catch forms of non-suport for IPv6:
;; EAFNOSUPPORT "Address family not supported by protocol" ;; EAFNOSUPPORT "Address family not supported by protocol"
;; or getaddrinfo failure "no address associated with name" ;; or getaddrinfo failure "no address associated with name"
;; In case IPv6 is supported by the OS but not for the loopback
;; devce, we also catch "Cannot assign requested address"
(unless (regexp-match? (unless (regexp-match?
#rx"family not supported by protocol|no address associated with name" #rx"family not supported by protocol|no address associated with name|Cannot assign requested address"
(exn-message e)) (exn-message e))
(raise e)))]) (raise e)))])
;; Supply listener hostname, so we can check whether `listen` receives IPv6 connections
(do-once #f "::1" "::1")
(do-once #t "::1" "::1")
;; If we get this far, then "::1" apparently works, so try listening
;; at all interfaces and connecting to "::1":
(do-once #f "::1") (do-once #f "::1")
(do-once #t "::1"))) (do-once #t "::1")))