From 4db1e8880035a804d1cdceaed3f153e364006d22 Mon Sep 17 00:00:00 2001
From: gerald <gerald>
Date: Sat, 10 Jun 2017 17:06:13 +0000
Subject: 1) Added namespace exports to tcltest namespace for new features 2)
 Rolled minor revision number of tcltest package to 2.5.0 since freatures were
 added. 3) Started http-tip-452.test to demostrate the use of mocks/stubs.
 (work here is not complete)

---
 library/init.tcl             |   3 +
 library/tcltest/pkgIndex.tcl |   4 +-
 library/tcltest/tcltest.tcl  |   6 +-
 tests/http-tip-452.test      | 654 +++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 664 insertions(+), 3 deletions(-)
 create mode 100644 tests/http-tip-452.test

diff --git a/library/init.tcl b/library/init.tcl
index 51e2251..af81a9a 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -842,6 +842,9 @@ proc ::tcltest::seam {action seamName body} {
     }
     return [uplevel 1 $body]
 }
+namespace eval ::tcltest:: {
+       namespace seam
+}
 ##
 ## TIP 452 -- end of addition
 ##
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index 5ac8823..a76ca31 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -8,5 +8,5 @@
 # script is sourced, the variable $dir must contain the
 # full path name of this file's directory.
 
