Merge 8.7

author: jan.nijtmans <nijtmans@users.sourceforge.net> 2022-09-09 13:22:46 (GMT)
committer: jan.nijtmans <nijtmans@users.sourceforge.net> 2022-09-09 13:22:46 (GMT)
commit: e1b9a033d74009b6b57c6a65fe10473cd96a67dc (patch)
tree: 45a1bf62fd648db3c9329cafd02c4e869a41dc5c /tests
parent: d6b88eb7975e3dc13b386679c53bb4a6f7f7f616 (diff)
parent: a81159df88c89e6950dff666b7e507a0285c616a (diff)
download: tcl-e1b9a033d74009b6b57c6a65fe10473cd96a67dc.zip
tcl-e1b9a033d74009b6b57c6a65fe10473cd96a67dc.tar.gz
tcl-e1b9a033d74009b6b57c6a65fe10473cd96a67dc.tar.bz2
3 files changed, 82 insertions, 21 deletions
diff --git a/tests/http.test b/tests/http.test
index 3207a83..80af826 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -16,20 +16,7 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
-if {[catch {package require http 2} version]} {
-    if {[info exists http2]} {
-	catch {puts "Cannot load http 2.* package"}
-	return
-    } else {
-	catch {puts "Running http 2.* tests in child interp"}
-	set interp [interp create http2]
-	$interp eval [list set http2 "running"]
-	$interp eval [list set argv $argv]
-	$interp eval [list source [info script]]
-	interp delete $interp
-	return
-    }
-}
+package require http 2.10
 
 proc bgerror {args} {
     global errorInfo
@@ -77,11 +64,31 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
 	return
     }
 }
+
+if {![info exists ThreadLevel]} {
+    if {[catch {package require Thread}] == 0} {
+        set ValueRange {0 1 2}
+    } else {
+        set ValueRange {0 1}
+    }
+
+    # For each value of ThreadLevel, source this file recursively in the
+    # same interpreter.
+    foreach ThreadLevel $ValueRange {
+        source [info script]
+    }
+    catch {unset ThreadLevel}
+    catch {unset ValueRange}
+    return
+}
+
+catch {puts "==== Test with ThreadLevel $ThreadLevel ===="}
+http::config -threadlevel $ThreadLevel
 
 test http-1.1 {http::config} {
     http::config -useragent UserAgent
     http::config
-} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
+} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -threadlevel $ThreadLevel -urlencoding utf-8 -useragent UserAgent -zip 1]
 test http-1.2 {http::config} {
     http::config -proxyfilter
 } http::ProxyRequired
