summaryrefslogtreecommitdiffstats
path: root/tests/http.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/http.test')
-rw-r--r--tests/http.test108
1 files changed, 84 insertions, 24 deletions
diff --git a/tests/http.test b/tests/http.test
index c242ae0..4ae5757 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -12,19 +12,21 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#
-# RCS: @(#) $Id: http.test,v 1.16 2000/03/19 22:32:26 sandeep Exp $
+# RCS: @(#) $Id: http.test,v 1.17 2000/04/09 23:56:31 welch Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import ::tcltest::*
}
+set tcltest::testConstraints(notLinux) \
+ [expr ![string equal Linux $tcl_platform(os)]]
-if {[catch {package require http 2}]} {
+if {[catch {package require http 2} version]} {
if {[info exist http2]} {
- catch {puts "Cannot load http 2.2 package"}
+ catch {puts "Cannot load http 2.* package"}
return
} else {
- catch {puts "Running http 2.2 tests in slave interp"}
+ catch {puts "Running http 2.* tests in slave interp"}
set interp [interp create http2]
$interp eval [list set http2 "running"]
$interp eval [list source [info script]]
@@ -33,6 +35,12 @@ if {[catch {package require http 2}]} {
}
}
+proc bgerror {args} {
+ global errorInfo
+ puts stderr "http.test bgerror"
+ puts stderr [join $args]
+ puts stderr $errorInfo
+}
set port 8010
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
@@ -74,7 +82,7 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
test http-1.1 {http::config} {
http::config
-} {-accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 2.2}}
+} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -useragent "Tcl http client package $version"]
test http-1.2 {http::config} {
http::config -proxyfilter
@@ -122,6 +130,7 @@ set tail /a/b/c
set url [info hostname]:$port/a/b/c
set binurl [info hostname]:$port/binary
set posturl [info hostname]:$port/post
+set badposturl [info hostname]:$port/droppost
test http-3.4 {http::geturl} {
set token [http::geturl $url]
@@ -164,7 +173,7 @@ test http-3.7 {http::geturl} {
</body></html>"
test http-3.8 {http::geturl} {
- set token [http::geturl $url -query Name=Value&Foo=Bar]
+ set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000]
http::data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
@@ -237,6 +246,50 @@ test http-3.11 {http::geturl querychannel with -command} {
set testRes
} {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
+# On Linux platforms when the client and server are on the same
+# host, the client is unable to read the server's response one
+# it hits the write error. The status is "eof"
+
+# On Windows, the http::wait procedure gets a
+# "connection reset by peer" error while reading the reply
+
+test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
+ set query foo=bar
+ set sep ""
+ set i 0
+ # Create about 120K of query data
+ while {$i < 14} {
+ incr i
+ append query $sep$query
+ set sep &
+ }
+ ::tcltest::makeFile $query outdata
+ set fp [open outdata]
+
+ proc asyncCB {token} {
+ global postResult
+ lappend postResult [http::data $token]
+ }
+ proc postProgress {token x y} {
+ global postProgress
+ lappend postProgress $y
+ }
+ set postProgress {}
+ # Now do async
+ set postResult [list PostStart]
+ if {[catch {
+ set t [http::geturl $badposturl -querychannel $fp -command asyncCB \
+ -queryprogress postProgress]
+ http::wait $t
+ upvar #0 $t state
+ } err]} {
+ puts $errorInfo
+ error $err
+ }
+
+ list [http::status $t] [http::code $t]
+} {ok {HTTP/1.0 200 Data follows}}
+
test http-4.1 {http::Event} {
set token [http::geturl $url]
@@ -325,41 +378,48 @@ test http-4.10 {http::Event} {
} {111}
# Timeout cases
+
# Short timeout to working server (the test server)
-# Short timeout to working server that waits longer
-# Short timeout to good host, bad port, hits in connection phase
-# Longer timeout to good host, bad port, hits in I/O phase
+# This lets us try a reset during the connection
test http-4.11 {http::Event} {
set token [http::geturl $url -timeout 1 -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 -timeout 1 -command {#}]
- http::wait $token
+ set token [http::geturl $url/?timeout=10 -command {#}]
+ http::reset $token
http::status $token
-} {timeout}
+} {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 $badurl/?timeout=10 -timeout 1 -command {#}]
- if {[string length $token] == 0} {
- error "bogus return from http::geturl"
- }
+ set token [http::geturl $url?timeout=30 -timeout 10 -command {#}]
http::wait $token
http::status $token
} {timeout}
-# Longer timeout hits after connection (to a bad socket!) completes
+# 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 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
-} {ioerror}
+ 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]
+ # error code varies among platforms.
+ list $code [string match "connect failed*" $err]
+} {1 1}
# Bogus host