diff options
Diffstat (limited to 'tests/http.test')
| -rw-r--r-- | tests/http.test | 63 |
1 files changed, 42 insertions, 21 deletions
diff --git a/tests/http.test b/tests/http.test index bde5795..41820cb 100644 --- a/tests/http.test +++ b/tests/http.test @@ -51,7 +51,7 @@ if {![file exists $httpdFile]} { set removeHttpd 1 } -catch {package require Thread 2.6} +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] @@ -119,7 +119,7 @@ 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]:6666 +set badurl //[info hostname]:[expr $port+1] test http-3.3 {http::geturl} -body { set token [http::geturl $url] http::data $token @@ -131,10 +131,11 @@ test http-3.3 {http::geturl} -body { </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 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 ipv6url http://\[::1\]:$port/ test http-3.4 {http::geturl} -body { set token [http::geturl $url] @@ -305,7 +306,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 @@ -371,11 +371,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 { @@ -384,14 +384,14 @@ 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 $ipv6url" -body { +test http-3.29 {http::geturl IPv6 address} -body { # We only want to see if the URL gets parsed correctly. This is # the case if http::geturl succeeds or returns a socket related # error. If the parsing is wrong, we'll get a parse error. @@ -405,6 +405,32 @@ test http-3.29 "http::geturl $ipv6url" -body { } -cleanup { catch { http::cleanup $token } } -result 0 +test http-3.30 {http::geturl query without path} -body { + set token [http::geturl $authorityurl?var=val] + http::ncode $token +} -cleanup { + catch { http::cleanup $token } +} -result 200 +test http-3.31 {http::geturl fragment without path} -body { + set token [http::geturl "$authorityurl#fragment42"] + http::ncode $token +} -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} test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] @@ -480,14 +506,10 @@ proc myProgress {token total current} { } set progress [list $total $current] } -if 0 { - # This test hangs on Windows95 because the client never gets EOF - set httpLog 1 - test http-4.6.1 {http::Event} knownBug { - set token [http::geturl $url -blocksize 50 -progress myProgress] - return $progress - } {111 111} -} +test http-4.6.1 {http::Event} knownBug { + set token [http::geturl $url -blocksize 50 -progress myProgress] + return $progress +} {111 111} test http-4.7 {http::Event} -body { set token [http::geturl $url -keepalive 0 -progress myProgress] return $progress @@ -547,11 +569,10 @@ test http-4.14 {http::Event} -body { error "bogus return from http::geturl" } http::wait $token - http::status $token - # error code varies among platforms. -} -returnCodes 1 -match regexp -cleanup { + lindex [http::error $token] 0 +} -cleanup { catch {http::cleanup $token} -} -result {(connect failed|couldn't open socket)} +} -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 |