os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/http.test
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/http.test	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,551 @@
     1.4 +# Commands covered:  http::config, http::geturl, 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-2000 by Ajuba Solutions.
    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 +#
    1.18 +# RCS: @(#) $Id: http.test,v 1.33.2.6 2006/10/06 19:00:53 hobbs Exp $
    1.19 +
    1.20 +if {[lsearch [namespace children] ::tcltest] == -1} {
    1.21 +    package require tcltest 2
    1.22 +    namespace import -force ::tcltest::*
    1.23 +}
    1.24 +
    1.25 +if {[catch {package require http 2} version]} {
    1.26 +    if {[info exists http2]} {
    1.27 +	catch {puts "Cannot load http 2.* package"}
    1.28 +	return
    1.29 +    } else {
    1.30 +	catch {puts "Running http 2.* tests in slave interp"}
    1.31 +	set interp [interp create http2]
    1.32 +	$interp eval [list set http2 "running"]
    1.33 +	$interp eval [list set argv $argv]
    1.34 +	$interp eval [list source [info script]]
    1.35 +	interp delete $interp
    1.36 +	return
    1.37 +    }
    1.38 +}
    1.39 +
    1.40 +proc bgerror {args} {
    1.41 +    global errorInfo
    1.42 +    puts stderr "http.test bgerror"
    1.43 +    puts stderr [join $args]
    1.44 +    puts stderr $errorInfo
    1.45 +}
    1.46 +
    1.47 +set port 8010
    1.48 +set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
    1.49 +catch {unset data}
    1.50 +
    1.51 +# Ensure httpd file exists
    1.52 +
    1.53 +set origFile [file join [pwd] [file dirname [info script]] httpd]
    1.54 +set httpdFile [file join [temporaryDirectory] httpd_[pid]]
    1.55 +if {![file exists $httpdFile]} {
    1.56 +    makeFile "" $httpdFile
    1.57 +    file delete $httpdFile
    1.58 +    file copy $origFile $httpdFile
    1.59 +    set removeHttpd 1
    1.60 +}
    1.61 +
    1.62 +if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
    1.63 +    set httpthread [testthread create "
    1.64 +	source [list $httpdFile]
    1.65 +	testthread wait
    1.66 +    "]
    1.67 +    testthread send $httpthread [list set port $port]
    1.68 +    testthread send $httpthread [list set bindata $bindata]
    1.69 +    testthread send $httpthread {httpd_init $port}
    1.70 +    puts "Running httpd in thread $httpthread"
    1.71 +} else {
    1.72 +    if {![file exists $httpdFile]} {
    1.73 +	puts "Cannot read $httpdFile script, http test skipped"
    1.74 +	unset port
    1.75 +	return
    1.76 +    }
    1.77 +    source $httpdFile
    1.78 +    # Let the OS pick the port; that's much more flexible
    1.79 +    if {[catch {httpd_init 0} listen]} {
    1.80 +	puts "Cannot start http server, http test skipped"
    1.81 +	unset port
    1.82 +	return
    1.83 +    } else {
    1.84 +	set port [lindex [fconfigure $listen -sockname] 2]
    1.85 +    }
    1.86 +}
    1.87 +
    1.88 +test http-1.1 {http::config} {
    1.89 +    http::config
    1.90 +} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "Tcl http client package $version"]
    1.91 +test http-1.2 {http::config} {
    1.92 +    http::config -proxyfilter
    1.93 +} http::ProxyRequired
    1.94 +test http-1.3 {http::config} {
    1.95 +    catch {http::config -junk}
    1.96 +} 1
    1.97 +test http-1.4 {http::config} {
    1.98 +    set savedconf [http::config]
    1.99 +    http::config -proxyhost nowhere.come -proxyport 8080 \
   1.100 +	-proxyfilter myFilter -useragent "Tcl Test Suite" \
   1.101 +	-urlencoding iso8859-1
   1.102 +    set x [http::config]
   1.103 +    eval http::config $savedconf
   1.104 +    set x
   1.105 +} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
   1.106 +test http-1.5 {http::config} {
   1.107 +    list [catch {http::config -proxyhost {} -junk 8080} msg] $msg
   1.108 +} {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}}
   1.109 +test http-1.6 {http::config} {
   1.110 +    set enc [list [http::config -urlencoding]]
   1.111 +    http::config -urlencoding iso8859-1
   1.112 +    lappend enc [http::config -urlencoding]
   1.113 +    http::config -urlencoding [lindex $enc 0]
   1.114 +    set enc
   1.115 +} {utf-8 iso8859-1}
   1.116 +
   1.117 +test http-2.1 {http::reset} {
   1.118 +    catch {http::reset http#1}
   1.119 +} 0
   1.120 +
   1.121 +test http-3.1 {http::geturl} {
   1.122 +    list [catch {http::geturl -bogus flag} msg] $msg
   1.123 +} {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -progress, -query, -queryblocksize, -querychannel, -queryprogress, -validate, -timeout, -type}}
   1.124 +test http-3.2 {http::geturl} {
   1.125 +    catch {http::geturl http:junk} err
   1.126 +    set err
   1.127 +} {Unsupported URL: http:junk}
   1.128 +set url //[info hostname]:$port
   1.129 +set badurl //[info hostname]:6666
   1.130 +test http-3.3 {http::geturl} {
   1.131 +    set token [http::geturl $url]
   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 /</h2>
   1.136 +</body></html>"
   1.137 +set tail /a/b/c
   1.138 +set url //[info hostname]:$port/a/b/c
   1.139 +set fullurl http://user:pass@[info hostname]:$port/a/b/c
   1.140 +set binurl //[info hostname]:$port/binary
   1.141 +set posturl //[info hostname]:$port/post
   1.142 +set badposturl //[info hostname]:$port/droppost
   1.143 +set badcharurl //%user@[info hostname]:$port/a/^b/c
   1.144 +
   1.145 +test http-3.4 {http::geturl} {
   1.146 +    set token [http::geturl $url]
   1.147 +    http::data $token
   1.148 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   1.149 +<h1>Hello, World!</h1>
   1.150 +<h2>GET $tail</h2>
   1.151 +</body></html>"
   1.152 +proc selfproxy {host} {
   1.153 +    global port
   1.154 +    return [list [info hostname] $port]
   1.155 +}
   1.156 +test http-3.5 {http::geturl} {
   1.157 +    http::config -proxyfilter selfproxy
   1.158 +    set token [http::geturl $url]
   1.159 +    http::config -proxyfilter http::ProxyRequired
   1.160 +    http::data $token
   1.161 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   1.162 +<h1>Hello, World!</h1>
   1.163 +<h2>GET http:$url</h2>
   1.164 +</body></html>"
   1.165 +test http-3.6 {http::geturl} {
   1.166 +    http::config -proxyfilter bogus
   1.167 +    set token [http::geturl $url]
   1.168 +    http::config -proxyfilter http::ProxyRequired
   1.169 +    http::data $token
   1.170 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   1.171 +<h1>Hello, World!</h1>
   1.172 +<h2>GET $tail</h2>
   1.173 +</body></html>"
   1.174 +test http-3.7 {http::geturl} {
   1.175 +    set token [http::geturl $url -headers {Pragma no-cache}]
   1.176 +    http::data $token
   1.177 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   1.178 +<h1>Hello, World!</h1>
   1.179 +<h2>GET $tail</h2>
   1.180 +</body></html>"
   1.181 +test http-3.8 {http::geturl} {
   1.182 +    set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000]
   1.183 +    http::data $token
   1.184 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   1.185 +<h1>Hello, World!</h1>
   1.186 +<h2>POST $tail</h2>
   1.187 +<h2>Query</h2>
   1.188 +<dl>
   1.189 +<dt>Name<dd>Value
   1.190 +<dt>Foo<dd>Bar
   1.191 +</dl>
   1.192 +</body></html>"
   1.193 +test http-3.9 {http::geturl} {
   1.194 +    set token [http::geturl $url -validate 1]
   1.195 +    http::code $token
   1.196 +} "HTTP/1.0 200 OK"
   1.197 +test http-3.10 {http::geturl queryprogress} {
   1.198 +    set query foo=bar
   1.199 +    set sep ""
   1.200 +    set i 0
   1.201 +    # Create about 120K of query data
   1.202 +    while {$i < 14} {
   1.203 +	incr i
   1.204 +	append query $sep$query
   1.205 +	set sep &
   1.206 +    }
   1.207 +
   1.208 +    proc postProgress {token x y} {
   1.209 +	global postProgress
   1.210 +	lappend postProgress $y
   1.211 +    }
   1.212 +    set postProgress {}
   1.213 +    set t [http::geturl $posturl -query $query \
   1.214 +	    -queryprogress postProgress -queryblocksize 16384]
   1.215 +    http::wait $t
   1.216 +    list [http::status $t] [string length $query] $postProgress [http::data $t]
   1.217 +} {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
   1.218 +test http-3.11 {http::geturl querychannel with -command} {
   1.219 +    set query foo=bar
   1.220 +    set sep ""
   1.221 +    set i 0
   1.222 +    # Create about 120K of query data
   1.223 +    while {$i < 14} {
   1.224 +	incr i
   1.225 +	append query $sep$query
   1.226 +	set sep &
   1.227 +    }
   1.228 +    set file [makeFile $query outdata]
   1.229 +    set fp [open $file]
   1.230 +
   1.231 +    proc asyncCB {token} {
   1.232 +	global postResult
   1.233 +	lappend postResult [http::data $token]
   1.234 +    }
   1.235 +    set postResult [list ]
   1.236 +    set t [http::geturl $posturl -querychannel $fp]
   1.237 +    http::wait $t
   1.238 +    set testRes [list [http::status $t] [string length $query] [http::data $t]]
   1.239 +
   1.240 +    # Now do async
   1.241 +    http::cleanup $t
   1.242 +    close $fp
   1.243 +    set fp [open $file]
   1.244 +    set t [http::geturl $posturl -querychannel $fp -command asyncCB]
   1.245 +    set postResult [list PostStart]
   1.246 +    http::wait $t
   1.247 +    close $fp
   1.248 +
   1.249 +    lappend testRes [http::status $t] $postResult
   1.250 +    removeFile outdata
   1.251 +    set testRes
   1.252 +} {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
   1.253 +# On Linux platforms when the client and server are on the same host, the
   1.254 +# client is unable to read the server's response one it hits the write error.
   1.255 +# The status is "eof".
   1.256 +# On Windows, the http::wait procedure gets a "connection reset by peer" error
   1.257 +# while reading the reply.
   1.258 +test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
   1.259 +    set query foo=bar
   1.260 +    set sep ""
   1.261 +    set i 0
   1.262 +    # Create about 120K of query data
   1.263 +    while {$i < 14} {
   1.264 +	incr i
   1.265 +	append query $sep$query
   1.266 +	set sep &
   1.267 +    }
   1.268 +    set file [makeFile $query outdata]
   1.269 +    set fp [open $file]
   1.270 +
   1.271 +    proc asyncCB {token} {
   1.272 +	global postResult
   1.273 +	lappend postResult [http::data $token]
   1.274 +    }
   1.275 +    proc postProgress {token x y} {
   1.276 +	global postProgress
   1.277 +	lappend postProgress $y
   1.278 +    }
   1.279 +    set postProgress {}
   1.280 +    # Now do async
   1.281 +    set postResult [list PostStart]
   1.282 +    if {[catch {
   1.283 +	set t [http::geturl $badposturl -querychannel $fp -command asyncCB \
   1.284 +		-queryprogress postProgress]
   1.285 +	http::wait $t
   1.286 +	upvar #0 $t state
   1.287 +    } err]} {
   1.288 +	puts $errorInfo
   1.289 +	error $err
   1.290 +    }
   1.291 +
   1.292 +    removeFile outdata
   1.293 +    list [http::status $t] [http::code $t]
   1.294 +} {ok {HTTP/1.0 200 Data follows}}
   1.295 +test http-3.13 {http::geturl socket leak test} {
   1.296 +    set chanCount [llength [file channels]]
   1.297 +    for {set i 0} {$i < 3} {incr i} {
   1.298 +	catch {http::geturl $badurl -timeout 5000}
   1.299 +    }
   1.300 +
   1.301 +    # No extra channels should be taken
   1.302 +    expr {[llength [file channels]] == $chanCount}
   1.303 +} 1
   1.304 +test http-3.14 "http::geturl $fullurl" {
   1.305 +    set token [http::geturl $fullurl -validate 1]
   1.306 +    http::code $token
   1.307 +} "HTTP/1.0 200 OK"
   1.308 +test http-3.15 {http::geturl parse failures} -body {
   1.309 +    http::geturl "{invalid}:url"
   1.310 +} -returnCodes error -result {Unsupported URL: {invalid}:url}
   1.311 +test http-3.16 {http::geturl parse failures} -body {
   1.312 +    http::geturl http:relative/url
   1.313 +} -returnCodes error -result {Unsupported URL: http:relative/url}
   1.314 +test http-3.17 {http::geturl parse failures} -body {
   1.315 +    http::geturl /absolute/url
   1.316 +} -returnCodes error -result {Missing host part: /absolute/url}
   1.317 +test http-3.18 {http::geturl parse failures} -body {
   1.318 +    http::geturl http://somewhere:123456789/
   1.319 +} -returnCodes error -result {Invalid port number: 123456789}
   1.320 +test http-3.19 {http::geturl parse failures} -body {
   1.321 +    set ::http::strict 1
   1.322 +    http::geturl http://{user}@somewhere
   1.323 +} -returnCodes error -result {Illegal characters in URL user}
   1.324 +test http-3.20 {http::geturl parse failures} -body {
   1.325 +    set ::http::strict 1
   1.326 +    http::geturl http://%user@somewhere
   1.327 +} -returnCodes error -result {Illegal encoding character usage "%us" in URL user}
   1.328 +test http-3.21 {http::geturl parse failures} -body {
   1.329 +    set ::http::strict 1
   1.330 +    http::geturl http://somewhere/{path}
   1.331 +} -returnCodes error -result {Illegal characters in URL path}
   1.332 +test http-3.22 {http::geturl parse failures} -body {
   1.333 +    set ::http::strict 1
   1.334 +    http::geturl http://somewhere/%path
   1.335 +} -returnCodes error -result {Illegal encoding character usage "%pa" in URL path}
   1.336 +test http-3.23 {http::geturl parse failures} -body {
   1.337 +    set ::http::strict 1
   1.338 +    http::geturl http://somewhere/path?{query}
   1.339 +} -returnCodes error -result {Illegal characters in URL path}
   1.340 +test http-3.24 {http::geturl parse failures} -body {
   1.341 +    set ::http::strict 1
   1.342 +    http::geturl http://somewhere/path?%query
   1.343 +} -returnCodes error -result {Illegal encoding character usage "%qu" in URL path}
   1.344 +test http-3.25 {http::geturl parse failures} -body {
   1.345 +    set ::http::strict 0
   1.346 +    set token [http::geturl $badcharurl]
   1.347 +    http::cleanup $token
   1.348 +} -returnCodes ok -result {}
   1.349 +
   1.350 +test http-4.1 {http::Event} {
   1.351 +    set token [http::geturl $url]
   1.352 +    upvar #0 $token data
   1.353 +    array set meta $data(meta)
   1.354 +    expr ($data(totalsize) == $meta(Content-Length))
   1.355 +} 1
   1.356 +test http-4.2 {http::Event} {
   1.357 +    set token [http::geturl $url]
   1.358 +    upvar #0 $token data
   1.359 +    array set meta $data(meta)
   1.360 +    string compare $data(type) [string trim $meta(Content-Type)]
   1.361 +} 0
   1.362 +test http-4.3 {http::Event} {
   1.363 +    set token [http::geturl $url]
   1.364 +    http::code $token
   1.365 +} {HTTP/1.0 200 Data follows}
   1.366 +test http-4.4 {http::Event} {
   1.367 +    set testfile [makeFile "" testfile]
   1.368 +    set out [open $testfile w]
   1.369 +    set token [http::geturl $url -channel $out]
   1.370 +    close $out
   1.371 +    set in [open $testfile]
   1.372 +    set x [read $in]
   1.373 +    close $in
   1.374 +    removeFile $testfile
   1.375 +    set x
   1.376 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   1.377 +<h1>Hello, World!</h1>
   1.378 +<h2>GET $tail</h2>
   1.379 +</body></html>"
   1.380 +test http-4.5 {http::Event} {
   1.381 +    set testfile [makeFile "" testfile]
   1.382 +    set out [open $testfile w]
   1.383 +    set token [http::geturl $url -channel $out]
   1.384 +    close $out
   1.385 +    upvar #0 $token data
   1.386 +    removeFile $testfile
   1.387 +    expr $data(currentsize) == $data(totalsize)
   1.388 +} 1
   1.389 +test http-4.6 {http::Event} {
   1.390 +    set testfile [makeFile "" testfile]
   1.391 +    set out [open $testfile w]
   1.392 +    set token [http::geturl $binurl -channel $out]
   1.393 +    close $out
   1.394 +    set in [open $testfile]
   1.395 +    fconfigure $in -translation binary
   1.396 +    set x [read $in]
   1.397 +    close $in
   1.398 +    removeFile $testfile
   1.399 +    set x
   1.400 +} "$bindata[string trimleft $binurl /]"
   1.401 +proc myProgress {token total current} {
   1.402 +    global progress httpLog
   1.403 +    if {[info exists httpLog] && $httpLog} {
   1.404 +	puts "progress $total $current"
   1.405 +    }
   1.406 +    set progress [list $total $current]
   1.407 +}
   1.408 +if 0 {
   1.409 +    # This test hangs on Windows95 because the client never gets EOF
   1.410 +    set httpLog 1
   1.411 +    test http-4.6.1 {http::Event} knownBug {
   1.412 +	set token [http::geturl $url -blocksize 50 -progress myProgress]
   1.413 +	set progress
   1.414 +    } {111 111}
   1.415 +}
   1.416 +test http-4.7 {http::Event} {
   1.417 +    set token [http::geturl $url -progress myProgress]
   1.418 +    set progress
   1.419 +} {111 111}
   1.420 +test http-4.8 {http::Event} {
   1.421 +    set token [http::geturl $url]
   1.422 +    http::status $token
   1.423 +} {ok}
   1.424 +test http-4.9 {http::Event} {
   1.425 +    set token [http::geturl $url -progress myProgress]
   1.426 +    http::code $token
   1.427 +} {HTTP/1.0 200 Data follows}
   1.428 +test http-4.10 {http::Event} {
   1.429 +    set token [http::geturl $url -progress myProgress]
   1.430 +    http::size $token
   1.431 +} {111}
   1.432 +# Timeout cases
   1.433 +#	Short timeout to working server (the test server). This lets us try a
   1.434 +#	reset during the connection.
   1.435 +test http-4.11 {http::Event} {
   1.436 +    set token [http::geturl $url -timeout 1 -command {#}]
   1.437 +    http::reset $token
   1.438 +    http::status $token
   1.439 +} {reset}
   1.440 +#	Longer timeout with reset.
   1.441 +test http-4.12 {http::Event} {
   1.442 +    set token [http::geturl $url/?timeout=10 -command {#}]
   1.443 +    http::reset $token
   1.444 +    http::status $token
   1.445 +} {reset}
   1.446 +#	Medium timeout to working server that waits even longer. The timeout
   1.447 +#	hits while waiting for a reply.
   1.448 +test http-4.13 {http::Event} {
   1.449 +    set token [http::geturl $url?timeout=30 -timeout 10 -command {#}]
   1.450 +    http::wait $token
   1.451 +    http::status $token
   1.452 +} {timeout}
   1.453 +#	Longer timeout to good host, bad port, gets an error after the
   1.454 +#	connection "completes" but the socket is bad.
   1.455 +test http-4.14 {http::Event} {
   1.456 +    set code [catch {
   1.457 +	set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}]
   1.458 +	if {[string length $token] == 0} {
   1.459 +	    error "bogus return from http::geturl"
   1.460 +	}
   1.461 +	http::wait $token
   1.462 +	http::status $token
   1.463 +    } err]
   1.464 +    # error code varies among platforms.
   1.465 +    list $code [regexp {(connect failed|couldn't open socket)} $err]
   1.466 +} {1 1}
   1.467 +# Bogus host
   1.468 +test http-4.15 {http::Event} {
   1.469 +    # This test may fail if you use a proxy server.  That is to be
   1.470 +    # expected and is not a problem with Tcl.
   1.471 +    set code [catch {
   1.472 +	set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command {#}]
   1.473 +	http::wait $token
   1.474 +	http::status $token
   1.475 +    } err]
   1.476 +    # error code varies among platforms.
   1.477 +    list $code [string match "couldn't open socket*" $err]
   1.478 +} {1 1}
   1.479 +
   1.480 +test http-5.1 {http::formatQuery} {
   1.481 +    http::formatQuery name1 value1 name2 "value two"
   1.482 +} {name1=value1&name2=value%20two}
   1.483 +# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
   1.484 +test http-5.3 {http::formatQuery} {
   1.485 +    http::formatQuery lines "line1\nline2\nline3"
   1.486 +} {lines=line1%0d%0aline2%0d%0aline3}
   1.487 +test http-5.4 {http::formatQuery} {
   1.488 +    http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
   1.489 +} {name1=~bwelch&name2=%c2%a1%c2%a2%c2%a2}
   1.490 +test http-5.5 {http::formatQuery} {
   1.491 +    set enc [http::config -urlencoding]
   1.492 +    http::config -urlencoding iso8859-1
   1.493 +    set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
   1.494 +    http::config -urlencoding $enc
   1.495 +    set res
   1.496 +} {name1=~bwelch&name2=%a1%a2%a2}
   1.497 +
   1.498 +test http-6.1 {http::ProxyRequired} {
   1.499 +    http::config -proxyhost [info hostname] -proxyport $port
   1.500 +    set token [http::geturl $url]
   1.501 +    http::wait $token
   1.502 +    http::config -proxyhost {} -proxyport {}
   1.503 +    upvar #0 $token data
   1.504 +    set data(body)
   1.505 +} "<html><head><title>HTTP/1.0 TEST</title></head><body>
   1.506 +<h1>Hello, World!</h1>
   1.507 +<h2>GET http:$url</h2>
   1.508 +</body></html>"
   1.509 +
   1.510 +test http-7.1 {http::mapReply} {
   1.511 +    http::mapReply "abc\$\[\]\"\\()\}\{"
   1.512 +} {abc%24%5b%5d%22%5c%28%29%7d%7b}
   1.513 +test http-7.2 {http::mapReply} {
   1.514 +    # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
   1.515 +    # so make sure this gets converted to utf-8 then urlencoded.
   1.516 +    http::mapReply "\u2208"
   1.517 +} {%e2%88%88}
   1.518 +test http-7.3 {http::formatQuery} {
   1.519 +    set enc [http::config -urlencoding]
   1.520 +    # this would be reverting to http <=2.4 behavior
   1.521 +    http::config -urlencoding ""
   1.522 +    set res [list [catch {http::mapReply "\u2208"} msg] $msg]
   1.523 +    http::config -urlencoding $enc
   1.524 +    set res
   1.525 +} [list 1 "can't read \"formMap(\u2208)\": no such element in array"]
   1.526 +test http-7.4 {http::formatQuery} {
   1.527 +    set enc [http::config -urlencoding]
   1.528 +    # this would be reverting to http <=2.4 behavior w/o errors
   1.529 +    # (unknown chars become '?')
   1.530 +    http::config -urlencoding "iso8859-1"
   1.531 +    set res [http::mapReply "\u2208"]
   1.532 +    http::config -urlencoding $enc
   1.533 +    set res
   1.534 +} {%3f}
   1.535 +
   1.536 +# cleanup
   1.537 +catch {unset url}
   1.538 +catch {unset badurl}
   1.539 +catch {unset port}
   1.540 +catch {unset data}
   1.541 +if {[info exists httpthread]} {
   1.542 +    testthread send -async $httpthread {
   1.543 +	testthread exit
   1.544 +    }
   1.545 +} else {
   1.546 +    close $listen
   1.547 +}
   1.548 +
   1.549 +if {[info exists removeHttpd]} {
   1.550 +    removeFile $httpdFile
   1.551 +}
   1.552 +
   1.553 +rename bgerror {}
   1.554 +::tcltest::cleanupTests