tests/http.test - main - niceSOFT/tcl

tests/http.test
778 строк27 KB
dkf
Use 9.0's [const] for constants, and move IDNA tests out of http.test into their own file
23 сен 2025, 17:48
23 сен 2025, 17:48c54d039
# 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.
#
# Copyright © 1991-1993 The Regents of the University of California.
# Copyright © 1994-1996 Sun Microsystems, Inc.
# Copyright © 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

package require http 2.10
#http::register http 80 ::socket

# To write a separate summary for each value of ThreadLevel, set constraint ThreadLevelSummary.
#testConstraint ThreadLevelSummary 0

proc bgerror {args} {
    global errorInfo
    puts stderr "http.test bgerror"
    puts stderr [join $args]
    puts stderr $errorInfo
}

# Do not use [info hostname].
# Name resolution is often a problem on OSX; not focus of HTTP package anyway.
# Also a problem on other platforms for http-4.14 (test with bad port number).
set HOST localhost
set bindata "This is binary data\x0D\x0Amore\x0Dmore\x0Amore\x00null"
catch {unset data}

# Ensure httpd file exists

set origFile [file join [pwd] [file dirname [info script]] httpd]
set httpdFile [file join [temporaryDirectory] httpd_[pid]]
if {![file exists $httpdFile]} {
    makeFile "" $httpdFile
    file delete $httpdFile
    file copy $origFile $httpdFile
    set removeHttpd 1
}

catch {package require Thread 2.7-}
if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
    set httpthread [thread::create -preserved]
    lappend threadStack [list thread::release $httpthread]
    thread::send $httpthread [list source $httpdFile]
    thread::send $httpthread [list set bindata $bindata]
    thread::send $httpthread {httpd_init 0; set port} port
    puts "Running httpd in thread $httpthread"
} else {
    if {![file exists $httpdFile]} {
	puts "Cannot read $httpdFile script, http test skipped"
	unset port
	return
    }
    source $httpdFile
    # Let the OS pick the port; that's much more flexible
    if {[catch {httpd_init 0} listen]} {
	puts "Cannot start http server, http test skipped"
	catch {unset port}
	return
    }
    set threadStack {}
}

if 0 {
    # For debugging: run with a single value of ThreadLevel: 0|1|2
    set ThreadLevel 0
    testConstraint ThreadLevelSummary 1
}
if {![info exists ThreadLevel]} {
    if {[catch {package require Thread}] == 0} {
	set ValueRange {0 1 2}
    } else {
	set ValueRange {0 1}
    }

    # For each value of ThreadLevel, source this file recursively in the
    # same interpreter.
    foreach ThreadLevel $ValueRange {
	source [info script]
    }
    if {[llength $threadStack]} {
	eval [lpop threadStack]
    }
    catch {unset ThreadLevel}
    catch {unset ValueRange}
    if {![testConstraint ThreadLevelSummary]} {
	::tcltest::cleanupTests
    }
    return
}

catch {puts "==== Test with ThreadLevel $ThreadLevel ===="}
http::config -threadlevel $ThreadLevel