@@ -96,10 +103,10 @@ test http-1.4 {http::config} {
     set x [http::config]
     http::config {*}$savedconf
     set x
-} {-accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
+} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -threadlevel $ThreadLevel -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1]
 test http-1.5 {http::config} -returnCodes error -body {
     http::config -proxyhost {} -junk 8080
-} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
+} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -threadlevel, -urlencoding, -useragent, -zip}
 test http-1.6 {http::config} -setup {
     set oldenc [http::config -urlencoding]
 } -body {
@@ -138,9 +145,11 @@ test http-2.8 {http::CharsetToEncoding} {
 test http-3.1 {http::geturl} -returnCodes error -body {
     http::geturl -bogus flag
 } -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}
+
 test http-3.2 {http::geturl} -returnCodes error -body {
     http::geturl http:junk
 } -result {Unsupported URL: http:junk}
+
 set url //${::HOST}:$port
 set badurl //${::HOST}:[expr {$port+1}]
 test http-3.3 {http::geturl} -body {
@@ -152,6 +161,7 @@ test http-3.3 {http::geturl} -body {
 <h1>Hello, World!</h1>
 <h2>GET /</h2>
 </body></html>"
+
 set tail /a/b/c
 set url //${::HOST}:$port/a/b/c
 set fullurl HTTP://user:pass@${::HOST}:$port/a/b/c
@@ -161,6 +171,7 @@ set posturl //${::HOST}:$port/post
 set badposturl //${::HOST}:$port/droppost
 set authorityurl //${::HOST}:$port
 set ipv6url http://\[::1\]:$port/
+
 test http-3.4 {http::geturl} -body {
     set token [http::geturl $url]
     http::data $token
@@ -571,6 +582,7 @@ test http-4.10 {http::Event} -body {
 } -cleanup {
     http::cleanup $token
 } -result {111}
+
 # Timeout cases
 #	Short timeout to working server (the test server). This lets us try a
 #	reset during the connection.
@@ -581,6 +593,7 @@ test http-4.11 {http::Event} -body {
 } -cleanup {
     http::cleanup $token
 } -result {reset}
+
 #	Longer timeout with reset.
 test http-4.12 {http::Event} -body {
     set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#]
@@ -589,6 +602,7 @@ test http-4.12 {http::Event} -body {
 } -cleanup {
     http::cleanup $token
 } -result {reset}
+
 #	Medium timeout to working server that waits even longer. The timeout
 #	hits while waiting for a reply.
 test http-4.13 {http::Event} -body {
@@ -598,6 +612,7 @@ test http-4.13 {http::Event} -body {
 } -cleanup {
     http::cleanup $token
 } -result {timeout}
+
 #	Longer timeout to good host, bad port, gets an error after the
 #	connection "completes" but the socket is bad.
 test http-4.14 {http::Event} -body {
@@ -610,17 +625,19 @@ test http-4.14 {http::Event} -body {
 } -cleanup {
     catch {http::cleanup $token}
 } -result {connect failed connection refused}
+
 # Bogus host
 test http-4.15 {http::Event} -body {
     # This test may fail if you use a proxy server. That is to be
     # expected and is not a problem with Tcl.
     set token [http::geturl //not_a_host.tcl.tk -timeout 3000 -command \#]
     http::wait $token
-    http::status $token
+    set result "[http::status $token] -- [lindex [http::error $token] 0]"
     # error codes vary among platforms.
 } -cleanup {
     catch {http::cleanup $token}
-} -returnCodes 1 -match glob -result "couldn't open socket*"
+} -match glob -result "error -- couldn't open socket*"
+
 test http-4.16 {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup {
     proc list-difference {l1 l2} {
 	lmap item $l2 {if {$item in $l1} continue; set item}
diff --git a/tests/http11.test b/tests/http11.test
index 4f6fb92..346e334 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -12,7 +12,7 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
-package require http 2.9
+package require http 2.10
 
 # start the server
 variable httpd_output
@@ -87,6 +87,26 @@ proc check_crc {tok args} {
 }
 
 makeFile "<html><head><title>test</title></head><body><p>this is a test</p>\n[string repeat {<p>This is a tcl test file.</p>} 4192]\n</body></html>" testdoc.html
+
+if {![info exists ThreadLevel]} {
+    if {[catch {package require Thread}] == 0} {
+        set ValueRange {0 1 2}
+    } else {
+        set ValueRange {0 1}
+    }
+
+    # For each value of ThreadLevel, source this file recursively in the
+    # same interpreter.
+    foreach ThreadLevel $ValueRange {
+        source [info script]
+    }
+    catch {unset ThreadLevel}
+    catch {unset ValueRange}
+    return
+}
+
+catch {puts "==== Test with ThreadLevel $ThreadLevel ===="}
+http::config -threadlevel $ThreadLevel
 
 # -------------------------------------------------------------------------
 
diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test
index 4e55a10..161519f 100644
--- a/tests/httpPipeline.test
+++ b/tests/httpPipeline.test
@@ -13,7 +13,31 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
-package require http 2.9
+package require http 2.10
+
+# ------------------------------------------------------------------------------
+# (0) Socket Creation in Thread, which triples the number of tests.
+# ------------------------------------------------------------------------------
+
+if {![info exists ThreadLevel]} {
+    if {[catch {package require Thread}] == 0} {
+        set ValueRange {0 1 2}
+    } else {
+        set ValueRange {0 1}
+    }
+
+    # For each value of ThreadLevel, source this file recursively in the
+    # same interpreter.
+    foreach ThreadLevel $ValueRange {
+        source [info script]
+    }
+    catch {unset ThreadLevel}
+    catch {unset ValueRange}
+    return
+}
+
+catch {puts "==== Test with ThreadLevel $ThreadLevel ===="}
+http::config -threadlevel $ThreadLevel
 
 set sourcedir [file normalize [file dirname [info script]]]
 source [file join $sourcedir httpTest.tcl]
author	jan.nijtmans <nijtmans@users.sourceforge.net>	2022-09-09 13:22:46 (GMT)
committer	jan.nijtmans <nijtmans@users.sourceforge.net>	2022-09-09 13:22:46 (GMT)
commit	e1b9a033d74009b6b57c6a65fe10473cd96a67dc (patch)
tree	45a1bf62fd648db3c9329cafd02c4e869a41dc5c /tests
parent	d6b88eb7975e3dc13b386679c53bb4a6f7f7f616 (diff)
parent	a81159df88c89e6950dff666b7e507a0285c616a (diff)
download	tcl-e1b9a033d74009b6b57c6a65fe10473cd96a67dc.zip tcl-e1b9a033d74009b6b57c6a65fe10473cd96a67dc.tar.gz tcl-e1b9a033d74009b6b57c6a65fe10473cd96a67dc.tar.bz2