closes [2641672fff] - resolved timing sensitivity of httpold-4.12 and speed-up all httpd depending tests (removed 50ms delay unneeded in other cases)

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"