summaryrefslogtreecommitdiffstats
path: root/tcl8.6/tests/httpold.test
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2016-12-21 22:56:22 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2016-12-21 22:56:22 (GMT)
commitd1a6de55efc90f190dee42ab8c4fa9070834e77d (patch)
treeec633f5608ef498bee52a5f42c12c49493ec8bf8 /tcl8.6/tests/httpold.test
parent5514e37335c012cc70f5b9aee3cedfe3d57f583f (diff)
parent98acd3f494b28ddd8c345a2bb9311e41e2d56ddd (diff)
downloadblt-d1a6de55efc90f190dee42ab8c4fa9070834e77d.zip
blt-d1a6de55efc90f190dee42ab8c4fa9070834e77d.tar.gz
blt-d1a6de55efc90f190dee42ab8c4fa9070834e77d.tar.bz2
Merge commit '98acd3f494b28ddd8c345a2bb9311e41e2d56ddd' as 'tcl8.6'
Diffstat (limited to 'tcl8.6/tests/httpold.test')
-rw-r--r--tcl8.6/tests/httpold.test293
1 files changed, 293 insertions, 0 deletions
diff --git a/tcl8.6/tests/httpold.test b/tcl8.6/tests/httpold.test
new file mode 100644
index 0000000..aeba311
--- /dev/null
+++ b/tcl8.6/tests/httpold.test
@@ -0,0 +1,293 @@
+# Commands covered: http_config, http_get, http_wait, http_reset
+#
+# This file contains a collection of tests for the http script library.
+# Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+if {[catch {package require http 1.0}]} {
+ if {[info exists httpold]} {
+ catch {puts "Cannot load http 1.0 package"}
+ ::tcltest::cleanupTests
+ return
+ } else {
+ catch {puts "Running http 1.0 tests in slave interp"}
+ set interp [interp create httpold]
+ $interp eval [list set httpold "running"]
+ $interp eval [list set argv $argv]
+ $interp eval [list source [info script]]
+ interp delete $interp
+ ::tcltest::cleanupTests
+ return
+ }
+}
+
+set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
+catch {unset data}
+
+##
+## The httpd script implement a stub http server
+##
+source [file join [file dirname [info script]] httpd]
+
+set port 8010
+if [catch {httpd_init $port} listen] {
+ puts "Cannot start http server, http test skipped"
+ unset port
+ ::tcltest::cleanupTests
+ return
+}
+
+test httpold-1.1 {http_config} {
+ http_config
+} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
+
+test httpold-1.2 {http_config} {
+ http_config -proxyfilter
+} httpProxyRequired
+
+test httpold-1.3 {http_config} {
+ catch {http_config -junk}
+} 1
+
+test httpold-1.4 {http_config} {
+ http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
+ set x [http_config]
+ http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
+ -useragent "Tcl http client package 1.0"
+ set x
+} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
+
+test httpold-1.5 {http_config} {
+ catch {http_config -proxyhost {} -junk 8080}
+} 1
+
+test httpold-2.1 {http_reset} {
+ catch {http_reset http#1}
+} 0
+
+test httpold-3.1 {http_get} {
+ catch {http_get -bogus flag}
+} 1
+test httpold-3.2 {http_get} {
+ catch {http_get http:junk} err
+ set err
+} {Unsupported URL: http:junk}
+
+set url [info hostname]:$port
+test httpold-3.3 {http_get} {
+ set token [http_get $url]
+ http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET /</h2>
+</body></html>"
+
+set tail /a/b/c
+set url [info hostname]:$port/a/b/c
+set binurl [info hostname]:$port/binary
+
+test httpold-3.4 {http_get} {
+ set token [http_get $url]
+ http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+
+proc selfproxy {host} {
+ global port
+ return [list [info hostname] $port]
+}
+test httpold-3.5 {http_get} {
+ http_config -proxyfilter selfproxy
+ set token [http_get $url]
+ http_config -proxyfilter httpProxyRequired
+ http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET http://$url</h2>
+</body></html>"
+
+test httpold-3.6 {http_get} {
+ http_config -proxyfilter bogus
+ set token [http_get $url]
+ http_config -proxyfilter httpProxyRequired
+ http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+
+test httpold-3.7 {http_get} {
+ set token [http_get $url -headers {Pragma no-cache}]
+ http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+
+test httpold-3.8 {http_get} {
+ set token [http_get $url -query Name=Value&Foo=Bar]
+ http_data $token
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>POST $tail</h2>
+<h2>Query</h2>
+<dl>
+<dt>Name<dd>Value
+<dt>Foo<dd>Bar
+</dl>
+</body></html>"
+
+test httpold-3.9 {http_get} {
+ set token [http_get $url -validate 1]
+ http_code $token
+} "HTTP/1.0 200 OK"
+
+
+test httpold-4.1 {httpEvent} {
+ set token [http_get $url]
+ upvar #0 $token data
+ array set meta $data(meta)
+ expr ($data(totalsize) == $meta(Content-Length))
+} 1
+
+test httpold-4.2 {httpEvent} {
+ set token [http_get $url]
+ upvar #0 $token data
+ array set meta $data(meta)
+ string compare $data(type) [string trim $meta(Content-Type)]
+} 0
+
+test httpold-4.3 {httpEvent} {
+ set token [http_get $url]
+ http_code $token
+} {HTTP/1.0 200 Data follows}
+
+test httpold-4.4 {httpEvent} {
+ set testfile [makeFile "" testfile]
+ set out [open $testfile w]
+ set token [http_get $url -channel $out]
+ close $out
+ set in [open $testfile]
+ set x [read $in]
+ close $in
+ removeFile $testfile
+ set x
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+
+test httpold-4.5 {httpEvent} {
+ set testfile [makeFile "" testfile]
+ set out [open $testfile w]
+ set token [http_get $url -channel $out]
+ close $out
+ upvar #0 $token data
+ removeFile $testfile
+ expr $data(currentsize) == $data(totalsize)
+} 1
+
+test httpold-4.6 {httpEvent} {
+ set testfile [makeFile "" testfile]
+ set out [open $testfile w]
+ set token [http_get $binurl -channel $out]
+ close $out
+ set in [open $testfile]
+ fconfigure $in -translation binary
+ set x [read $in]
+ close $in
+ removeFile $testfile
+ set x
+} "$bindata$binurl"
+
+proc myProgress {token total current} {
+ global progress httpLog
+ if {[info exists httpLog] && $httpLog} {
+ puts "progress $total $current"
+ }
+ set progress [list $total $current]
+}
+if 0 {
+ # This test hangs on Windows95 because the client never gets EOF
+ set httpLog 1
+ test httpold-4.6 {httpEvent} {
+ set token [http_get $url -blocksize 50 -progress myProgress]
+ set progress
+ } {111 111}
+}
+test httpold-4.7 {httpEvent} {
+ set token [http_get $url -progress myProgress]
+ set progress
+} {111 111}
+test httpold-4.8 {httpEvent} {
+ set token [http_get $url]
+ http_status $token
+} {ok}
+test httpold-4.9 {httpEvent} {
+ set token [http_get $url -progress myProgress]
+ http_code $token
+} {HTTP/1.0 200 Data follows}
+test httpold-4.10 {httpEvent} {
+ set token [http_get $url -progress myProgress]
+ http_size $token
+} {111}
+test httpold-4.11 {httpEvent} {
+ set token [http_get $url -timeout 1 -command {#}]
+ http_reset $token
+ http_status $token
+} {reset}
+test httpold-4.12 {httpEvent} {
+ update
+ set x {}
+ after 500 {lappend x ok}
+ set token [http_get $url -timeout 1 -command {lappend x fail}]
+ vwait x
+ list [http_status $token] $x
+} {timeout ok}
+
+test httpold-5.1 {http_formatQuery} {
+ http_formatQuery name1 value1 name2 "value two"
+} {name1=value1&name2=value+two}
+
+test httpold-5.2 {http_formatQuery} {
+ http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
+} {name1=%7ebwelch&name2=%a1%a2%a2}
+
+test httpold-5.3 {http_formatQuery} {
+ http_formatQuery lines "line1\nline2\nline3"
+} {lines=line1%0d%0aline2%0d%0aline3}
+
+test httpold-6.1 {httpProxyRequired} {
+ update
+ http_config -proxyhost [info hostname] -proxyport $port
+ set token [http_get $url]
+ http_wait $token
+ http_config -proxyhost {} -proxyport {}
+ upvar #0 $token data
+ set data(body)
+} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET http://$url</h2>
+</body></html>"
+
+# cleanup
+catch {unset url}
+catch {unset port}
+catch {unset data}
+close $listen
+::tcltest::cleanupTests
+return
generated by cgit v0.12 at 2024-07-05 13:36:02 (GMT)