diff options
Diffstat (limited to 'tests/http.test')
| -rw-r--r-- | tests/http.test | 94 |
1 files changed, 50 insertions, 44 deletions
diff --git a/tests/http.test b/tests/http.test index f8a79be..6dcb612 100644 --- a/tests/http.test +++ b/tests/http.test @@ -94,7 +94,7 @@ test http-1.4 {http::config} { -proxyfilter myFilter -useragent "Tcl Test Suite" \ -urlencoding iso8859-1 set x [http::config] - eval http::config $savedconf + http::config {*}$savedconf set x } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}} test http-1.5 {http::config} { @@ -114,7 +114,7 @@ test http-2.1 {http::reset} { test http-3.1 {http::geturl} { list [catch {http::geturl -bogus flag} msg] $msg -} {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -progress, -query, -queryblocksize, -querychannel, -queryprogress, -validate, -timeout, -type}} +} {1 {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} { catch {http::geturl http:junk} err set err @@ -134,8 +134,6 @@ 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 badcharurl //%user@[info hostname]:$port/a/^b/c - test http-3.4 {http::geturl} { set token [http::geturl $url] http::data $token @@ -204,7 +202,7 @@ test http-3.10 {http::geturl queryprogress} { lappend postProgress $y } set postProgress {} - set t [http::geturl $posturl -query $query \ + set t [http::geturl $posturl -keepalive 0 -query $query \ -queryprogress postProgress -queryblocksize 16384] http::wait $t list [http::status $t] [string length $query] $postProgress [http::data $t] @@ -279,7 +277,7 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} { http::wait $t upvar #0 $t state } err]} { - puts $errorInfo + puts $::errorInfo error $err } @@ -312,40 +310,53 @@ test http-3.18 {http::geturl parse failures} -body { http::geturl http://somewhere:123456789/ } -returnCodes error -result {Invalid port number: 123456789} test http-3.19 {http::geturl parse failures} -body { - set ::http::strict 1 http::geturl http://{user}@somewhere } -returnCodes error -result {Illegal characters in URL user} test http-3.20 {http::geturl parse failures} -body { - set ::http::strict 1 http::geturl http://%user@somewhere } -returnCodes error -result {Illegal encoding character usage "%us" in URL user} test http-3.21 {http::geturl parse failures} -body { - set ::http::strict 1 http::geturl http://somewhere/{path} } -returnCodes error -result {Illegal characters in URL path} test http-3.22 {http::geturl parse failures} -body { - set ::http::strict 1 http::geturl http://somewhere/%path } -returnCodes error -result {Illegal encoding character usage "%pa" in URL path} test http-3.23 {http::geturl parse failures} -body { - set ::http::strict 1 http::geturl http://somewhere/path?{query} } -returnCodes error -result {Illegal characters in URL path} test http-3.24 {http::geturl parse failures} -body { - set ::http::strict 1 http::geturl http://somewhere/path?%query } -returnCodes error -result {Illegal encoding character usage "%qu" in URL path} -test http-3.25 {http::geturl parse failures} -body { - set ::http::strict 0 - set token [http::geturl $badcharurl] +test http-3.25 {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} +Content-Length 5} +test http-3.26 {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 -} -returnCodes ok -result {} +} -match regexp -result {(?n)Accept \*/\* +Host .* +User-Agent .* +Connection close +Content-Type {text/plain;charset=utf-8} +Content-Length 5} test http-4.1 {http::Event} { - set token [http::geturl $url] + set token [http::geturl $url -keepalive 0] upvar #0 $token data array set meta $data(meta) - expr ($data(totalsize) == $meta(Content-Length)) + expr {($data(totalsize) == $meta(Content-Length))} } 1 test http-4.2 {http::Event} { set token [http::geturl $url] @@ -374,11 +385,12 @@ test http-4.4 {http::Event} { test http-4.5 {http::Event} { set testfile [makeFile "" testfile] set out [open $testfile w] + fconfigure $out -translation lf set token [http::geturl $url -channel $out] close $out upvar #0 $token data removeFile $testfile - expr $data(currentsize) == $data(totalsize) + expr {$data(currentsize) == $data(totalsize)} } 1 test http-4.6 {http::Event} { set testfile [makeFile "" testfile] @@ -408,7 +420,7 @@ if 0 { } {111 111} } test http-4.7 {http::Event} { - set token [http::geturl $url -progress myProgress] + set token [http::geturl $url -keepalive 0 -progress myProgress] set progress } {111 111} test http-4.8 {http::Event} { @@ -427,49 +439,43 @@ test http-4.10 {http::Event} { # Short timeout to working server (the test server). This lets us try a # reset during the connection. test http-4.11 {http::Event} { - set token [http::geturl $url -timeout 1 -command {#}] + set token [http::geturl $url -timeout 1 -keepalive 0 -command {#}] http::reset $token http::status $token } {reset} # Longer timeout with reset. test http-4.12 {http::Event} { - set token [http::geturl $url/?timeout=10 -command {#}] + set token [http::geturl $url/?timeout=10 -keepalive 0 -command {#}] http::reset $token http::status $token } {reset} # Medium timeout to working server that waits even longer. The timeout # hits while waiting for a reply. test http-4.13 {http::Event} { - set token [http::geturl $url?timeout=30 -timeout 10 -command {#}] + set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command {#}] http::wait $token http::status $token } {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} { - set code [catch { - set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}] - if {[string length $token] == 0} { - error "bogus return from http::geturl" - } - http::wait $token - http::status $token - } err] +test http-4.14 {http::Event} -body { + set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#] + if {$token eq ""} { + error "bogus return from http::geturl" + } + http::wait $token + http::status $token # error code varies among platforms. - list $code [regexp {(connect failed|couldn't open socket)} $err] -} {1 1} +} -returnCodes 1 -match regexp -result {(connect failed|couldn't open socket)} # Bogus host -test http-4.15 {http::Event} { - # This test may fail if you use a proxy server. That is to be +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 code [catch { - set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command {#}] - http::wait $token - http::status $token - } err] - # error code varies among platforms. - list $code [string match "couldn't open socket*" $err] -} {1 1} + set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command \#] + http::wait $token + http::status $token + # error codes vary among platforms. +} -returnCodes 1 -match glob -result "couldn't open socket*" test http-5.1 {http::formatQuery} { http::formatQuery name1 value1 name2 "value two" |