diff options
author | dgp <dgp@users.sourceforge.net> | 2009-04-10 13:15:57 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2009-04-10 13:15:57 (GMT) |
commit | 47e1c81009e30a84cb47e15b40dac9ee254136b6 (patch) | |
tree | 10738297df6a829398950e579bdec6cf9c35f7a0 | |
parent | 1d411553104b36d5a80c7a465812e262145c1942 (diff) | |
download | tcl-47e1c81009e30a84cb47e15b40dac9ee254136b6.zip tcl-47e1c81009e30a84cb47e15b40dac9ee254136b6.tar.gz tcl-47e1c81009e30a84cb47e15b40dac9ee254136b6.tar.bz2 |
* tests/httpd: Backport new tests for http 2.7.3.
* tests/http.tcl:
-rw-r--r-- | ChangeLog | 5 | ||||
-rw-r--r-- | tests/http.test | 6 | ||||
-rw-r--r-- | tests/httpd | 16 |
3 files changed, 22 insertions, 5 deletions
@@ -1,3 +1,8 @@ +2009-04-10 Don Porter <dgp@users.sourceforge.net> + + * tests/httpd: Backport new tests for http 2.7.3. + * tests/http.tcl: + 2008-04-09 Kevin B. Kenny <kennykb@acm.org> * tools/tclZIC.tcl: Always emit Unix-style line terminators. diff --git a/tests/http.test b/tests/http.test index 94cc95b..b889b04 100644 --- a/tests/http.test +++ b/tests/http.test @@ -12,7 +12,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# RCS: @(#) $Id: http.test,v 1.48.2.1 2008/12/11 01:20:02 patthoyts Exp $ +# RCS: @(#) $Id: http.test,v 1.48.2.2 2009/04/10 13:15:57 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -335,7 +335,7 @@ test http-4.1 {http::Event} { 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] @@ -369,7 +369,7 @@ test http-4.5 {http::Event} { 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] diff --git a/tests/httpd b/tests/httpd index b46a3f0..93ee08a 100644 --- a/tests/httpd +++ b/tests/httpd @@ -72,6 +72,10 @@ proc httpdRead { sock } { # Read the HTTP headers set readCount [gets $sock line] + if {[regexp {^([^:]+):(.*)$} $line -> key val]} { + lappend data(meta) $key [string trim $val] + } + } elseif {$data(state) == "query"} { # Read the query data @@ -195,17 +199,25 @@ proc httpdRespond { sock } { } # Catch errors from premature client closes - + catch { if {$data(proto) == "HEAD"} { puts $sock "HTTP/1.0 200 OK" } else { - puts $sock "HTTP/1.0 200 Data follows" + # Split the response to test for [Bug 26245326] + puts -nonewline $sock "HT" + flush $sock + puts $sock "TP/1.0 200 Data follows" } puts $sock "Date: [clock format [clock seconds] \ -format {%a, %d %b %Y %H:%M:%S %Z}]" puts $sock "Content-Type: $type" puts $sock "Content-Length: [string length $html]" + foreach {key val} $data(meta) { + if {[string match "X-*" $key]} { + puts $sock "$key: $val" + } + } puts $sock "" flush $sock if {$data(proto) != "HEAD"} { |