os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/httpold.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/httpold.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,307 @@
1.4 +# Commands covered: http_config, http_get, http_wait, http_reset
1.5 +#
1.6 +# This file contains a collection of tests for the http script library.
1.7 +# Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.11 +# Copyright (c) 1994-1996 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: httpold.test,v 1.11 2002/10/03 13:34:32 dkf Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +if {[catch {package require http 1.0}]} {
1.25 + if {[info exists httpold]} {
1.26 + catch {puts "Cannot load http 1.0 package"}
1.27 + ::tcltest::cleanupTests
1.28 + return
1.29 + } else {
1.30 + catch {puts "Running http 1.0 tests in slave interp"}
1.31 + set interp [interp create httpold]
1.32 + $interp eval [list set httpold "running"]
1.33 + $interp eval [list set argv $argv]
1.34 + $interp eval [list source [info script]]
1.35 + interp delete $interp
1.36 + ::tcltest::cleanupTests
1.37 + return
1.38 + }
1.39 +}
1.40 +
1.41 +set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
1.42 +catch {unset data}
1.43 +
1.44 +##
1.45 +## The httpd script implement a stub http server
1.46 +##
1.47 +source [file join [file dirname [info script]] httpd]
1.48 +
1.49 +set port 8010
1.50 +if [catch {httpd_init $port} listen] {
1.51 + puts "Cannot start http server, http test skipped"
1.52 + unset port
1.53 + ::tcltest::cleanupTests
1.54 + return
1.55 +}
1.56 +
1.57 +test httpold-1.1 {http_config} {
1.58 + http_config
1.59 +} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
1.60 +
1.61 +test httpold-1.2 {http_config} {
1.62 + http_config -proxyfilter
1.63 +} httpProxyRequired
1.64 +
1.65 +test httpold-1.3 {http_config} {
1.66 + catch {http_config -junk}
1.67 +} 1
1.68 +
1.69 +test httpold-1.4 {http_config} {
1.70 + http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
1.71 + set x [http_config]
1.72 + http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
1.73 + -useragent "Tcl http client package 1.0"
1.74 + set x
1.75 +} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
1.76 +
1.77 +test httpold-1.5 {http_config} {
1.78 + catch {http_config -proxyhost {} -junk 8080}
1.79 +} 1
1.80 +
1.81 +test httpold-2.1 {http_reset} {
1.82 + catch {http_reset http#1}
1.83 +} 0
1.84 +
1.85 +test httpold-3.1 {http_get} {
1.86 + catch {http_get -bogus flag}
1.87 +} 1
1.88 +test httpold-3.2 {http_get} {
1.89 + catch {http_get http:junk} err
1.90 + set err
1.91 +} {Unsupported URL: http:junk}
1.92 +
1.93 +set url [info hostname]:$port
1.94 +test httpold-3.3 {http_get} {
1.95 + set token [http_get $url]
1.96 + http_data $token
1.97 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
1.98 +<h1>Hello, World!</h1>
1.99 +<h2>GET /</h2>
1.100 +</body></html>"
1.101 +
1.102 +set tail /a/b/c
1.103 +set url [info hostname]:$port/a/b/c
1.104 +set binurl [info hostname]:$port/binary
1.105 +
1.106 +test httpold-3.4 {http_get} {
1.107 + set token [http_get $url]
1.108 + http_data $token
1.109 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
1.110 +<h1>Hello, World!</h1>
1.111 +<h2>GET $tail</h2>
1.112 +</body></html>"
1.113 +
1.114 +proc selfproxy {host} {
1.115 + global port
1.116 + return [list [info hostname] $port]
1.117 +}
1.118 +test httpold-3.5 {http_get} {
1.119 + http_config -proxyfilter selfproxy
1.120 + set token [http_get $url]
1.121 + http_config -proxyfilter httpProxyRequired
1.122 + http_data $token
1.123 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
1.124 +<h1>Hello, World!</h1>
1.125 +<h2>GET http://$url</h2>
1.126 +</body></html>"
1.127 +
1.128 +test httpold-3.6 {http_get} {
1.129 + http_config -proxyfilter bogus
1.130 + set token [http_get $url]
1.131 + http_config -proxyfilter httpProxyRequired
1.132 + http_data $token
1.133 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
1.134 +<h1>Hello, World!</h1>
1.135 +<h2>GET $tail</h2>
1.136 +</body></html>"
1.137 +
1.138 +test httpold-3.7 {http_get} {
1.139 + set token [http_get $url -headers {Pragma no-cache}]
1.140 + http_data $token
1.141 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
1.142 +<h1>Hello, World!</h1>
1.143 +<h2>GET $tail</h2>
1.144 +</body></html>"
1.145 +
1.146 +test httpold-3.8 {http_get} {
1.147 + set token [http_get $url -query Name=Value&Foo=Bar]
1.148 + http_data $token
1.149 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
1.150 +<h1>Hello, World!</h1>
1.151 +<h2>POST $tail</h2>
1.152 +<h2>Query</h2>
1.153 +<dl>
1.154 +<dt>Name<dd>Value
1.155 +<dt>Foo<dd>Bar
1.156 +</dl>
1.157 +</body></html>"
1.158 +
1.159 +test httpold-3.9 {http_get} {
1.160 + set token [http_get $url -validate 1]
1.161 + http_code $token
1.162 +} "HTTP/1.0 200 OK"
1.163 +
1.164 +
1.165 +test httpold-4.1 {httpEvent} {
1.166 + set token [http_get $url]
1.167 + upvar #0 $token data
1.168 + array set meta $data(meta)
1.169 + expr ($data(totalsize) == $meta(Content-Length))
1.170 +} 1
1.171 +
1.172 +test httpold-4.2 {httpEvent} {
1.173 + set token [http_get $url]
1.174 + upvar #0 $token data
1.175 + array set meta $data(meta)
1.176 + string compare $data(type) [string trim $meta(Content-Type)]
1.177 +} 0
1.178 +
1.179 +test httpold-4.3 {httpEvent} {
1.180 + set token [http_get $url]
1.181 + http_code $token
1.182 +} {HTTP/1.0 200 Data follows}
1.183 +
1.184 +test httpold-4.4 {httpEvent} {
1.185 + set testfile [makeFile "" testfile]
1.186 + set out [open $testfile w]
1.187 + set token [http_get $url -channel $out]
1.188 + close $out
1.189 + set in [open $testfile]
1.190 + set x [read $in]
1.191 + close $in
1.192 + removeFile $testfile
1.193 + set x
1.194 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
1.195 +<h1>Hello, World!</h1>
1.196 +<h2>GET $tail</h2>
1.197 +</body></html>"
1.198 +
1.199 +test httpold-4.5 {httpEvent} {
1.200 + set testfile [makeFile "" testfile]
1.201 + set out [open $testfile w]
1.202 + set token [http_get $url -channel $out]
1.203 + close $out
1.204 + upvar #0 $token data
1.205 + removeFile $testfile
1.206 + expr $data(currentsize) == $data(totalsize)
1.207 +} 1
1.208 +
1.209 +test httpold-4.6 {httpEvent} {
1.210 + set testfile [makeFile "" testfile]
1.211 + set out [open $testfile w]
1.212 + set token [http_get $binurl -channel $out]
1.213 + close $out
1.214 + set in [open $testfile]
1.215 + fconfigure $in -translation binary
1.216 + set x [read $in]
1.217 + close $in
1.218 + removeFile $testfile
1.219 + set x
1.220 +} "$bindata$binurl"
1.221 +
1.222 +proc myProgress {token total current} {
1.223 + global progress httpLog
1.224 + if {[info exists httpLog] && $httpLog} {
1.225 + puts "progress $total $current"
1.226 + }
1.227 + set progress [list $total $current]
1.228 +}
1.229 +if 0 {
1.230 + # This test hangs on Windows95 because the client never gets EOF
1.231 + set httpLog 1
1.232 + test httpold-4.6 {httpEvent} {
1.233 + set token [http_get $url -blocksize 50 -progress myProgress]
1.234 + set progress
1.235 + } {111 111}
1.236 +}
1.237 +test httpold-4.7 {httpEvent} {
1.238 + set token [http_get $url -progress myProgress]
1.239 + set progress
1.240 +} {111 111}
1.241 +test httpold-4.8 {httpEvent} {
1.242 + set token [http_get $url]
1.243 + http_status $token
1.244 +} {ok}
1.245 +test httpold-4.9 {httpEvent} {
1.246 + set token [http_get $url -progress myProgress]
1.247 + http_code $token
1.248 +} {HTTP/1.0 200 Data follows}
1.249 +test httpold-4.10 {httpEvent} {
1.250 + set token [http_get $url -progress myProgress]
1.251 + http_size $token
1.252 +} {111}
1.253 +test httpold-4.11 {httpEvent} {
1.254 + set token [http_get $url -timeout 1 -command {#}]
1.255 + http_reset $token
1.256 + http_status $token
1.257 +} {reset}
1.258 +test httpold-4.12 {httpEvent} {
1.259 + update
1.260 + set x {}
1.261 + after 500 {lappend x ok}
1.262 + set token [http_get $url -timeout 1 -command {lappend x fail}]
1.263 + vwait x
1.264 + list [http_status $token] $x
1.265 +} {timeout ok}
1.266 +
1.267 +test httpold-5.1 {http_formatQuery} {
1.268 + http_formatQuery name1 value1 name2 "value two"
1.269 +} {name1=value1&name2=value+two}
1.270 +
1.271 +test httpold-5.2 {http_formatQuery} {
1.272 + http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
1.273 +} {name1=%7ebwelch&name2=%a1%a2%a2}
1.274 +
1.275 +test httpold-5.3 {http_formatQuery} {
1.276 + http_formatQuery lines "line1\nline2\nline3"
1.277 +} {lines=line1%0d%0aline2%0d%0aline3}
1.278 +
1.279 +test httpold-6.1 {httpProxyRequired} {
1.280 + update
1.281 + http_config -proxyhost [info hostname] -proxyport $port
1.282 + set token [http_get $url]
1.283 + http_wait $token
1.284 + http_config -proxyhost {} -proxyport {}
1.285 + upvar #0 $token data
1.286 + set data(body)
1.287 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
1.288 +<h1>Hello, World!</h1>
1.289 +<h2>GET http://$url</h2>
1.290 +</body></html>"
1.291 +
1.292 +# cleanup
1.293 +catch {unset url}
1.294 +catch {unset port}
1.295 +catch {unset data}
1.296 +close $listen
1.297 +::tcltest::cleanupTests
1.298 +return
1.299 +
1.300 +
1.301 +
1.302 +
1.303 +
1.304 +
1.305 +
1.306 +
1.307 +
1.308 +
1.309 +
1.310 +