diff options
| -rw-r--r-- | tests/httpd | 6 | ||||
| -rw-r--r-- | tests/httpold.test | 19 |
2 files changed, 18 insertions, 7 deletions
diff --git a/tests/httpd b/tests/httpd index 3cf2170..9fd23e7 100644 --- a/tests/httpd +++ b/tests/httpd @@ -45,7 +45,7 @@ proc httpdAccept {newsock ipaddr port} { fconfigure $newsock -blocking 0 -translation {auto crlf} httpd_log $newsock Connect $ipaddr $port set data(ipaddr) $ipaddr - after 50 [list fileevent $newsock readable [list httpdRead $newsock]] + fileevent $newsock readable [list httpdRead $newsock] } # read data from a client request @@ -69,6 +69,10 @@ proc httpdRead { sock } { httpd_log $sock Error "bad first line:$line" httpdSockDone $sock } + if {[regexp {[\?&]delay=([^&]+)} val]} { + fileevent $sock readable {} + after $val [list fileevent $sock readable [list httpdRead $sock]] + } return } elseif {$data(state) == "mime"} { diff --git a/tests/httpold.test b/tests/httpold.test index e43a550..439ce92 100644 --- a/tests/httpold.test +++ b/tests/httpold.test @@ -256,14 +256,21 @@ test httpold-4.11 {httpEvent} { http_reset $token http_status $token } {reset} -test httpold-4.12 {httpEvent See [2641672]} knownBug { +test httpold-4.12 {httpEvent} -body { + set tout {} update set x {} - after 500 {lappend x ok} - set token [http_get $url -timeout 1 -command {lappend x fail}] - vwait x - list [http_status $token] $x -} {timeout ok} + set token [http_get $url -query delay=500 -timeout 1 -command {lappend x fail}] + set i 0; while {$x eq {} && [incr i] < 50} { + set tout [after 20 {set x progress}] + vwait x + if {$x ne "progress"} break + set x [http_status $token] + } + set x +} -cleanup { + if {$tout ne {}} {after cancel $tout} +} -result timeout test httpold-5.1 {http_formatQuery} { http_formatQuery name1 value1 name2 "value two" |