-if {![package vsatisfies [package provide Tcl] 8.5]} {return}
-package ifneeded tcltest 2.4.0 [list source [file join $dir tcltest.tcl]]
+if {![package vsatisfies [package provide Tcl] 8.6]} {return}
+package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index aa8ab35..f4d66d8 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -22,7 +22,7 @@ namespace eval tcltest {
     # When the version number changes, be sure to update the pkgIndex.tcl file,
     # and the install directory in the Makefiles.  When the minor version
     # changes (new feature) be sure to update the man page as well.
-    variable Version 2.4.0
+    variable Version 2.5.0
 
     # Compatibility support for dumb variables defined in tcltest 1
     # Do not use these.  Call [package provide Tcl] and [info patchlevel]
@@ -3376,6 +3376,10 @@ namespace eval ::tcltest:: {
     array set ::tcltest::SavedVars {}
     array set ::tcltest::SeamData {}
     set ::tcltest::debugLevel 0
+
+   namespace export testSetup addStub saveVars addVars
+   namespace export callCount testCleanup sortedArrayData callProc seam
+
 }
 
 
diff --git a/tests/http-tip-452.test b/tests/http-tip-452.test
new file mode 100644
index 0000000..e74f38c
--- /dev/null
+++ b/tests/http-tip-452.test
@@ -0,0 +1,654 @@
+# Commands covered:  http::config, http::geturl, 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.
+#
+# This file is a rewrite to demostrate TIP 452 (enhancement to tcltest for
+# stubs/mocks and seams).  NOTE -- due to the use of stubs/mocks, no actual
+# I/O is done, so the httpd package is no longer being used. Please also note,
+# the seams feature is not used, only the stub/mock feature.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-2000 by Ajuba Solutions.
+# Copyright (c) 2017 by Gerald W. Lester.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcltest 2.5
+namespace import -force ::tcltest::*
+
+if {[catch {package require http 2} version]} {
+    if {[info exists http2]} {
+	catch {puts "Cannot load http 2.* package"}
+	return
+    } else {
+	catch {puts "Running http 2.* tests in slave interp"}
+	set interp [interp create http2]
+	$interp eval [list set http2 "running"]
+	$interp eval [list set argv $argv]
+	$interp eval [list source [info script]]
+	interp delete $interp
+	return
+    }
+}
+
+proc bgerror {args} {
+    global errorInfo
+    puts stderr "http.test bgerror"
+    puts stderr [join $args]
+    puts stderr $errorInfo
+}
+
+set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
+catch {unset data}
+
+
+test http-1.1 {http::config} {
+    http::config -useragent UserAgent
+    http::config
+} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
+test http-1.2 {http::config} {
+    http::config -proxyfilter
+} http::ProxyRequired
+test http-1.3 {http::config} {
+    catch {http::config -junk}
+} 1
+test http-1.4 {http::config} {
+    set savedconf [http::config]
+    http::config -proxyhost nowhere.come -proxyport 8080 \
+	-proxyfilter myFilter -useragent "Tcl Test Suite" \
+	-urlencoding iso8859-1
+    set x [http::config]
+    http::config {*}$savedconf
+    set x
+} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
+test http-1.5 {http::config} -returnCodes error -body {
+    http::config -proxyhost {} -junk 8080
+} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
+test http-1.6 {http::config} -setup {
+    set oldenc [http::config -urlencoding]
+} -body {
+    set enc [list [http::config -urlencoding]]
+    http::config -urlencoding iso8859-1
+    lappend enc [http::config -urlencoding]
+} -cleanup {
+    http::config -urlencoding $oldenc
+} -result {utf-8 iso8859-1}
+
+test http-2.1 {http::reset} {
+    catch {http::reset http#1}
+} 0
+
+test http-3.1 {http::geturl} -returnCodes error -body {
+    http::geturl -bogus flag
+} -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}
+test http-3.2 {http::geturl} -returnCodes error -body {
+    http::geturl http:junk
+} -result {Unsupported URL: http:junk}
+set url //[info hostname]:$port
+set badurl //[info hostname]:[expr $port+1]
+test http-3.3 {http::geturl} -body {
+    set token [http::geturl $url]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -result "<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 fullurl HTTP://user:pass@[info hostname]:$port/a/b/c
+set binurl //[info hostname]:$port/binary
+set xmlurl //[info hostname]:$port/xml
+set posturl //[info hostname]:$port/post
+set badposturl //[info hostname]:$port/droppost
+set authorityurl //[info hostname]:$port
+set ipv6url http://\[::1\]:$port/
+test http-3.4 {http::geturl} -body {
+    set token [http::geturl $url]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -result "<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 http-3.5 {http::geturl} -body {
+    http::config -proxyfilter selfproxy
+    set token [http::geturl $url]
+    http::data $token
+} -cleanup {
+    http::config -proxyfilter http::ProxyRequired
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET http:$url</h2>
+</body></html>"
+test http-3.6 {http::geturl} -body {
+    http::config -proxyfilter bogus
+    set token [http::geturl $url]
+    http::data $token
+} -cleanup {
+    http::config -proxyfilter http::ProxyRequired
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+test http-3.7 {http::geturl} -body {
+    set token [http::geturl $url -headers {Pragma no-cache}]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+test http-3.8 {http::geturl} -body {
+    set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -result "<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 http-3.9 {http::geturl} -body {
+    set token [http::geturl $url -validate 1]
+    http::code $token
+} -cleanup {
+    http::cleanup $token
+} -result "HTTP/1.0 200 OK"
+test http-3.10 {http::geturl queryprogress} -setup {
+    set query foo=bar
+    set sep ""
+    set i 0
+    # Create about 120K of query data
+    while {$i < 14} {
+	incr i
+	append query $sep$query
+	set sep &
+    }
+} -body {
+    proc postProgress {token x y} {
+	global postProgress
+	lappend postProgress $y
+    }
+    set postProgress {}
+    set t [http::geturl $posturl -keepalive 0 -query $query \
+	    -queryprogress postProgress -queryblocksize 16384]
+    http::wait $t
+    list [http::status $t] [string length $query] $postProgress [http::data $t]
+} -cleanup {
+    http::cleanup $t
+} -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
+test http-3.11 {http::geturl querychannel with -command} -setup {
+    set query foo=bar
+    set sep ""
+    set i 0
+    # Create about 120K of query data
+    while {$i < 14} {
+	incr i
+	append query $sep$query
+	set sep &
+    }
+    set file [makeFile $query outdata]
+} -body {
+    set fp [open $file]
+    proc asyncCB {token} {
+	global postResult
+	lappend postResult [http::data $token]
+    }
+    set postResult [list ]
+    set t [http::geturl $posturl -querychannel $fp]
+    http::wait $t
+    set testRes [list [http::status $t] [string length $query] [http::data $t]]
+    # Now do async
+    http::cleanup $t
+    close $fp
+    set fp [open $file]
+    set t [http::geturl $posturl -querychannel $fp -command asyncCB]
+    set postResult [list PostStart]
+    http::wait $t
+    close $fp
+    lappend testRes [http::status $t] $postResult
+} -cleanup {
+    removeFile outdata
+    http::cleanup $t
+} -result {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
+# On Linux platforms when the client and server are on the same host, the
+# client is unable to read the server's response one it hits the write error.
+# The status is "eof".
+# On Windows, the http::wait procedure gets a "connection reset by peer" error
+# while reading the reply.
+test http-3.12 {http::geturl querychannel with aborted request} -setup {
+    set query foo=bar
+    set sep ""
+    set i 0
+    # Create about 120K of query data
+    while {$i < 14} {
+	incr i
+	append query $sep$query
+	set sep &
+    }
+    set file [makeFile $query outdata]
+} -constraints {nonPortable} -body {
+    set fp [open $file]
+    proc asyncCB {token} {
+	global postResult
+	lappend postResult [http::data $token]
+    }
+    proc postProgress {token x y} {
+	global postProgress
+	lappend postProgress $y
+    }
+    set postProgress {}
+    # Now do async
+    set postResult [list PostStart]
+    if {[catch {
+	set t [http::geturl $badposturl -querychannel $fp -command asyncCB \
+		-queryprogress postProgress]
+	http::wait $t
+	upvar #0 $t state
+    } err]} {
+	puts $::errorInfo
+	error $err
+    }
+    list [http::status $t] [http::code $t]
+} -cleanup {
+    removeFile outdata
+    http::cleanup $t
+} -result {ok {HTTP/1.0 200 Data follows}}
+test http-3.13 {http::geturl socket leak test} {
+    set chanCount [llength [file channels]]
+    for {set i 0} {$i < 3} {incr i} {
+	catch {http::geturl $badurl -timeout 5000}
+    }
+    # No extra channels should be taken
+    expr {[llength [file channels]] == $chanCount}
+} 1
+test http-3.14 "http::geturl $fullurl" -body {
+    set token [http::geturl $fullurl -validate 1]
+    http::code $token
+} -cleanup {
+    http::cleanup $token
+} -result "HTTP/1.0 200 OK"
+test http-3.15 {http::geturl parse failures} -body {
+    http::geturl "{invalid}:url"
+} -returnCodes error -result {Unsupported URL: {invalid}:url}
+test http-3.16 {http::geturl parse failures} -body {
+    http::geturl http:relative/url
+} -returnCodes error -result {Unsupported URL: http:relative/url}
+test http-3.17 {http::geturl parse failures} -body {
+    http::geturl /absolute/url
+} -returnCodes error -result {Missing host part: /absolute/url}
+test http-3.18 {http::geturl parse failures} -body {
+    http::geturl http://somewhere:123456789/
+} -returnCodes error -result {Invalid port number: 123456789}
+test http-3.19 {http::geturl parse failures} -body {
+    http::geturl http://{user}@somewhere
+} -returnCodes error -result {Illegal characters in URL user}
+test http-3.20 {http::geturl parse failures} -body {
+    http::geturl http://%user@somewhere
+} -returnCodes error -result {Illegal encoding character usage "%us" in URL user}
+test http-3.21 {http::geturl parse failures} -body {
+    http::geturl http://somewhere/{path}
+} -returnCodes error -result {Illegal characters in URL path}
+test http-3.22 {http::geturl parse failures} -body {
+    http::geturl http://somewhere/%path
+} -returnCodes error -result {Illegal encoding character usage "%pa" in URL path}
+test http-3.23 {http::geturl parse failures} -body {
+    http::geturl http://somewhere/path?{query}?
+} -returnCodes error -result {Illegal characters in URL path}
+test http-3.24 {http::geturl parse failures} -body {
+    http::geturl http://somewhere/path?%query
+} -returnCodes error -result {Illegal encoding character usage "%qu" in URL path}
+test http-3.25 {http::meta} -setup {
+    unset -nocomplain m token
+} -body {
+    set token [http::geturl $url -timeout 2000]
+    array set m [http::meta $token]
+    lsort [array names m]
+} -cleanup {
+    http::cleanup $token
+    unset -nocomplain m token
+} -result {Content-Length Content-Type Date}
+test http-3.26 {http::meta} -setup {
+    unset -nocomplain m token
+} -body {
+    set token [http::geturl $url -headers {X-Check 1} -timeout 2000]
+    array set m [http::meta $token]
+    lsort [array names m]
+} -cleanup {
+    http::cleanup $token
+    unset -nocomplain m token
+} -result {Content-Length Content-Type Date X-Check}
+test http-3.27 {http::geturl: -headers override -type} -body {
+    set token [http::geturl $url/headers -type "text/plain" -query dummy \
+	    -headers [list "Content-Type" "text/plain;charset=utf-8"]]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -match regexp -result {(?n)Host .*
+User-Agent .*
+Connection close
+Content-Type {text/plain;charset=utf-8}
+Accept \*/\*
+Accept-Encoding .*
+Content-Length 5}
+test http-3.28 {http::geturl: -headers override -type default} -body {
+    set token [http::geturl $url/headers -query dummy \
+	    -headers [list "Content-Type" "text/plain;charset=utf-8"]]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -match regexp -result {(?n)Host .*
+User-Agent .*
+Connection close
+Content-Type {text/plain;charset=utf-8}
+Accept \*/\*
+Accept-Encoding .*
+Content-Length 5}
+test http-3.29 {http::geturl IPv6 address} -body {
+    # We only want to see if the URL gets parsed correctly. This is
+    # the case if http::geturl succeeds or returns a socket related
+    # error. If the parsing is wrong, we'll get a parse error.
+    # It'd be better to separate the URL parser from http::geturl, so
+    # that it can be tested without also trying to make a connection.
+    set error [catch {http::geturl $ipv6url -validate 1} token]
+    if {$error && [string match "couldn't open socket: *" $token]} {
+            set error 0
+    }
+    set error
+} -cleanup {
+    catch { http::cleanup $token }
+} -result 0
+test http-3.30 {http::geturl query without path} -body {
+    set token [http::geturl $authorityurl?var=val]
+    http::ncode $token
+} -cleanup {
+    catch { http::cleanup $token }
+} -result 200
+test http-3.31 {http::geturl fragment without path} -body {
+    set token [http::geturl "$authorityurl#fragment42"]
+    http::ncode $token
+} -cleanup {
+    catch { http::cleanup $token }
+} -result 200
+# Bug c11a51c482
+test http-3.32 {http::geturl: -headers override -accept default} -body {
+    set token [http::geturl $url/headers -query dummy \
+	    -headers [list "Accept" "text/plain,application/tcl-test-value"]]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -match regexp -result {(?n)Host .*
+User-Agent .*
+Connection close
+Accept text/plain,application/tcl-test-value
+Accept-Encoding .*
+Content-Type application/x-www-form-urlencoded
+Content-Length 5}
+# Bug 838e99a76d
+test http-3.33 {http::geturl application/xml is text} -body {
+    set token [http::geturl "$xmlurl"]
+    scan [http::data $token] "<%\[^>]>%c<%\[^>]>"
+} -cleanup {
+    catch { http::cleanup $token }
+} -result {test 4660 /test}
+
+test http-4.1 {http::Event} -body {
+    set token [http::geturl $url -keepalive 0]
+    upvar #0 $token data
+    array set meta $data(meta)
+    expr {($data(totalsize) == $meta(Content-Length))}
+} -cleanup {
+    http::cleanup $token
+} -result 1
+test http-4.2 {http::Event} -body {
+    set token [http::geturl $url]
+    upvar #0 $token data
+    array set meta $data(meta)
+    string compare $data(type) [string trim $meta(Content-Type)]
+} -cleanup {
+    http::cleanup $token
+} -result 0
+test http-4.3 {http::Event} -body {
+    set token [http::geturl $url]
+    http::code $token
+} -cleanup {
+    http::cleanup $token
+} -result {HTTP/1.0 200 Data follows}
+test http-4.4 {http::Event} -setup {
+    set testfile [makeFile "" testfile]
+} -body {
+    set out [open $testfile w]
+    set token [http::geturl $url -channel $out]
+    close $out
+    set in [open $testfile]
+    set x [read $in]
+} -cleanup {
+    catch {close $in}
+    catch {close $out}
+    removeFile $testfile
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET $tail</h2>
+</body></html>"
+test http-4.5 {http::Event} -setup {
+    set testfile [makeFile "" testfile]
+} -body {
+    set out [open $testfile w]
+    fconfigure $out -translation lf
+    set token [http::geturl $url -channel $out]
+    close $out
+    upvar #0 $token data
+    expr {$data(currentsize) == $data(totalsize)}
+} -cleanup {
+    removeFile $testfile
+    http::cleanup $token
+} -result 1
+test http-4.6 {http::Event} -setup {
+    set testfile [makeFile "" testfile]
+} -body {
+    set out [open $testfile w]
+    set token [http::geturl $binurl -channel $out]
+    close $out
+    set in [open $testfile]
+    fconfigure $in -translation binary
+    read $in
+} -cleanup {
+    catch {close $in}
+    catch {close $out}
+    removeFile $testfile
+    http::cleanup $token
+} -result "$bindata[string trimleft $binurl /]"
+proc myProgress {token total current} {
+    global progress httpLog
+    if {[info exists httpLog] && $httpLog} {
+	puts "progress $total $current"
+    }
+    set progress [list $total $current]
+}
+test http-4.6.1 {http::Event} knownBug {
+    set token [http::geturl $url -blocksize 50 -progress myProgress]
+    return $progress
+} {111 111}
+test http-4.7 {http::Event} -body {
+    set token [http::geturl $url -keepalive 0 -progress myProgress]
+    return $progress
+} -cleanup {
+    http::cleanup $token
+} -result {111 111}
+test http-4.8 {http::Event} -body {
+    set token [http::geturl $url]
+    http::status $token
+} -cleanup {
+    http::cleanup $token
+} -result {ok}
+test http-4.9 {http::Event} -body {
+    set token [http::geturl $url -progress myProgress]
+    http::code $token
+} -cleanup {
+    http::cleanup $token
+} -result {HTTP/1.0 200 Data follows}
+test http-4.10 {http::Event} -body {
+    set token [http::geturl $url -progress myProgress]
+    http::size $token
+} -cleanup {
+    http::cleanup $token
+} -result {111}
+# Timeout cases
+#	Short timeout to working server (the test server). This lets us try a
+#	reset during the connection.
+test http-4.11 {http::Event} -body {
+    set token [http::geturl $url -timeout 1 -keepalive 0 -command \#]
+    http::reset $token
+    http::status $token
+} -cleanup {
+    http::cleanup $token
+} -result {reset}
+#	Longer timeout with reset.
+test http-4.12 {http::Event} -body {
+    set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#]
+    http::reset $token
+    http::status $token
+} -cleanup {
+    http::cleanup $token
+} -result {reset}
+#	Medium timeout to working server that waits even longer. The timeout
+#	hits while waiting for a reply.
+test http-4.13 {http::Event} -body {
+    set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#]
+    http::wait $token
+    http::status $token
+} -cleanup {
+    http::cleanup $token
+} -result {timeout}
+#	Longer timeout to good host, bad port, gets an error after the
+#	connection "completes" but the socket is bad.
+test http-4.14 {http::Event} -body {
+    set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#]
+    if {$token eq ""} {
+	error "bogus return from http::geturl"
+    }
+    http::wait $token
+    lindex [http::error $token] 0
+} -cleanup {
+    catch {http::cleanup $token}
+} -result {connect failed connection refused}
+# Bogus host
+test http-4.15 {http::Event} -body {
+    # This test may fail if you use a proxy server. That is to be
+    # expected and is not a problem with Tcl.
+    set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command \#]
+    http::wait $token
+    http::status $token
+    # error codes vary among platforms.
+} -cleanup {
+    catch {http::cleanup $token}
+} -returnCodes 1 -match glob -result "couldn't open socket*"
+test http-4.16 {Leak with Close vs Keepalive (bug [6ca52aec14]} -body {
+    set before [chan names]
+    set token [http::geturl $url -headers {X-Connection keep-alive}]
+    http::cleanup $token
+    update
+    set after [chan names]
+    expr {$before eq $after}
+} -result 1
+
+test http-5.1 {http::formatQuery} {
+    http::formatQuery name1 value1 name2 "value two"
+} {name1=value1&name2=value%20two}
+# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
+test http-5.3 {http::formatQuery} {
+    http::formatQuery lines "line1\nline2\nline3"
+} {lines=line1%0D%0Aline2%0D%0Aline3}
+test http-5.4 {http::formatQuery} {
+    http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
+} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2}
+test http-5.5 {http::formatQuery} {
+    set enc [http::config -urlencoding]
+    http::config -urlencoding iso8859-1
+    set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
+    http::config -urlencoding $enc
+    set res
+} {name1=~bwelch&name2=%A1%A2%A2}
+
+test http-6.1 {http::ProxyRequired} -body {
+    http::config -proxyhost [info hostname] -proxyport $port
+    set token [http::geturl $url]
+    http::wait $token
+    upvar #0 $token data
+    set data(body)
+} -cleanup {
+    http::config -proxyhost {} -proxyport {}
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
+<h1>Hello, World!</h1>
+<h2>GET http:$url</h2>
+</body></html>"
+
+test http-7.1 {http::mapReply} {
+    http::mapReply "abc\$\[\]\"\\()\}\{"
+} {abc%24%5B%5D%22%5C%28%29%7D%7B}
+test http-7.2 {http::mapReply} {
+    # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
+    # so make sure this gets converted to utf-8 then urlencoded.
+    http::mapReply "\u2208"
+} {%E2%88%88}
+test http-7.3 {http::formatQuery} -setup {
+    set enc [http::config -urlencoding]
+} -returnCodes error -body {
+    # this would be reverting to http <=2.4 behavior
+    http::config -urlencoding ""
+    http::mapReply "\u2208"
+} -cleanup {
+    http::config -urlencoding $enc
+} -result "can't read \"formMap(\u2208)\": no such element in array"
+test http-7.4 {http::formatQuery} -setup {
+    set enc [http::config -urlencoding]
+} -body {
+    # this would be reverting to http <=2.4 behavior w/o errors
+    # (unknown chars become '?')
+    http::config -urlencoding "iso8859-1"
+    http::mapReply "\u2208"
+} -cleanup {
+    http::config -urlencoding $enc
+} -result {%3F}
+
+# cleanup
+catch {unset url}
+catch {unset badurl}
+catch {unset port}
+catch {unset data}
+if {[info exists httpthread]} {
+    thread::release $httpthread
+} else {
+    close $listen
+}
+
+if {[info exists removeHttpd]} {
+    removeFile $httpdFile
+}
+
+rename bgerror {}
+::tcltest::cleanupTests
+
+# Local variables:
+# mode: tcl
+# End:
-- 
cgit v0.12