test http-1.1.$ThreadLevel {http::config} {
    http::config -useragent UserAgent
    http::config
} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyauth {} -proxyfilter http::ProxyRequired -proxyhost {} -proxynot {} -proxyport {} -repost 0 -threadlevel $ThreadLevel -urlencoding utf-8 -useragent UserAgent -zip 1]
test http-1.2.$ThreadLevel {http::config} {
    http::config -proxyfilter
} http::ProxyRequired
test http-1.3.$ThreadLevel {http::config} {
    catch {http::config -junk}
} 1
test http-1.4.$ThreadLevel {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
} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyauth {} -proxyfilter myFilter -proxyhost nowhere.come -proxynot {} -proxyport 8080 -repost 0 -threadlevel $ThreadLevel -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1]
test http-1.5.$ThreadLevel {http::config} -returnCodes error -body {
    http::config -proxyhost {} -junk 8080
} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyauth, -proxyfilter, -proxyhost, -proxynot, -proxyport, -repost, -threadlevel, -urlencoding, -useragent, -zip}
test http-1.6.$ThreadLevel {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.$ThreadLevel {http::reset} {
    catch {http::reset http#1}
} 0
test http-2.2.$ThreadLevel {http::CharsetToEncoding} {
    http::CharsetToEncoding iso-8859-11
} iso8859-11
test http-2.3.$ThreadLevel {http::CharsetToEncoding} {
    http::CharsetToEncoding iso-2022-kr
} iso2022-kr
test http-2.4.$ThreadLevel {http::CharsetToEncoding} {
    http::CharsetToEncoding shift-jis
} shiftjis
test http-2.5.$ThreadLevel {http::CharsetToEncoding} {
    http::CharsetToEncoding windows-437
} cp437
test http-2.6.$ThreadLevel {http::CharsetToEncoding} {
    http::CharsetToEncoding latin5
} iso8859-9
test http-2.7.$ThreadLevel {http::CharsetToEncoding} {
    http::CharsetToEncoding latin1
} iso8859-1
test http-2.8.$ThreadLevel {http::CharsetToEncoding} {
    http::CharsetToEncoding latin4
} binary

test http-3.1.$ThreadLevel {http::geturl} -returnCodes error -body {
    http::geturl -bogus flag
} -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -guesstype, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}

test http-3.2.$ThreadLevel {http::geturl} -returnCodes error -body {
    http::geturl http:junk
} -result {Unsupported URL: http:junk}

set url //${::HOST}:$port
set badurl //${::HOST}:[expr {$port+1}]
test http-3.3.$ThreadLevel {http::geturl} -body {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    catch {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 //${::HOST}:$port/a/b/c
set fullurl HTTP://user:pass@${::HOST}:$port/a/b/c
set binurl //${::HOST}:$port/binary
set xmlurl //${::HOST}:$port/xml
set posturl //${::HOST}:$port/post
set badposturl //${::HOST}:$port/droppost
set authorityurl //${::HOST}:$port
set ipv6url http://\[::1\]:$port/

test http-3.4.$ThreadLevel {http::geturl} -body {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    catch {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 ${::HOST} $port]
}
test http-3.5.$ThreadLevel {http::geturl} -body {
    http::config -proxyfilter selfproxy
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::config -proxyfilter http::ProxyRequired
    catch {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.$ThreadLevel {http::geturl} -body {
    http::config -proxyfilter bogus
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::config -proxyfilter http::ProxyRequired
    catch {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.$ThreadLevel {http::geturl} -body {
    set token [http::geturl $url -headers {Pragma no-cache}]
    http::data $token
} -cleanup {
    catch {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.$ThreadLevel {http::geturl} -body {
    set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 3000]
    http::data $token
} -cleanup {
    catch {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.$ThreadLevel {http::geturl} -body {
    set token [http::geturl $url -validate 1]
    http::code $token
} -cleanup {
    catch {http::cleanup $token}
} -result "HTTP/1.0 200 OK"
test http-3.10.$ThreadLevel {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 {tok x y} {
	global postProgress
	lappend postProgress $y
    }
    set postProgress {}
    set token [http::geturl $posturl -keepalive 0 -query $query \
	    -queryprogress postProgress -queryblocksize 16384]
    http::wait $token
    list [http::status $token] [string length $query] $postProgress [http::data $token]
} -cleanup {
    catch {http::cleanup $token}
} -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
test http-3.11.$ThreadLevel {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 {tok} {
	global postResult
	lappend postResult [http::data $tok]
    }
    set postResult [list ]
    set token [http::geturl $posturl -querychannel $fp]
    http::wait $token
    set testRes [list [http::status $token] [string length $query] [http::data $token]]
    # Now do async
    http::cleanup $token
    close $fp
    set fp [open $file]
    set token [http::geturl $posturl -querychannel $fp -command asyncCB]
    set postResult [list PostStart]
    http::wait $token
    close $fp
    lappend testRes [http::status $token] $postResult
} -cleanup {
    removeFile outdata
    catch {http::cleanup $token}
} -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.$ThreadLevel {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 {tok} {
	global postResult
	lappend postResult [http::data $tok]
    }
    proc postProgress {tok x y} {
	global postProgress
	lappend postProgress $y
    }
    set postProgress {}
    # Now do async
    set postResult [list PostStart]
    if {[catch {
	set token [http::geturl $badposturl -querychannel $fp -command asyncCB \
		-queryprogress postProgress]
	http::wait $token
	upvar #0 $token state
    } err]} {
	puts $::errorInfo
	error $err
    }
    list [http::status $token] [http::code $token]
} -cleanup {
    removeFile outdata
    catch {http::cleanup $token}
} -result {ok {HTTP/1.0 200 Data follows}}
test http-3.13.$ThreadLevel {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.$ThreadLevel "http::geturl $fullurl" -body {
    set token [http::geturl $fullurl -validate 1]
    http::code $token
} -cleanup {
    catch {http::cleanup $token}
} -result "HTTP/1.0 200 OK"
test http-3.15.$ThreadLevel {http::geturl parse failures} -body {
    http::geturl "{invalid}:url"
} -returnCodes error -result {Unsupported URL: {invalid}:url}
test http-3.16.$ThreadLevel {http::geturl parse failures} -body {
    http::geturl http:relative/url
} -returnCodes error -result {Unsupported URL: http:relative/url}
test http-3.17.$ThreadLevel {http::geturl parse failures} -body {
    http::geturl /absolute/url
} -returnCodes error -result {Missing host part: /absolute/url}
test http-3.18.$ThreadLevel {http::geturl parse failures} -body {
    http::geturl http://somewhere:123456789/
} -returnCodes error -result {Invalid port number: 123456789}
test http-3.19.$ThreadLevel {http::geturl parse failures} -body {
    http::geturl http://{user}@somewhere
} -returnCodes error -result {Illegal characters in URL user}
test http-3.20.$ThreadLevel {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.$ThreadLevel {http::geturl parse failures} -body {
    http::geturl http://somewhere/{path}
} -returnCodes error -result {Illegal characters in URL path}
test http-3.22.$ThreadLevel {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.$ThreadLevel {http::geturl parse failures} -body {
    http::geturl http://somewhere/path?{query}?
} -returnCodes error -result {Illegal characters in URL path}
test http-3.24.$ThreadLevel {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.$ThreadLevel {http::meta} -setup {
    unset -nocomplain m token
} -body {
    set token [http::geturl $url -timeout 3000]
    array set m [http::meta $token]
    lsort [array names m]
} -cleanup {
    catch {http::cleanup $token}
    unset -nocomplain m token
} -result {content-length content-type date}
test http-3.26.$ThreadLevel {http::meta} -setup {
    unset -nocomplain m token
} -body {
    set token [http::geturl $url -headers {X-Check 1} -timeout 3000]
    array set m [http::meta $token]
    lsort [array names m]
} -cleanup {
    catch {http::cleanup $token}
    unset -nocomplain m token
} -result {content-length content-type date x-check}
test http-3.27.$ThreadLevel {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 {
    catch {http::cleanup $token}
} -match regexp -result {(?n)Host .*
User-Agent .*
Content-Type {text/plain;charset=utf-8}
Accept \*/\*
Accept-Encoding .*
Connection close
Content-Length 5}
test http-3.28.$ThreadLevel {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 {
    catch {http::cleanup $token}
} -match regexp -result {(?n)Host .*
User-Agent .*
Content-Type {text/plain;charset=utf-8}
Accept \*/\*
Accept-Encoding .*
Connection close
Content-Length 5}
test http-3.29.$ThreadLevel {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.$ThreadLevel {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.$ThreadLevel {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.$ThreadLevel {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 {
    catch {http::cleanup $token}
} -match regexp -result {(?n)Host .*
User-Agent .*
Accept text/plain,application/tcl-test-value
Accept-Encoding .*
Connection close
Content-Type application/x-www-form-urlencoded
Content-Length 5}
# Bug 838e99a76d
test http-3.33.$ThreadLevel {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-3.34.$ThreadLevel {http::geturl -headers not a list} -returnCodes error -body {
    http::geturl http://test/t -headers \"
} -result "Bad value for -headers (\"), must be list"
test http-3.35.$ThreadLevel {http::geturl -headers not even number of elements} -returnCodes error -body {
    http::geturl http://test/t -headers {List Length 3}
} -result {Bad value for -headers (List Length 3), number of list elements must be even}

test http-4.1.$ThreadLevel {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 {
    catch {http::cleanup $token}
} -result 1
test http-4.2.$ThreadLevel {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 {
    catch {http::cleanup $token}
} -result 0
test http-4.3.$ThreadLevel {http::Event} -body {
    set token [http::geturl $url]
    http::code $token
} -cleanup {
    catch {http::cleanup $token}
} -result {HTTP/1.0 200 Data follows}
test http-4.4.$ThreadLevel {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
    catch {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.$ThreadLevel {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
    catch {http::cleanup $token}
} -result 1
test http-4.6.$ThreadLevel {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
    catch {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.$ThreadLevel {http::Event} knownBug {
    set token [http::geturl $url -blocksize 50 -progress myProgress]
    return $progress
} {111 111}
test http-4.7.$ThreadLevel {http::Event} -body {
    set token [http::geturl $url -keepalive 0 -progress myProgress]
    return $progress
} -cleanup {
    catch {http::cleanup $token}
} -result {111 111}
test http-4.8.$ThreadLevel {http::Event} -body {
    set token [http::geturl $url]
    http::status $token
} -cleanup {
    catch {http::cleanup $token}
} -result {ok}
test http-4.9.$ThreadLevel {http::Event} -body {
    set token [http::geturl $url -progress myProgress]
    http::code $token
} -cleanup {
    catch {http::cleanup $token}
} -result {HTTP/1.0 200 Data follows}
test http-4.10.$ThreadLevel {http::Event} -body {
    set token [http::geturl $url -progress myProgress]
    http::size $token
} -cleanup {
    catch {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.$ThreadLevel {http::Event} -body {
    set token [http::geturl $url -timeout 1 -keepalive 0 -command \#]
    http::reset $token
    http::status $token
} -cleanup {
    catch {http::cleanup $token}
} -result {reset}

#	Longer timeout with reset.
test http-4.12.$ThreadLevel {http::Event} -body {
    set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#]
    http::reset $token
    http::status $token
} -cleanup {
    catch {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.$ThreadLevel {http::Event} -body {
    set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#]
    http::wait $token
    http::status $token
} -cleanup {
    catch {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.$ThreadLevel {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.$ThreadLevel {http::Event} -body {
    # 1. The test assumes that http is not using a proxy server.
    #    If http is using a proxy server, the latter is responsible for the DNS
    #    lookup of the non-existent host. Squid responds with
    #    "503 Service Unavailable" and an explanatory response body; but other
    #    proxies may respond differently.
    # 2. The [socket] command blocks during the DNS lookup.
    #    - When [socket] runs in the main thread (i.e. when -threadlevel is 0 or
    #      (if Thread package not available) 1), the script cannot time out
    #      during a prolonged DNS lookup.
    #    - When [socket] runs in a separate thread (i.e. when the Thread package
    #      is available and [http::config -threadlevel] is 1 or 2), the main
    #      thread enters the event loop and has the opportunity to time out
    #      during the DNS lookup.  This causes the test to fail.
    #    - The test uses a long -timeout so that it is not confounded by a slow
    #      DNS lookup.
    #    - If the error result is "timeout", this suggests a problem with
    #      negative DNS lookups on the test host.  Compare the timings for
    #      different values of threadLevel.
    # set t0 [clock milliseconds]
    set token [http::geturl //not-a-host.nodns. -timeout 30000 -command \#]
    http::wait $token
    # set t1 [clock milliseconds]
    # puts "Test http-4.15.$ThreadLevel - time taken: [expr {$t1 - $t0}] ms"
    set result "[http::status $token] -- [lindex [http::error $token] 0]"
    # error codes vary among platforms.
} -cleanup {
    catch {http::cleanup $token}
} -match glob -result "error -- couldn't open socket*"

test http-4.16.$ThreadLevel {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup {
    proc list-difference {l1 l2} {
	lmap item $l2 {if {$item in $l1} continue; set item}
    }
} -body {
    set before [chan names]
    set token [http::geturl $url -headers {X-Connection keep-alive}]
    http::cleanup $token
    update
    # Compute what channels have been unexpectedly leaked past cleanup
    list-difference $before [chan names]
} -cleanup {
    rename list-difference {}
} -result {}

test http-5.1.$ThreadLevel {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.$ThreadLevel {http::formatQuery} {
    http::formatQuery lines "line1\nline2\nline3"
} {lines=line1%0D%0Aline2%0D%0Aline3}
test http-5.4.$ThreadLevel {http::formatQuery} {
    http::formatQuery name1 ~bwelch name2 ¡¢¢
} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2}
test http-5.5.$ThreadLevel {http::formatQuery} {
    set enc [http::config -urlencoding]
    http::config -urlencoding iso8859-1
    set res [http::formatQuery name1 ~bwelch name2 ¡¢¢]
    http::config -urlencoding $enc
    set res
} {name1=~bwelch&name2=%A1%A2%A2}

test http-6.1.$ThreadLevel {http::ProxyRequired} -body {
    http::config -proxyhost ${::HOST} -proxyport $port
    set token [http::geturl $url]
    http::wait $token
    upvar #0 $token data
    set data(body)
} -cleanup {
    http::config -proxyhost {} -proxyport {}
    catch {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.$ThreadLevel {http::mapReply} {
    http::mapReply "abc\$\[\]\"\\()\}\{"
} {abc%24%5B%5D%22%5C%28%29%7D%7B}
test http-7.2.$ThreadLevel {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 "∈"
} {%E2%88%88}
test http-7.3.$ThreadLevel {http::formatQuery} -setup {
    set enc [http::config -urlencoding]
} -returnCodes error -body {
    # -urlencoding "" no longer supported. Use "iso8859-1".
    http::config -urlencoding ""
    http::mapReply "∈"
} -cleanup {
    http::config -urlencoding $enc
} -result {unknown encoding ""}
test http-7.4.$ThreadLevel {http::formatQuery} -setup {
    set enc [http::config -urlencoding]
} -constraints {
    knownProfileBug
} -body {
    # this would be reverting to http <=2.4 behavior w/o errors
    # with Tcl 8.x (unknown chars become '?'), generating a
    # proper exception with Tcl 9.0
    http::config -urlencoding "iso8859-1"
    http::mapReply "∈"
} -cleanup {
    http::config -urlencoding $enc
} -errorCode {TCL ENCODING ILLEGALSEQUENCE 0} -result {unexpected character at index 0: 'U+002208'}

# cleanup
catch {unset url}
catch {unset badurl}
catch {unset port}
catch {unset data}
if {[llength $threadStack]} {
    eval [lpop threadStack]
} else {
    close $listen
}

if {[info exists removeHttpd]} {
    removeFile $httpdFile
}

rename bgerror {}

if {[testConstraint ThreadLevelSummary]} {
    ::tcltest::cleanupTests
}

# Local variables:
# mode: tcl
# End: