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..48e14ea 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 @@ -64,6 +64,10 @@ proc httpdRead { sock } { -> data(proto) data(url) data(query) data(httpversion)]} { set data(state) mime httpd_log $sock Query $line + if {[regexp {(?:^|[\?&])delay=([^&]+)} $data(query) {} val]} { + fileevent $sock readable {} + after $val [list fileevent $sock readable [list httpdRead $sock]] + } } else { httpdError $sock 400 httpd_log $sock Error "bad first line:$line" diff --git a/tests/httpold.test b/tests/httpold.test index e43a550..e760c92 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?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" |