diff options
Diffstat (limited to 'tests/http.test')
| -rw-r--r-- | tests/http.test | 76 |
1 files changed, 56 insertions, 20 deletions
diff --git a/tests/http.test b/tests/http.test index d879e45..9861e0e 100644 --- a/tests/http.test +++ b/tests/http.test @@ -10,8 +10,6 @@ # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: http.test,v 1.55 2009/11/18 21:04:32 nijtmans Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -53,14 +51,13 @@ if {![file exists $httpdFile]} { set removeHttpd 1 } -if {[info commands testthread] == "testthread" && [file exists $httpdFile]} { - set httpthread [testthread create " - source [list $httpdFile] - testthread wait - "] - testthread send $httpthread [list set port $port] - testthread send $httpthread [list set bindata $bindata] - testthread send $httpthread {httpd_init $port} +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} puts "Running httpd in thread $httpthread" } else { if {![file exists $httpdFile]} { @@ -138,6 +135,7 @@ 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 ipv6url http://\[::1\]:$port/ test http-3.4 {http::geturl} -body { set token [http::geturl $url] http::data $token @@ -367,6 +365,46 @@ test http-3.26 {http::meta} -setup { http::cleanup $token unset -nocomplain m token } -result {Content-Length Content-Type Date X-Check} +test http-3.27 {http::geturl: -headers override -type} -body { + set token [http::geturl $url/headers -type "text/plain" -query dummy \ + -headers [list "Content-Type" "text/plain;charset=utf-8"]] + http::data $token +} -cleanup { + http::cleanup $token +} -match regexp -result {(?n)Accept \*/\* +Host .* +User-Agent .* +Connection close +Content-Type {text/plain;charset=utf-8} +Accept-Encoding .* +Content-Length 5} +test http-3.28 {http::geturl: -headers override -type default} -body { + set token [http::geturl $url/headers -query dummy \ + -headers [list "Content-Type" "text/plain;charset=utf-8"]] + http::data $token +} -cleanup { + http::cleanup $token +} -match regexp -result {(?n)Accept \*/\* +Host .* +User-Agent .* +Connection close +Content-Type {text/plain;charset=utf-8} +Accept-Encoding .* +Content-Length 5} +test http-3.29 "http::geturl $ipv6url" -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. + # It'd be better to separate the URL parser from http::geturl, so + # that it can be tested without also trying to make a connection. + set error [catch {http::geturl $ipv6url -validate 1} token] + if {$error && [string match "couldn't open socket: *" $token]} { + set error 0 + } + set error +} -cleanup { + catch { http::cleanup $token } +} -result 0 test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] @@ -523,7 +561,7 @@ test http-4.15 {http::Event} -body { http::status $token # error codes vary among platforms. } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -returnCodes 1 -match glob -result "couldn't open socket*" test http-5.1 {http::formatQuery} { @@ -532,17 +570,17 @@ test http-5.1 {http::formatQuery} { # test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5 test http-5.3 {http::formatQuery} { http::formatQuery lines "line1\nline2\nline3" -} {lines=line1%0d%0aline2%0d%0aline3} +} {lines=line1%0D%0Aline2%0D%0Aline3} test http-5.4 {http::formatQuery} { http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2 -} {name1=~bwelch&name2=%c2%a1%c2%a2%c2%a2} +} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2} test http-5.5 {http::formatQuery} { set enc [http::config -urlencoding] http::config -urlencoding iso8859-1 set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2] http::config -urlencoding $enc set res -} {name1=~bwelch&name2=%a1%a2%a2} +} {name1=~bwelch&name2=%A1%A2%A2} test http-6.1 {http::ProxyRequired} -body { http::config -proxyhost [info hostname] -proxyport $port @@ -560,12 +598,12 @@ test http-6.1 {http::ProxyRequired} -body { test http-7.1 {http::mapReply} { http::mapReply "abc\$\[\]\"\\()\}\{" -} {abc%24%5b%5d%22%5c%28%29%7d%7b} +} {abc%24%5B%5D%22%5C%28%29%7D%7B} test http-7.2 {http::mapReply} { # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default, # so make sure this gets converted to utf-8 then urlencoded. http::mapReply "\u2208" -} {%e2%88%88} +} {%E2%88%88} test http-7.3 {http::formatQuery} -setup { set enc [http::config -urlencoding] } -returnCodes error -body { @@ -584,7 +622,7 @@ test http-7.4 {http::formatQuery} -setup { http::mapReply "\u2208" } -cleanup { http::config -urlencoding $enc -} -result {%3f} +} -result {%3F} # cleanup catch {unset url} @@ -592,9 +630,7 @@ catch {unset badurl} catch {unset port} catch {unset data} if {[info exists httpthread]} { - testthread send -async $httpthread { - testthread exit - } + thread::release $httpthread } else { close $listen } |