merge core-8-branch

1 files changed, 63 insertions, 24 deletions

diff --git a/tests/http.test b/tests/http.test
index 6569443..cf30348 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -36,7 +36,13 @@ proc bgerror {args} {
     puts stderr $errorInfo
 }
 
-set port 8010
+if {$::tcl_platform(os) eq "Darwin"} {
+    # Name resolution often a problem on OSX; not focus of HTTP package anyway
+    set HOST localhost
+} else {
+    set HOST [info hostname]
+}
+
 set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
 catch {unset data}
 
@@ -55,9 +61,8 @@ catch {package require Thread 2.7-}
 if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
     set httpthread [thread::create -preserved]
     thread::send $httpthread [list source $httpdFile]
-    thread::send $httpthread [list set port $port]
     thread::send $httpthread [list set bindata $bindata]
-    thread::send $httpthread {httpd_init $port}
+    thread::send $httpthread {httpd_init 0; set port} port
     puts "Running httpd in thread $httpthread"
 } else {
     if {![file exists $httpdFile]} {
@@ -69,17 +74,15 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
     # Let the OS pick the port; that's much more flexible
     if {[catch {httpd_init 0} listen]} {
 	puts "Cannot start http server, http test skipped"
-	unset port
+	catch {unset port}
 	return
-    } else {
-	set port [lindex [fconfigure $listen -sockname] 2]
     }
 }
 
 test http-1.1 {http::config} {
     http::config -useragent UserAgent
     http::config
-} [list -accept */* -cookiejar {} -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
+} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
 test http-1.2 {http::config} {
     http::config -proxyfilter
 } http::ProxyRequired
@@ -94,10 +97,10 @@ test http-1.4 {http::config} {
     set x [http::config]
     http::config {*}$savedconf
     set x
-} {-accept */* -cookiejar {} -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
+} {-accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -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, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
+} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
 test http-1.6 {http::config} -setup {
     set oldenc [http::config -urlencoding]
 } -body {
@@ -118,8 +121,8 @@ test http-3.1 {http::geturl} -returnCodes error -body {
 test http-3.2 {http::geturl} -returnCodes error -body {
     http::geturl http:junk
 } -result {Unsupported URL: http:junk}
-set url //[info hostname]:$port
-set badurl //[info hostname]:[expr $port+1]
+set url //${::HOST}:$port
+set badurl //${::HOST}:[expr $port+1]
 test http-3.3 {http::geturl} -body {
     set token [http::geturl $url]
     http::data $token
@@ -130,12 +133,13 @@ test http-3.3 {http::geturl} -body {
 <h2>GET /</h2>
 </body></html>"
 set tail /a/b/c
-set url //[info hostname]:$port/a/b/c
-set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c
-set binurl //[info hostname]:$port/binary
-set posturl //[info hostname]:$port/post
-set badposturl //[info hostname]:$port/droppost
-set authorityurl //[info hostname]:$port
+set url //${::HOST}:$port/a/b/c
+set fullurl HTTP://user:pass@${::HOST}:$port/a/b/c
+set binurl //${::HOST}:$port/binary
+set xmlurl //${::HOST}:$port/xml
+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]
@@ -148,7 +152,7 @@ test http-3.4 {http::geturl} -body {
 </body></html>"
 proc selfproxy {host} {
     global port
-    return [list [info hostname] $port]
+    return [list ${::HOST} $port]
 }
 test http-3.5 {http::geturl} -body {
     http::config -proxyfilter selfproxy
@@ -306,7 +310,6 @@ test http-3.13 {http::geturl socket leak test} {
     for {set i 0} {$i < 3} {incr i} {
 	catch {http::geturl $badurl -timeout 5000}
     }
-
     # No extra channels should be taken
     expr {[llength [file channels]] == $chanCount}
 } 1
@@ -372,11 +375,11 @@ test http-3.27 {http::geturl: -headers override -type} -body {
     http::data $token
 } -cleanup {
     http::cleanup $token
-} -match regexp -result {(?n)Accept \*/\*
-Host .*
+} -match regexp -result {(?n)Host .*
 User-Agent .*
 Connection close
 Content-Type {text/plain;charset=utf-8}
+Accept \*/\*
 Accept-Encoding .*
 Content-Length 5}
 test http-3.28 {http::geturl: -headers override -type default} -body {
@@ -385,11 +388,11 @@ test http-3.28 {http::geturl: -headers override -type default} -body {
     http::data $token
 } -cleanup {
     http::cleanup $token
-} -match regexp -result {(?n)Accept \*/\*
-Host .*
+} -match regexp -result {(?n)Host .*
 User-Agent .*
 Connection close
 Content-Type {text/plain;charset=utf-8}
+Accept \*/\*
 Accept-Encoding .*
 Content-Length 5}
 test http-3.29 {http::geturl IPv6 address} -body {
@@ -418,6 +421,28 @@ test http-3.31 {http::geturl fragment without path} -body {
 } -cleanup {
     catch { http::cleanup $token }
 } -result 200
+# Bug c11a51c482
+test http-3.32 {http::geturl: -headers override -accept default} -body {
+    set token [http::geturl $url/headers -query dummy \
+	    -headers [list "Accept" "text/plain,application/tcl-test-value"]]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -match regexp -result {(?n)Host .*
+User-Agent .*
+Connection close
+Accept text/plain,application/tcl-test-value
+Accept-Encoding .*
+Content-Type application/x-www-form-urlencoded
+Content-Length 5}
+# Bug 838e99a76d
+test http-3.33 {http::geturl application/xml is text} -body {
+    set token [http::geturl "$xmlurl"]
+    scan [http::data $token] "<%\[^>]>%c<%\[^>]>"
+} -cleanup {
+    catch { http::cleanup $token }
+} -result {test 4660 /test}
+
 test http-4.1 {http::Event} -body {
     set token [http::geturl $url -keepalive 0]
     upvar #0 $token data
@@ -570,6 +595,20 @@ test http-4.15 {http::Event} -body {
 } -cleanup {
     catch {http::cleanup $token}
 } -returnCodes 1 -match glob -result "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}
+    }
+} -body {
+    set before [chan names]
+    set token [http::geturl $url -headers {X-Connection keep-alive}]
+    http::cleanup $token
+    update
+    # Compute what channels have been unexpectedly leaked past cleanup
+    list-difference $before [chan names]
+} -cleanup {
+    rename list-difference {}
+} -result {}
 
 test http-5.1 {http::formatQuery} {
     http::formatQuery name1 value1 name2 "value two"
@@ -590,7 +629,7 @@ test http-5.5 {http::formatQuery} {
 } {name1=~bwelch&name2=%A1%A2%A2}
 
 test http-6.1 {http::ProxyRequired} -body {
-    http::config -proxyhost [info hostname] -proxyport $port
+    http::config -proxyhost ${::HOST} -proxyport $port
     set token [http::geturl $url]
     http::wait $token
     upvar #0 $token data