From 3fa8112c7afe69df643dcccb9570e698f2173da4 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Fri, 2 Sep 2022 17:02:56 +0000
Subject: really closes [2641672fff] - resolved timing sensitivity of
 httpold-4.12 and speed-up all httpd depending tests (removed 50ms delay
 unneeded in other cases)

---
 tests/httpd        |  6 +++++-
 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"
-- 
cgit v0.12