summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2009-04-10 13:15:57 (GMT)
committerdgp <dgp@users.sourceforge.net>2009-04-10 13:15:57 (GMT)
commit47e1c81009e30a84cb47e15b40dac9ee254136b6 (patch)
tree10738297df6a829398950e579bdec6cf9c35f7a0
parent1d411553104b36d5a80c7a465812e262145c1942 (diff)
downloadtcl-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--ChangeLog5
-rw-r--r--tests/http.test6
-rw-r--r--tests/httpd16
3 files changed, 22 insertions, 5 deletions
diff --git a/ChangeLog b/ChangeLog
index a80f875..9fa2101 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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"} {