merge 8.7

11 files changed, 2178 insertions, 11 deletions

diff --git a/tests/config.test b/tests/config.test
index d14837e..468a1df 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 
 test pkgconfig-1.1 {query keys} {
     lsort [::tcl::pkgconfig list]
-} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded}
+} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime}
 test pkgconfig-1.2 {query keys multiple times} {
     string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
 } 0
diff --git a/tests/env.test b/tests/env.test
index 59d5391..79a353a 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -16,6 +16,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     namespace import -force ::tcltest::*
 }
 
+loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 package require tcltests
 
 # [exec] is required here to see the actual environment received by child
diff --git a/tests/exec.test b/tests/exec.test
index dfc44c4..4fd8b8d 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -17,6 +17,8 @@
 package require tcltest 2
 namespace import -force ::tcltest::*
 
+loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 package require tcltests
 
 # All tests require the "exec" command.
diff --git a/tests/http.test b/tests/http.test
index e165804..b6a7251 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -82,7 +82,7 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
 test http-1.1 {http::config} {
     http::config -useragent UserAgent
     http::config
-} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
+} [list -accept */* -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
 test http-1.2 {http::config} {
     http::config -proxyfilter
 } http::ProxyRequired
@@ -97,10 +97,10 @@ test http-1.4 {http::config} {
     set x [http::config]
     http::config {*}$savedconf
     set x
-} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
+} {-accept */* -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
 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}
+} -result {Unknown option -junk, must be: -accept, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
 test http-1.6 {http::config} -setup {
     set oldenc [http::config -urlencoding]
 } -body {
diff --git a/tests/http11.test b/tests/http11.test
index 2e50837..1e30802 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -515,10 +515,7 @@ proc handler {var sock token} {
     set chunk [read $sock]
     append data $chunk
     #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
-    if {[eof $sock]} {
-        #::http::Log "handler eof $sock"
-	chan event $sock readable {}
-    }
+    return [string length $chunk]
 }
 
 test http11-3.0 "-handler,close,identity" -setup {
diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test
new file mode 100644
index 0000000..5eb02d3
--- /dev/null
+++ b/tests/httpPipeline.test
@@ -0,0 +1,866 @@
+# httpPipeline.test
+#
+#	Test HTTP/1.1 concurrent requests including
+#	queueing, pipelining and retries.
+#
+# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
+#
+# 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
+namespace import -force ::tcltest::*
+
+package require http 2.8
+
+set sourcedir [file normalize [file dirname [info script]]]
+source [file join $sourcedir httpTest.tcl]
+source [file join $sourcedir httpTestScript.tcl]
+
+# ------------------------------------------------------------------------------
+# (1) Define the test scripts that will be used to generate logs for analysis -
+#     and also define the "correct" results.
+# ------------------------------------------------------------------------------
+
+proc ReturnTestScriptAndResult {ca cb delay te} {
+
+    switch -- $ca {
+	1     {set start {
+	    START
+	    KEEPALIVE 0
+	    PIPELINE  0
+	}}
+
+	2     {set start {
+	    START
+	    KEEPALIVE 0
+	    PIPELINE  1
+	}}
+
+	3     {set start {
+	    START
+	    KEEPALIVE 1
+	    PIPELINE  0
+	}}
+
+	4     {set start {
+	    START
+	    KEEPALIVE 1
+	    PIPELINE  1
+	}}
+
+	default {
+	    return -code error {no matching script}
+	}
+    }
+
+    set middle "
+	    [list DELAY $delay]
+    "
+
+    switch -- $cb {
+	1     {set end {
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 ? ? ?}
+	    set resLong  {1 2 3 4}
+	}
+
+	2     {set end {
+	    GET a
+	    HEAD b
+	    GET c
+	    HEAD a
+	    HEAD c
+	    STOP
+	    }
+	    set resShort {1 ? ? ? ?}
+	    set resLong  {1 2 3 4 5}
+	}
+
+	3     {set end {
+	    HEAD a
+	    GET b
+	    HEAD c
+	    HEAD b
+	    GET a
+	    GET b
+	    STOP
+	    }
+	    set resShort {1 ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6}
+	}
+
+	4     {set end {
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    POST b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? ? ? 5 ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	5     {set end {
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 3 4 5 6 7 8 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	6     {set end {
+	    POST a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    GET a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? 6 7 ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	7     {set end {
+	    GET b address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    GET a address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 ? 4 ? ? 7 8 ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	8     {set end {
+	    # Telling the server to close the connection.
+	    GET a
+	    GET b close=y
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	9     {set end {
+	    # Telling the server to close the connection.
+	    GET a
+	    POST b close=y address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 2 3 ? ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	10     {set end {
+	    # Telling the server to close the connection.
+	    GET a
+	    GET b close=y
+	    POST c address=home code=brief paid=yes
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	11    {set end {
+	    # Telling the server to close the connection twice.
+	    GET a
+	    GET b close=y
+	    GET c
+	    GET a
+	    GET b close=y
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? 6 ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	12    {set end {
+	    # Telling the server to delay before sending the response.
+	    GET a
+	    GET b delay=1
+	    GET c
+	    GET a
+	    GET b
+	    STOP
+	    }
+	    set resShort {1 ? ? ? ?}
+	    set resLong  {1 2 3 4 5}
+	}
+
+	13    {set end {
+	    # Making the server close the connection (time out).
+	    GET a
+	    WAIT 2000
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    STOP
+	    }
+	    set resShort {1 2 ? ? ?}
+	    set resLong  {1 2 3 4 5}
+	}
+
+	14    {set end {
+	    # Making the server close the connection (time out) twice.
+	    GET a
+	    WAIT 2000
+	    GET b
+	    GET c
+	    GET a
+	    WAIT 2000
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 2 ? ? 5 ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	15    {set end {
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes close=y delay=1
+	    POST c address=home code=brief paid=yes delay=1
+	    POST a address=home code=brief paid=yes close=y
+	    WAIT 2000
+	    POST b address=home code=brief paid=yes delay=1
+	    POST c address=home code=brief paid=yes close=y
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes close=y
+	    POST c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 3 4 5 6 7 8 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	16    {set end {
+	    POST a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes close=y
+	    GET a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes close=y
+	    POST c address=home code=brief paid=yes
+	    WAIT 2000
+	    POST a address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes close=y
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 ? 3 4 ? 6 7 ? 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	17    {set end {
+	    GET b address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    GET a address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes close=y
+	    GET b address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes close=y
+	    POST c address=home code=brief paid=yes
+	    WAIT 2000
+	    POST a address=home code=brief paid=yes
+	    WAIT 2000
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 3 4 5 ? 7 8 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+
+	18    {set end {
+	    REPOST 0
+	    GET a
+	    WAIT 2000
+	    POST b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 2 ? ?}
+	    set resLong  {1 2 3 4}
+	    # resShort is overwritten below for the case ($te == 1).
+	}
+
+
+	19    {set end {
+	    REPOST 0
+	    GET a
+	    WAIT 2000
+	    GET b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 2 ? ?}
+	    set resLong  {1 2 3 4}
+	}
+
+
+	20    {set end {
+	    POSTFRESH 1
+	    GET a
+	    WAIT 2000
+	    POST b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 3 ?}
+	    set resLong  {1 3 4}
+	}
+
+
+	21    {set end {
+	    POSTFRESH 1
+	    GET a
+	    WAIT 2000
+	    GET b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 2 ? ?}
+	    set resLong  {1 2 3 4}
+	}
+
+	22    {set end {
+	    GET a
+	    WAIT 2000
+	    KEEPALIVE 0
+	    POST b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 3 ?}
+	    set resLong  {1 3 4}
+	}
+
+
+	23    {set end {
+	    GET a
+	    WAIT 2000
+	    KEEPALIVE 0
+	    GET b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 3 ?}
+	    set resLong  {1 3 4}
+	}
+
+	24    {set end {
+	    GET a
+	    KEEPALIVE 0
+	    POST b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 ? ?}
+	    set resLong  {1 3 4}
+	}
+
+
+	25    {set end {
+	    GET a
+	    KEEPALIVE 0
+	    GET b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 ? ?}
+	    set resLong  {1 3 4}
+	}
+
+	default {
+	    return -code error {no matching script}
+	}
+    }
+
+
+    if {$ca < 3} {
+	# Not Keep-Alive.
+        set result "Passed all sanity checks."
+
+    } elseif {$ca == 3} {
+        # Keep-Alive, not pipelined.
+        set result {}
+        append result "Passed all sanity checks.\n"
+        append result "Have overlaps including response body:\n"
+
+    } else {
+        # Keep-Alive, pipelined: ($ca == 4)
+        set result {}
+        append result "Passed all sanity checks.\n"
+        append result "Overlap-free without response body:\n"
+        append result "$resShort"
+    }
+
+    # - The special case of test *.18*-testEof needs test results to be
+    #   individually written.
+    # - These test -repost 0 when there is a POST to apply it to, and the server
+    #   timeout has not been detected.
+    if {($cb == 18) && ($te == 1)} {
+        if {$ca < 3} {
+	    # Not Keep-Alive.
+	    set result "Passed all sanity checks."
+
+	} elseif {$ca == 3 && $delay == 0} {
+	    # Keep-Alive, not pipelined.
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::3 - {A X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::4 - {A X X X}
+		|- and error(s) X
+		|
+		|Have overlaps including response body:
+		|
+	    }]
+
+	} elseif {$ca == 3} {
+	    # Keep-Alive, not pipelined.
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|
+		|Have overlaps including response body:
+		|
+	    }]
+
+	} elseif {$delay == 0} {
+	    # Keep-Alive, pipelined: ($ca == 4)
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::3 - {A X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::4 - {A X X X}
+		|- and error(s) X
+		|
+		|Overlap-free without response body:
+		|
+	    }]
+
+	} else {
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|
+		|Overlap-free without response body:
+		|
+	    }]
+
+        }
+    }
+
+    return [list "$start$middle$end" $result]
+}
+
+# ------------------------------------------------------------------------------
+#  Proc MakeMessage
+# ------------------------------------------------------------------------------
+# WHD's one-line command to generate multi-line strings from readable code.
+# 
+# Example:
+#   set blurb [MakeMessage {
+#            |This command allows multi-line strings to be created with readable
+#            |code, and without breaking the rules for indentation.
+#            |
+#            |The command shifts the entire block of text to the left, omitting
+#            |the pipe character and the spaces to its left.
+#   }]
+# ------------------------------------------------------------------------------
+
+proc MakeMessage {in} {
+    regsub -all -line {^\s*\|} [string trim $in] {}
+    # N.B. Implicit Return.
+}
+
+
+proc ReturnTestScript {ca cb delay te} {
+    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
+    return $script
+}
+
+proc ReturnTestResult {ca cb delay te} {
+    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
+    return $result
+}
+
+
+# ------------------------------------------------------------------------------
+# (2) Command to run a test script and use httpTest to analyse the logs.
+# ------------------------------------------------------------------------------
+
+namespace import httpTestScript::runHttpTestScript
+namespace import httpTestScript::cleanupHttpTestScript
+namespace import httpTest::cleanupHttpTest
+namespace import httpTest::logAnalyse
+namespace import httpTest::setHttpTestOptions
+
+proc RunTest {header footer delay te} {
+    set num [runHttpTestScript [ReturnTestScript $header $footer $delay $te]]
+    set skipOverlaps 0
+    set notPiped    {}
+    set notIncluded {}
+
+    # --------------------------------------------------------------------------
+    # Custom code for specific tests
+    # --------------------------------------------------------------------------
+    if {$header < 3} {
+        set skipOverlaps 1
+        for {set i 1} {$i <= $num} {incr i} {
+	    lappend notPiped $i
+        }
+    } elseif {$header > 2 && $footer == 18 && $te == 1} {
+        set skipOverlaps 1
+        if {$delay == 0} {
+	    # Transaction 1 is conventional.
+	    # Check that transactions 2,3,4 are cancelled.
+	    set notPiped {1}
+	    set notIncluded $notPiped
+        } else {
+	    # Transaction 1 is conventional.
+	    # Check that transaction 2 is cancelled.
+	    # The timing of transactions 3 and 4 is uncertain.
+	    set notPiped {1 3 4}
+	    set notIncluded $notPiped
+	}
+    } elseif {$footer in {20 22 23 24 25}} {
+	# Transaction 2 uses its own socket.
+	set notPiped    2
+	set notIncluded $notPiped
+    } else {
+    }
+    # --------------------------------------------------------------------------
+    # End of custom code for specific tests
+    # --------------------------------------------------------------------------
+
+
+    set Results [logAnalyse $num $skipOverlaps $notIncluded $notPiped]
+    lassign $Results msg cleanE cleanF dirtyE dirtyF
+    if {$msg eq {}} {
+        set msg "Passed all sanity checks."
+    } else {
+        set msg "Problems with sanity checks:\n$msg"
+    }
+
+    if 0 {
+        puts $msg
+        puts "Overlap-free including response body:\n$cleanF"
+        puts "Have overlaps including response body:\n$dirtyF"
+        puts "Overlap-free without response body:\n$cleanE"
+        puts "Have overlaps without response body:\n$dirtyE"
+    }
+
+    if {$header < 3} {
+        # No ordering, just check that transactions all finish
+        set result $msg
+    } elseif {$header == 3} {
+        # Not pipelined - check overlaps with response body.
+        set result "$msg\nHave overlaps including response body:\n$dirtyF"
+    } else {
+        # Pipelined - check overlaps without response body.  Check that the
+        # first request, the first requests after replay, and POSTs are clean.
+        set result "$msg\nOverlap-free without response body:\n$cleanE"
+    }
+    set ::nTokens $num
+    return $result
+}
+
+
+# ------------------------------------------------------------------------------
+# (3) VERBOSITY CONTROL
+# ------------------------------------------------------------------------------
+# If tests fail, run an individual test with -verbose 1 or 2 for diagnosis.
+# If still obscure, uncomment #Log and ##Log lines in the http package.
+# ------------------------------------------------------------------------------
+
+setHttpTestOptions -verbose 0
+
+# ------------------------------------------------------------------------------
+# (4) Define the base URLs used for testing.  Each must have a query string.
+# ------------------------------------------------------------------------------
+# - A HTTP/1.1 server is required.  It should be configured to provide
+#   persistent connections when requested to do so, and to close these
+#   connections if they are idle for one second.
+# - The resource must be served with status 200 in response to a valid GET or
+#   POST.
+# - The value of "page" is always specified in the query-string. Different
+#   resources for the three values of "page" allow testing of both chunked and
+#   unchunked transfer encoding.
+# - The variables "close" and "delay" may be specified in the query-string (for
+#   a GET) or the request body (for a POST).
+#   - "delay" is a numerical value in seconds, and causes the server to delay
+#     the response, including headers.
+#   - "close", if it has the value "y", instructs the server to close the
+#     connection ater the current request.
+# - Any other variables should be ignored.
+# ------------------------------------------------------------------------------
+
+namespace eval ::httpTestScript {
+    variable URL
+    array set URL {
+        a  http://test-tcl-http.kerlin.org/index.html?page=privacy
+        b  http://test-tcl-http.kerlin.org/index.html?page=conditions
+        c  http://test-tcl-http.kerlin.org/index.html?page=welcome
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+# (5) Define the tests
+# ------------------------------------------------------------------------------
+# Constraints:
+# - serverNeeded - the URLs defined at (4) must be available, and must have the
+#                  properties specified there.
+# - duplicate    - the value of -pipeline does not matter if -keepalive 0
+# - timeout1s    - tests that work correctly only if the server closes
+#                  persistent connections after one second.
+#
+# Server timeout of persistent connections should be 1s.  Delays of 2s are
+# intended to cause timeout.
+# Servers are usually configured to use a longer timeout: this will cause the
+# tests to fail.  The "2000" could be replaced with a larger number, but the
+# tests will then be inconveniently slow.
+# ------------------------------------------------------------------------------
+
+#testConstraint serverNeeded 1
+#testConstraint timeout1s 1
+#testConstraint duplicate 1
+
+# ------------------------------------------------------------------------------
+#  Proc SetTestEof - to edit the command ::http::KeepSocket
+# ------------------------------------------------------------------------------
+# The usual line in command ::http::KeepSocket is "    set TEST_EOF 0".
+# Whether the value set in the file is 0 or 1, change it here to the value
+# specified by the argument.
+#
+# It is worth doing all tests for both values of the argument.
+#
+# test 0  - ::http::KeepSocket is unchanged, detects server eof where possible
+#           and closes the connection.
+# test 1  - ::http::KeepSocket is edited, does not detect server eof, so the
+#           reaction to finding server eof can be tested without the difficulty
+#           of testing in the few milliseconds of an asynchronous close event.
+# ------------------------------------------------------------------------------
+
+proc SetTestEof {test} {
+    set body [info body ::http::KeepSocket]
+    set subs "    set TEST_EOF $test"
+    set count [regsub -line -all -- {^\s*set TEST_EOF .*$} $body $subs newBody]
+    if {$count != 1} {
+        return -code error {proc ::http::KeepSocket has unexpected form}
+    }
+    proc ::http::KeepSocket {token} $newBody
+    return
+}
+
+for {set header 1} {$header <= 4} {incr header} {
+    if {$header == 4} {
+	setHttpTestOptions -dotted 1
+	set match glob
+    } else {
+	setHttpTestOptions -dotted 0
+	set match exact
+    }
+
+    if {$header == 2} {
+        set cons0 {serverNeeded duplicate}
+    } else {
+        set cons0 serverNeeded
+    }
+
+    for {set footer 1} {$footer <= 25} {incr footer} {
+        foreach {delay label} {
+	       0 a
+	       1 b
+	       2 c
+	       3 d
+	       5 e
+	       8 f
+	      12 g
+	     100 h
+	     500 i
+	    2000 j
+	} {
+	  foreach te {0 1} {
+	    if {$te} {
+	        set tag testEof
+	    } else {
+	        set tag normal
+	    }
+	    set suffix {}
+	    set cons $cons0
+
+	    # ------------------------------------------------------------------
+	    # Custom code for individual tests
+	    # ------------------------------------------------------------------
+	    if {$footer in {18}} {
+		# Custom code:
+		if {($label eq "j") && ($te == 1)} {
+		    continue
+		}
+		if {$te == 1} {
+		    # The test (of REPOST 0) is useful if tag is "testEof"
+		    # (server timeout without client reaction).  The same test
+		    # has a different result if tag is "normal".
+
+		    set suffix " - extra test for -repost 0 - ::http::2 must be"
+		    append suffix " cancelled"
+		    if {($delay == 0)} {
+			append suffix ", along with  ::http::3  ::http::4 if"
+			append suffix " the test creates these before ::http::2"
+			append suffix " is cancelled"
+		    }
+		} else {
+		}
+	    } elseif {$footer in {19}} {
+		set suffix " - extra test for -repost 0"
+	    } elseif {$footer in {20 21}} {
+		set suffix " - extra test for -postfresh 1"
+		if {($footer == 20)} {
+		    append suffix " - ::http::2 uses a separate socket"
+		    append suffix ", other requests use a persistent connection"
+		}
+	    } elseif {$footer in {22 23 24 25}} {
+		append suffix " - ::http::2 uses a separate socket"
+		append suffix ", other requests use a persistent connection"
+	    } else {
+	    }
+
+	    if {($footer >= 13 && $footer <= 23)} {
+		# Test use WAIT and depend on server timeout before this time.
+		lappend cons timeout1s
+	    }
+	    # ------------------------------------------------------------------
+	    # End of custom code.
+	    # ------------------------------------------------------------------
+
+            set name "pipeline test header $header footer $footer delay $delay $tag$suffix"
+
+
+	    # Here's the test:
+            test httpPipeline-${header}.${footer}${label}-${tag} $name \
+            -constraints $cons \
+            -setup [string map [list TE $te] {
+		# Restore default values for tests:
+		http::config -pipeline 1 -postfresh 0 -repost 1
+                http::init
+                set http::http(uid) 0
+		SetTestEof {TE}
+	    }] -body [list RunTest $header $footer $delay $te] -cleanup {
+		# Restore default values for tests:
+		http::config -pipeline 1 -postfresh 0 -repost 1
+		cleanupHttpTestScript
+		SetTestEof 0
+		cleanupHttpTest
+		after 2000
+		# Wait for persistent sockets on the server to time out.
+	    } -result [ReturnTestResult $header $footer $delay $te] -match $match
+
+
+	  }
+
+	}
+    }
+}
+
+# ------------------------------------------------------------------------------
+# (*) Notes on tests *.18*-testEof, *.19*-testEof - these test -repost 0
+# ------------------------------------------------------------------------------
+# These tests are a bit awkward because the main test kit analyses whether all
+# requests are satisfied, with retries if necessary, and it has result analysis
+# for processing retry logs.
+# - *.18*-testEof tests that certain requests are NOT satisfied, so the analysis
+#   is a one-off.
+# - Tests *.18a-testEof depend on client/server timing - the test needs to call
+#   http::geturl for all requests before the POST (request 2) is cancelled.
+#   We test that requests 2, 3, 4 are all cancelled.
+# - Other tests *.18*-testEof may not request 3 and 4 in time for the to be
+#   added to the write queue before request 2 is completed. We simply check that
+#   request 2 is cancelled.
+# - The behaviour is different if all connections are allowed to time out
+#   (label "j").  This case is not needed to test -repost 0, and is omitted.
+# - Tests *.18*-normal and *.19* are conventional (-repost 0 should have no
+#   effect).
+# ------------------------------------------------------------------------------
+
+
+unset header footer delay label suffix match cons name te
+namespace delete ::httpTest
+namespace delete ::httpTestScript
+
+::tcltest::cleanupTests
diff --git a/tests/httpTest.tcl b/tests/httpTest.tcl
new file mode 100644
index 0000000..9cd7a5d
--- /dev/null
+++ b/tests/httpTest.tcl
@@ -0,0 +1,505 @@
+# httpTest.tcl
+#
+#	Test HTTP/1.1 concurrent requests including
+#	queueing, pipelining and retries.
+#
+# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ------------------------------------------------------------------------------
+# "Package" httpTest for analysis of Log output of http requests.
+# ------------------------------------------------------------------------------
+# This is a specialised test kit for examining the presence, ordering, and
+# overlap of multiple HTTP transactions over a persistent ("Keep-Alive")
+# connection; and also for testing reconnection in accordance with RFC 7230 when
+# the connection is lost.
+#
+# This kit is probably not useful for other purposes.  It depends on the
+# presence of specific Log commands in the http library, and it interprets the
+# logs that these commands create.
+# ------------------------------------------------------------------------------
+
+package require http
+
+namespace eval ::http {
+    variable TestStartTimeInMs [clock milliseconds]
+    catch {puts stdout "Start time (zero ms) is $TestStartTimeInMs"}
+}
+
+namespace eval ::httpTest {
+    variable testResults {}
+    variable testOptions
+    array set testOptions {
+        -verbose 0
+        -dotted  1
+    }
+    # -verbose - 0 quiet 1 write to stdout 2 write more
+    # -dotted  - (boolean) use dots for absences in lists of transactions
+}
+
+proc httpTest::Puts {txt} {
+    variable testOptions
+    if {$testOptions(-verbose) > 0} {
+        puts stdout $txt
+        flush stdout
+    }
+    return
+}
+
+# http::Log
+#
+# A special-purpose logger used for running tests.
+# - Processes Log calls that have "^" in their arguments, and records them in
+#   variable ::httpTest::testResults.
+# - Also writes them to stdout (using Puts) if ($testOptions(-verbose) > 0).
+# - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1).
+
+proc http::Log {args} {
+    variable TestStartTimeInMs
+    set time [expr {[clock milliseconds] - $TestStartTimeInMs}]
+    set txt [list $time {*}$args]
+    if {[string first ^ $txt] != -1} {
+        ::httpTest::LogRecord $txt
+        ::httpTest::Puts $txt
+    } elseif {$::httpTest::testOptions(-verbose) > 1} {
+        ::httpTest::Puts $txt
+    }
+    return
+}
+
+
+# Called by http::Log (the "testing" version) to record logs for later analysis.
+
+proc httpTest::LogRecord {txt} {
+    variable testResults
+
+    set pos [string first ^ $txt]
+    set len [string length  $txt]
+    if {$pos > $len - 3} {
+        puts stdout "Logging Error: $txt"
+        puts stdout "Fix this call to Log in http-*.tm so it has ^ then\
+		a letter then a numeral."
+        flush stdout
+    } elseif {$pos == -1} {
+        # Called by mistake.
+    } else {
+        set letter [string index $txt [incr pos]]
+        set number [string index $txt [incr pos]]
+        # Max 9 requests!
+        lappend testResults [list $letter $number]
+    }
+
+    return
+}
+
+
+# ------------------------------------------------------------------------------
+# Commands for analysing the logs recorded when calling http::geturl.
+# ------------------------------------------------------------------------------
+
+# httpTest::TestOverlaps --
+#
+# The main test for correct behaviour of pipelined and sequential
+# (non-pipelined) transactions.  Other tests should be run first to detect
+# any inconsistencies in the data (e.g. absence of the elements that are
+# examined here).
+#
+# Examine the sequence $someResults for each transaction from 1 to $n,
+# ignoring any that are listed in $badTrans.
+# Determine whether the elements "B" to $term for one transaction overlap
+# elements "B" to $term for the previous and following transactions.
+#
+# Transactions in the list $badTrans are not included in "clean" or
+# "dirty", but their possible overlap with other transactions is noted.
+# Transactions in the list $notPiped are a subset of $badTrans, and
+# their possible overlap with other transactions is NOT noted.
+#
+# Arguments:
+# someResults - list of results, each of the form {letter numeral}
+# n           - number of HTTP transactions
+# term        - letter that indicated end of search range. "E" for testing
+#               overlaps from start of request to end of response headers.
+#               "F" to extend to the end of the response body.
+# msg         - the cumulative message from sanity checks.  Append to it only
+#               to report a test failure.
+# badTrans    - list of transaction numbers not to be assessed as "clean" or
+#               "dirty"
+# notPiped    - subset of badTrans.  List of transaction numbers that cannot
+#               taint another transaction by overlapping with it, because it
+#               used a different socket.
+#
+# Return value: [list $msg $clean $dirty]
+# msg   - warning messages: nothing will be appended to argument $msg if there
+#         is an error with the test.
+# clean - list of transactions that have no overlap with other transactions
+# dirty - list of transactions that have YES overlap with other transactions
+
+proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} {
+    variable testOptions
+
+    # Check whether transactions overlap:
+    set clean {}
+    set dirty {}
+    for {set i 1} {$i <= $n} {incr i} {
+        if {$i in $badTrans} {
+            continue
+        }
+        set myStart   [lsearch -exact $someResults [list B $i]]
+        set myEnd     [lsearch -exact $someResults [list $term $i]]
+
+        if {($myStart == -1 || $myEnd == -1)} {
+            set res "Cannot find positions of transaction $i"
+	    append msg $res \n
+	    Puts $res
+        }
+
+	set overlaps {}
+	for {set j $myStart} {$j <= $myEnd} {incr j} {
+	    lassign [lindex $someResults $j] letter number
+	    if {$number != $i && $letter ne "A" && $number ni $notPiped} {
+		lappend overlaps $number
+	    }
+	}
+
+        if {[llength $overlaps] == 0} {
+	    set res "Transaction $i has no overlaps"
+	    Puts $res
+	    lappend clean $i
+	    if {$testOptions(-dotted)} {
+		# N.B. results from different segments are concatenated.
+		lappend dirty .
+	    } else {
+	    }
+        } else {
+	    set res "Transaction $i overlaps with [join $overlaps { }]"
+	    Puts $res
+	    lappend dirty $i
+	    if {$testOptions(-dotted)} {
+		# N.B. results from different segments are concatenated.
+		lappend clean .
+	    } else {
+	    }
+        }
+    }
+    return [list $msg $clean $dirty]
+}
+
+# httpTest::PipelineNext --
+#
+# Test whether prevPair, pair are valid as consecutive elements of a pipelined
+# sequence (Start 1), (End 1), (Start 2), (End 2) ...
+# Numbers are integers increasing (by 1 if argument "any" is false), and need
+# not begin with 1.
+# The first element of the sequence has prevPair {} and is always passed as
+# valid.
+#
+# Arguments;
+# Start        - string that labels the start of a segment
+# End          - string that labels the end of a segment
+# prevPair     - previous "pair" (list of string and number) element of a
+#                sequence, or {} if argument "pair" is the first in the
+#                sequence.
+# pair         - current "pair" (list of string and number) element of a
+#                sequence
+# any          - (boolean) iff true, accept any increasing sequence of integers.
+#                If false, integers must increase by 1.
+#
+# Return value - boolean, true iff the two pairs are valid consecutive elements.
+
+proc httpTest::PipelineNext {Start End prevPair pair any} {
+    if {$prevPair eq {}} {
+        return 1
+    }
+
+    lassign $prevPair letter number
+    lassign $pair newLetter newNumber
+    if {$letter eq $Start} {
+	return [expr {($newLetter eq $End) && ($newNumber == $number)}]
+    } elseif {$any} {
+        set nxt [list $Start [expr {$number + 1}]]
+	return [expr {($newLetter eq $Start) && ($newNumber > $number)}]
+    } else {
+        set nxt [list $Start [expr {$number + 1}]]
+	return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}]
+    }
+}
+
+# httpTest::TestPipeline --
+#
+# Given a sequence of "pair" elements, check that the elements whose string is
+# $Start or $End form a valid pipeline. Ignore other elements.
+#
+# Return value: {} if valid pipeline, otherwise a non-empty error message.
+
+proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} {
+    set sequence {}
+    set prevPair {}
+    set ok 1
+    set any [llength $badTrans]
+    foreach pair $someResults {
+        lassign $pair letter number
+        if {($letter in [list $Start $End]) && ($number ni $badTrans)} {
+            lappend sequence $pair
+            if {![PipelineNext $Start $End $prevPair $pair $any]} {
+		set ok 0
+		break
+            }
+            set prevPair $pair
+        }
+    }
+
+    if {!$ok} {
+        set res "$desc are not pipelined: {$sequence}"
+        append msg $res \n
+        Puts $res
+    }
+    return $msg
+}
+
+# httpTest::TestSequence --
+#
+# Examine each transaction from 1 to $n, ignoring any that are listed
+# in $badTrans.
+# Check that each transaction has elements A to F, in alphabetical order.
+
+proc httpTest::TestSequence {someResults n msg badTrans} {
+    variable testOptions
+
+    for {set i 1} {$i <= $n} {incr i} {
+        if {$i in $badTrans} {
+	    continue
+        }
+        set sequence {}
+        foreach pair $someResults {
+            lassign $pair letter number
+            if {$number == $i} {
+                lappend sequence $letter
+            }
+        }
+        if {$sequence eq {A B C D E F}} {
+        } else {
+            set res "Wrong sequence for token ::http::$i - {$sequence}"
+	    append msg $res \n
+	    Puts $res
+            if {"X" in $sequence} {
+                set res "- and error(s) X"
+		append msg $res \n
+		Puts $res
+            }
+            if {"Y" in $sequence} {
+                set res "- and warnings(s) Y"
+		append msg $res \n
+		Puts $res
+            }
+        }
+    }
+    return $msg
+}
+
+#
+# Arguments:
+# someResults  - list of elements, each a list of a letter and a number
+# n            - (positive integer) the number of HTTP requests
+# msg          - accumulated warning messages
+# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
+# badTrans     - list of transaction numbers not to be assessed as "clean" or
+#                "dirty" by their overlaps
+#   for 1/2 includes all transactions
+#   for 3/4 includes an increasing (with recursion) set that will not be included in the list because they are already handled.
+# notPiped     - subset of badTrans.  List of transaction numbers that cannot
+#                taint another transaction by overlapping with it, because it
+#                used a different socket.
+#
+# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+# msg    - warning messages: nothing will be appended to argument $msg if there
+#          is no error with the test.
+# cleanE - list of transactions that have no overlap with other transactions
+#          (not considering response body)
+# dirtyE - list of transactions that have YES overlap with other transactions
+#          (not considering response body)
+# cleanF - list of transactions that have no overlap with other transactions
+#          (including response body)
+# dirtyF - list of transactions that have YES overlap with other transactions
+#          (including response body)
+
+proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} {
+    variable testOptions
+
+    # Check that stages for "good" transactions are all present and correct:
+    set msg [TestSequence $someResults $n $msg $badTrans]
+
+    # Check that requests are pipelined:
+    set msg [TestPipeline $someResults $n B C $msg Requests $notPiped]
+
+    # Check that responses are pipelined:
+    set msg [TestPipeline $someResults $n D F $msg Responses $notPiped]
+
+    if {$skipOverlaps} {
+	set cleanE {}
+	set dirtyE {}
+	set cleanF {}
+	set dirtyF {}
+    } else {
+	Puts "Overlaps including response body (test for non-pipelined case)"
+	lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF
+
+	Puts "Overlaps without response body (test for pipelined case)"
+	lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE
+    }
+
+    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+}
+
+# httpTest::ProcessRetries --
+#
+# Command to examine results for socket-changing records [PQR],
+# divide the results into segments for each connection, and analyse each segment
+# individually.
+# (Could add $sock to the logging to simplify this, but never mind.)
+#
+# In each segment, identify any transactions that are not included, and
+# any that are aborted, to assist subsequent testing.
+#
+# Prepend A records (socket-independent) to each segment for transactions that
+# were scheduled (by A) but not completed (by F).  Pass each segment to
+# MostAnalysis for processing.
+
+proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} {
+    variable testOptions
+
+    set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}]
+    if {$nextRetry == -1} {
+        return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped]
+    }
+    set badTrans $notIncluded
+    set tryCount 0
+    set try $nextRetry
+    incr tryCount
+    lassign [lindex $someResults $try] letter number
+    Puts "Processing retry [lindex $someResults $try]"
+    set beforeTry [lrange $someResults 0 $try-1]
+    Puts [join $beforeTry \n]
+    set afterTry [lrange $someResults $try+1 end]
+
+    set dummyTry   {}
+    for {set i 1} {$i <= $n} {incr i} {
+        set first [lsearch -exact $beforeTry [list A $i]]
+        set last  [lsearch -exact $beforeTry [list F $i]]
+        if {$first == -1} {
+	    set res "Transaction $i was not started in connection number $tryCount"
+	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
+	    # append msg $res \n
+	    Puts $res
+	    if {$i ni $badTrans} {
+		lappend badTrans $i
+	    } else {
+	    }
+        } elseif {$last == -1} {
+	    set res "Transaction $i was started but unfinished in connection number $tryCount"
+	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
+	    # append msg $res \n
+	    Puts $res
+	    lappend badTrans $i
+	    lappend dummyTry [list A $i]
+        } else {
+	    set res "Transaction $i was started and finished in connection number $tryCount"
+	    # So include it in the call below of MostAnalysis.
+	    # So lappend it to notIncluded and don't include it in the recursive call of
+	    # ProcessRetries which handles the later connections.
+	    # append msg $res \n
+	    Puts $res
+	    lappend notIncluded $i
+        }
+    }
+
+    # Analyse the part of the results before the first replay:
+    set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped]
+    lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1
+
+    # Pass the rest of the results to be processed recursively.
+    set afterTry [concat $dummyTry $afterTry]
+    set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped]
+    lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2
+
+    set cleanE [concat $cleanE1 $cleanE2]
+    set cleanF [concat $cleanF1 $cleanF2]
+    set dirtyE [concat $dirtyE1 $dirtyE2]
+    set dirtyF [concat $dirtyF1 $dirtyF2]
+    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+}
+
+# httpTest::logAnalyse --
+#
+#	The main command called to analyse logs for a single test.
+#
+# Arguments:
+# n            - (positive integer) the number of HTTP requests
+# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
+# notIncluded  - list of transaction numbers not to be assessed as "clean" or
+#                "dirty" by their overlaps
+# notPiped     - subset of notIncluded.  List of transaction numbers that cannot
+#                taint another transaction by overlapping with it, because it
+#                used a different socket.
+#
+# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+# msg    - warning messages: {} if there is no error with the test.
+# cleanE - list of transactions that have no overlap with other transactions
+#          (not considering response body)
+# dirtyE - list of transactions that have YES overlap with other transactions
+#          (not considering response body)
+# cleanF - list of transactions that have no overlap with other transactions
+#          (including response body)
+# dirtyF - list of transactions that have YES overlap with other transactions
+#          (including response body)
+
+proc httpTest::logAnalyse {n skipOverlaps notIncluded notPiped} {
+    variable testResults
+    variable testOptions
+
+    # Check that each data item has the correct form {letter numeral}.
+    set ii 0
+    set ok 1
+    foreach pair $testResults {
+	lassign $pair letter number
+	if {    [string match {[A-Z]} $letter]
+	     && [string match {[0-9]} $number]
+	} {
+	    # OK
+	} else {
+	    set ok 0
+	    set res "Error: testResults has bad element {$pair} at position $ii"
+	    append msg $res \n
+	    Puts $res
+	}
+	incr ii
+    }
+
+    if {!$ok} {
+	return $msg
+    }
+    set msg {}
+
+    Puts [join $testResults \n]
+    ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped
+    # N.B. Implicit Return.
+}
+
+proc httpTest::cleanupHttpTest {} {
+    variable testResults
+    set testResults {}
+    return
+}
+
+proc httpTest::setHttpTestOptions {key args} {
+    variable testOptions
+    if {$key ni {-dotted -verbose}} {
+        return -code error {valid options are -dotted, -verbose}
+    }
+    set testOptions($key) {*}$args
+}
+
+namespace eval httpTest {
+    namespace export cleanupHttpTest logAnalyse setHttpTestOptions
+}
diff --git a/tests/httpTestScript.tcl b/tests/httpTestScript.tcl
new file mode 100644
index 0000000..a8ef9c8
--- /dev/null
+++ b/tests/httpTestScript.tcl
@@ -0,0 +1,509 @@
+# httpTestScript.tcl
+#
+#	Test HTTP/1.1 concurrent requests including
+#	queueing, pipelining and retries.
+#
+# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ------------------------------------------------------------------------------
+# "Package" httpTestScript for executing test scripts written in a convenient
+# shorthand.
+# ------------------------------------------------------------------------------
+
+# ------------------------------------------------------------------------------
+# Documentation for "package" httpTestScript.
+# ------------------------------------------------------------------------------
+# To use the package:
+# (a) define URLs as the values of elements in the array ::httpTestScript
+# (b) define a script in terms of the commands
+#         START STOP DELAY KEEPALIVE WAIT PIPELINE GET HEAD POST
+#     referring to URLs by the name of the corresponding array element.  The
+#     script can include any other Tcl commands, and evaluates in the
+#     httpTestScript namespace.
+# (c) Use the command httpTestScript::runHttpTestScript to evaluate the script.
+# (d) For tcltest tests, wrap the runHttpTestScript call in a suitable "test"
+#     command.
+# ------------------------------------------------------------------------------
+# START
+# Must be the first command of the script.
+#
+# STOP
+# Must be present in the script to avoid waiting for client timeout.
+# Usually the last command, but can be elsewhere to end a script prematurely.
+# Subsequent httpTestScript commands will have no effect.
+#
+# DELAY ms
+# If there are no WAIT commands, this sets the delay in ms between subsequent
+# calls to http::geturl.  Default 500ms.
+#
+# KEEPALIVE
+# Set the value passed to http::geturl for the -keepalive option.  The command
+# applies to subsequent requests in the script. Default 1.
+#
+# WAIT ms
+# Pause for a time in ms before sending subsequent requests.
+#
+# PIPELINE boolean
+# Set the value of -pipeline using http::config.  The last PIPELINE command
+# in the script applies to every request. Default 1.
+#
+# POSTFRESH boolean
+# Set the value of -postfresh using http::config.  The last POSTFRESH command
+# in the script applies to every request. Default 0.
+#
+# REPOST boolean
+# Set the value of -repost using http::config.  The last REPOST command
+# in the script applies to every request. Default 1 for httpTestScript.
+# (Default value in http is 0).
+#
+# GET uriCode ?arg ...?
+# Send a HTTP request using the GET method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will be joined by "&" and appended to the query
+#           string with a preceding "&".
+#
+# HEAD uriCode ?arg ...?
+# Send a HTTP request using the HEAD method.
+# Arguments: as for GET
+#
+# POST uriCode ?arg ...?
+# Send a HTTP request using the POST method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will be joined by "&" and used as the request body.
+# ------------------------------------------------------------------------------
+
+namespace eval ::httpTestScript {
+    namespace export runHttpTestScript cleanupHttpTestScript
+}
+
+# httpTestScript::START --
+# Initialise, and create a long-stop timeout.
+
+proc httpTestScript::START {} {
+    variable CountRequestedSoFar
+    variable RequestsWhenStopped
+    variable KeepAlive
+    variable Delay
+    variable TimeOutCode
+    variable TimeOutDone
+    variable StartDone
+    variable StopDone
+    variable CountFinishedSoFar
+    variable RequestList
+    variable RequestsMade
+    variable ExtraTime
+    variable ActualKeepAlive
+
+    if {[info exists StartDone] && ($StartDone == 1)} {
+        set msg {START has been called twice without an intervening STOP}
+        return -code error $msg
+    }
+
+    set StartDone 1
+    set StopDone 0
+    set TimeOutDone 0
+    set CountFinishedSoFar 0
+    set CountRequestedSoFar 0
+    set RequestList {}
+    set RequestsMade {}
+    set ExtraTime 0
+    set ActualKeepAlive 1
+
+    # Undefined until a STOP command:
+    unset -nocomplain RequestsWhenStopped
+
+    # Default values:
+    set KeepAlive 1
+    set Delay 500
+
+    # Default values for tests:
+    KEEPALIVE 1
+    PIPELINE  1
+    POSTFRESH 0
+    REPOST    1
+
+    set TimeOutCode [after 30000 httpTestScript::TimeOutNow]
+#    set TimeOutCode [after 4000 httpTestScript::TimeOutNow]
+    return
+}
+
+# httpTestScript::STOP --
+# Do not process any more commands.  The commands will be executed but will
+# silently do nothing.
+
+proc httpTestScript::STOP {} {
+    variable CountRequestedSoFar
+    variable CountFinishedSoFar
+    variable RequestsWhenStopped
+    variable TimeOutCode
+    variable StartDone
+    variable StopDone
+    variable RequestsMade
+
+    if {$StopDone} {
+        # Don't do anything on a second call.
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    set StopDone 1
+    set StartDone 0
+    set RequestsWhenStopped $CountRequestedSoFar
+    unset -nocomplain StartDone
+
+    if {$CountFinishedSoFar == $RequestsWhenStopped} {
+        if {[info exists TimeOutCode]} {
+            after cancel $TimeOutCode
+        }
+        set ::httpTestScript::FOREVER 0
+    }
+    return
+}
+
+# httpTestScript::DELAY --
+# If there are no WAIT commands, this sets the delay in ms between subsequent
+# calls to http::geturl.  Default 500ms.
+
+proc httpTestScript::DELAY {t} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    variable Delay
+
+    set Delay $t
+    return
+}
+
+# httpTestScript::KEEPALIVE --
+# Set the value passed to http::geturl for the -keepalive option.  Default 1.
+
+proc httpTestScript::KEEPALIVE {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    variable KeepAlive
+    set KeepAlive $b
+    return
+}
+
+# httpTestScript::WAIT --
+# Pause for a time in ms before processing any more commands.
+
+proc httpTestScript::WAIT {t} {
+    variable StartDone
+    variable StopDone
+    variable ExtraTime
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    if {(![string is integer -strict $t]) || $t < 0} {
+        return -code error {argument to WAIT must be a non-negative integer}
+    }
+
+    incr ExtraTime $t
+
+    return
+}
+
+# httpTestScript::PIPELINE --
+# Pass a value to http::config -pipeline.
+
+proc httpTestScript::PIPELINE {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    ::http::config -pipeline $b
+    ##::http::Log http(-pipeline) is now [::http::config -pipeline]
+    return
+}
+
+# httpTestScript::POSTFRESH --
+# Pass a value to http::config -postfresh.
+
+proc httpTestScript::POSTFRESH {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    ::http::config -postfresh $b
+    ##::http::Log http(-postfresh) is now [::http::config -postfresh]
+    return
+}
+
+# httpTestScript::REPOST --
+# Pass a value to http::config -repost.
+
+proc httpTestScript::REPOST {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    ::http::config -repost $b
+    ##::http::Log http(-repost) is now [::http::config -repost]
+    return
+}
+
+# httpTestScript::GET --
+# Send a HTTP request using the GET method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will each be preceded by "&" and appended to the query
+#           string.
+
+proc httpTestScript::GET {uriCode args} {
+    variable RequestList
+    lappend RequestList GET
+    RequestAfter $uriCode 0 {} {*}$args
+    return
+}
+
+# httpTestScript::HEAD --
+# Send a HTTP request using the HEAD method.
+# Arguments: as for GET
+
+proc httpTestScript::HEAD {uriCode args} {
+    variable RequestList
+    lappend RequestList HEAD
+    RequestAfter $uriCode 1 {} {*}$args
+    return
+}
+
+# httpTestScript::POST --
+# Send a HTTP request using the POST method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will be joined by "&" and used as the request body.
+
+proc httpTestScript::POST {uriCode args} {
+    variable RequestList
+    lappend RequestList POST
+    RequestAfter $uriCode 0 {use} {*}$args
+    return
+}
+
+
+proc httpTestScript::RequestAfter {uriCode validate query args} {
+    variable CountRequestedSoFar
+    variable Delay
+    variable ExtraTime
+    variable StartDone
+    variable StopDone
+    variable KeepAlive
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    incr CountRequestedSoFar
+    set idelay [expr {($CountRequestedSoFar - 1) * $Delay + 10 + $ExtraTime}]
+
+    # Could pass values of -pipeline, -postfresh, -repost if it were
+    # useful to change these mid-script.
+    after $idelay [list httpTestScript::Requester $uriCode $KeepAlive $validate $query {*}$args]
+    return
+}
+
+proc httpTestScript::Requester {uriCode keepAlive validate query args} {
+    variable URL
+
+    ::http::config -accept {*/*}
+
+    set absUrl $URL($uriCode)
+    if {$query eq {}} {
+	if {$args ne {}} {
+	    append absUrl & [join $args &]
+	}
+	set queryArgs {}
+    } elseif {$validate} {
+        return -code error {cannot have both -validate (HEAD) and -query (POST)}
+    } else {
+	set queryArgs [list -query [join $args &]]
+    }
+
+    if {[catch {
+        ::http::geturl     $absUrl        \
+                -validate  $validate      \
+                -timeout   10000          \
+                {*}$queryArgs             \
+                -keepalive $keepAlive     \
+                -command   ::httpTestScript::WhenFinished
+    } token]} {
+        set msg $token
+        catch {puts stdout "Error: $msg"}
+        return
+    } else {
+        # Request will begin.
+    }
+
+    return
+
+}
+
+proc httpTestScript::TimeOutNow {} {
+    variable TimeOutDone
+
+    set TimeOutDone 1
+    set ::httpTestScript::FOREVER 0
+    return
+}
+
+proc httpTestScript::WhenFinished {hToken} {
+    variable CountFinishedSoFar
+    variable RequestsWhenStopped
+    variable TimeOutCode
+    variable StopDone
+    variable RequestList
+    variable RequestsMade
+    variable ActualKeepAlive
+
+    upvar #0 $hToken state
+
+    if {[catch {
+	if {    [info exists state(transfer)]
+	     && ($state(transfer) eq "chunked")
+	} {
+	    set Trans chunked
+	} else {
+	    set Trans unchunked
+	}
+
+	if {    [info exists ::httpTest::testOptions(-verbose)]
+	     && ($::httpTest::testOptions(-verbose) > 0)
+	} {
+	    puts "Token    $hToken
+Response $state(http)
+Status   $state(status)
+Method   $state(method)
+Transfer $Trans
+Size     $state(currentsize)
+URL      $state(url)
+"
+	}
+
+	if {!$state(-keepalive)} {
+	    set ActualKeepAlive 0
+	}
+
+	if {[info exists state(method)]} {
+	    lappend RequestsMade $state(method)
+	} else {
+	    lappend RequestsMade UNKNOWN
+	}
+	set tk [namespace tail $hToken]
+
+	if {    ($state(http) != {HTTP/1.1 200 OK})
+	     || ($state(status) != {ok})
+	     || (($state(currentsize) == 0) && ($state(method) ne "HEAD"))
+	} {
+	    ::http::Log ^X$tk unexpected result Response $state(http) Status $state(status) Size $state(currentsize) - token $hToken
+	}
+    } err]} {
+	::http::Log ^X$tk httpTestScript::WhenFinished failed with error status: $err - token $hToken
+    }
+
+    incr CountFinishedSoFar
+    if {$StopDone && ($CountFinishedSoFar == $RequestsWhenStopped)} {
+        if {[info exists TimeOutCode]} {
+            after cancel $TimeOutCode
+        }
+        if {$RequestsMade ne $RequestList && $ActualKeepAlive} {
+	    ::http::Log ^X$tk unexpected result - Script asked for "{$RequestList}" but got "{$RequestsMade}" - token $hToken
+        }
+        set ::httpTestScript::FOREVER 0
+    }
+
+    return
+}
+
+
+proc httpTestScript::runHttpTestScript {scr} {
+    variable TimeOutDone
+    variable RequestsWhenStopped
+
+    after idle [list namespace eval ::httpTestScript $scr]
+    vwait ::httpTestScript::FOREVER
+    # N.B. does not automatically execute in this namespace, unlike some other events.
+    # Release when all requests have been served or have timed out.
+
+    if {$TimeOutDone} {
+        return -code error {test script timed out}
+    }
+
+    return $RequestsWhenStopped
+}
+
+
+proc httpTestScript::cleanupHttpTestScript {} {
+    variable TimeOutDone
+    variable RequestsWhenStopped
+    
+    if {![info exists RequestsWhenStopped]} {
+	return -code error {Cleanup Failed: RequestsWhenStopped is undefined}
+    }
+
+    for {set i 1} {$i <= $RequestsWhenStopped} {incr i} {
+        http::cleanup ::http::$i
+    }
+
+    return
+}
diff --git a/tests/platform.test b/tests/platform.test
index 5880fb9..53d534e 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -10,7 +10,6 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 package require tcltest 2
-package require tcltests
 
 namespace eval ::tcl::test::platform {
     namespace import ::tcltest::testConstraint
@@ -23,6 +22,7 @@ namespace eval ::tcl::test::platform {
 
 ::tcltest::loadTestedCommands
 catch [list package require -exact Tcltest [info patchlevel]]
+package require tcltests
 
 testConstraint testCPUID [llength [info commands testcpuid]]
 testConstraint testlongsize [llength [info commands testlongsize]]
diff --git a/tests/thread.test b/tests/thread.test
index eaaaa41..2524911 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -11,14 +11,17 @@
 # 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
+    namespace import -force ::tcltest::*
+}
 
 #  when thread::release is used, -wait is passed in order allow the thread to
 #  be fully finalized, which avoids valgrind "still reachable" reports.
 
-package require tcltests
-
 ::tcltest::loadTestedCommands
 catch [list package require -exact Tcltest [info patchlevel]]
+package require tcltests
 
 # Some tests require the testthread command
 
diff --git a/tests/zipfs.test b/tests/zipfs.test
new file mode 100644
index 0000000..1a5225c
--- /dev/null
+++ b/tests/zipfs.test
@@ -0,0 +1,283 @@
+# The file tests the tclZlib.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
+#
+# Copyright (c) 1996-1998 by 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 {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::*
+}
+
+testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]}]
+
+# Removed in tip430 - zipfs is no longer a static package
+#test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
+#    load {} zipfs
+#} -result {}
+
+set ziproot [zipfs root]
+set CWD [pwd]
+set tmpdir  [file join $CWD tmp]
+file mkdir $tmpdir
+
+test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
+    package require zipfs
+} -result {2.0}
+
+test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
+    expr {${ziproot} in [file volumes]}
+} -result 1
+
+if {![string match ${ziproot}* $tcl_library]} {
+    ###
+    # "make test" does not map tcl_library from the dynamic library on Unix
+    #
+    # Hack the environment to pretend we did pull tcl_library from a zip
+    # archive
+    ###
+    set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]]
+    if {[file exists $tclzip]} {
+        zipfs mount /lib/tcl $tclzip
+        set ::tcl_library ${ziproot}lib/tcl/tcl_library
+    } else {
+        tcltest::skip zipfs-0.*
+    }
+}
+
+test zipfs-0.2 {zipfs basics} -constraints zipfs -body {
+    string match ${ziproot}* $tcl_library
+} -result 1
+
+test zipfs-0.3 {zipfs basics: glob} -constraints zipfs -body {
+    set pwd [pwd]
+    cd $tcl_library
+    lsort [glob -dir . http*]
+} -cleanup {
+    cd $pwd
+} -result {./http}
+
+test zipfs-0.4 {zipfs basics: glob} -constraints zipfs -body {
+    set pwd [pwd]
+    cd $tcl_library
+    lsort [glob -dir [pwd] http*]
+} -cleanup {
+    cd $pwd
+} -result [list $tcl_library/http]
+
+test zipfs-0.5 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob -dir $tcl_library http*]
+} -result [list $tcl_library/http]
+
+test zipfs-0.6 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob $tcl_library/http*]
+} -result [list $tcl_library/http]
+
+test zipfs-0.7 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob -tails -dir $tcl_library http*]
+} -result {http}
+
+test zipfs-0.8 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob -nocomplain -tails -types d -dir $tcl_library http*]
+} -result {http}
+
+test zipfs-0.9 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob -nocomplain -tails -types f -dir $tcl_library http*]
+} -result {}
+
+test zipfs-0.10 {zipfs basics: join} -constraints zipfs -body {
+    file join [zipfs root] bar baz
+} -result "[zipfs root]bar/baz"
+
+test zipfs-0.11 {zipfs basics: join} -constraints zipfs -body {
+    file normalize [zipfs root]
+} -result "[zipfs root]"
+
+test zipfs-0.12 {zipfs basics: join} -constraints zipfs -body {
+    file normalize [zipfs root]//bar/baz//qux/../
+} -result "[zipfs root]bar/baz"
+
+test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs mount a b c d e f
+} -result {wrong # args: should be "zipfs mount ?mountpoint? ?zipfile? ?password?"}
+
+test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs unmount a b c d e f
+} -result {wrong # args: should be "zipfs unmount zipfile"}
+
+test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs mkkey a b c d e f
+} -result {wrong # args: should be "zipfs mkkey password"}
+
+test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs mkimg a b c d e f
+} -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"}
+
+test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs mkzip a b c d e f
+} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
+
+test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs exists a b c d e f
+} -result {wrong # args: should be "zipfs exists filename"}
+
+test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs info a b c d e f
+} -result {wrong # args: should be "zipfs info filename"}
+
+test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs list a b c d e f
+} -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"}
+
+file mkdir tmp
+
+test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body {
+    zipfs mkzip [file join $tmpdir empty.zip] $tcl_library/xxxx
+} -result {empty archive}
+
+###
+# The 2.2 series of tests operate within
+# a zipfile created a temporary directory
+###
+set zipfile [file join $tmpdir abc.zip]
+if {[file exists $zipfile]} {
+   file delete $zipfile
+}
+
+test zipfs-2.2.0 {zipfs mkzip} -constraints zipfs -body {
+    cd $tcl_library/encoding
+    zipfs mkzip $zipfile .
+    zipfs mount ${ziproot}abc $zipfile
+    zipfs list -glob ${ziproot}abc/cp850.*
+} -cleanup {
+    cd $CWD
+} -result "[zipfs root]abc/cp850.enc"
+
+if {![zipfs exists /abc/cp850.enc]} {
+   skip [concat [skip] zipfs-2.2.*]
+}
+
+test zipfs-2.2.1 {zipfs info} -constraints zipfs -body {
+    set r [zipfs info ${ziproot}abc/cp850.enc]
+    lrange $r 0 2
+} -result [list $zipfile 1090 527] ;# NOTE: Only the first 3 results are stable
+
+test zipfs-2.2.3 {zipfs data} -constraints zipfs -body {
+    set zipfd [open ${ziproot}/abc/cp850.enc]	;# FIXME: leave open - see later test
+    read $zipfd
+} -result {# Encoding file: cp850, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
+00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
+2591259225932502252400C100C200C000A9256325512557255D00A200A52510
+25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
+00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
+00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
+00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
+} ;# FIXME: result depends on content of encodings dir
+
+test zipfs-2.2.4 {zipfs exists} -constraints zipfs -body {
+    zipfs exists /abc/cp850.enc
+} -result 1
+
+test zipfs-2.2.5 {zipfs unmount while busy} -constraints zipfs -body {
+    zipfs unmount /abc
+} -returnCodes error -result {filesystem is busy}
+
+test zipfs-2.2.6 {zipfs unmount} -constraints zipfs -body {
+    close $zipfd
+    zipfs unmount /abc
+    zipfs exists /abc/cp850.enc
+} -result 0
+
+
+###
+# Repeat the tests for a buffer mounted archive
+###
+test zipfs-2.3.0 {zipfs mkzip} -constraints zipfs -body {
+   cd $tcl_library/encoding
+   zipfs mkzip $zipfile .
+   set fin [open $zipfile r]
+   fconfigure $fin -translation binary
+   set dat [read $fin]
+   close $fin
+   zipfs mount_data def $dat
+    zipfs list -glob ${ziproot}def/cp850.*
+} -cleanup {
+    cd $CWD
+} -result "[zipfs root]def/cp850.enc"
+
+if {![zipfs exists /def/cp850.enc]} {
+   skip [concat [skip] zipfs-2.3.*]
+}
+
+test zipfs-2.3.1 {zipfs info} -constraints zipfs -body {
+    set r [zipfs info ${ziproot}def/cp850.enc]
+    lrange $r 0 2
+} -result [list {Memory Buffer} 1090 527] ;# NOTE: Only the first 3 results are stable
+
+test zipfs-2.3.3 {zipfs data} -constraints zipfs -body {
+    set zipfd [open ${ziproot}/def/cp850.enc]	;# FIXME: leave open - see later test
+    read $zipfd
+} -result {# Encoding file: cp850, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
+00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
+2591259225932502252400C100C200C000A9256325512557255D00A200A52510
+25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
+00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
+00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
+00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
+} ;# FIXME: result depends on content of encodings dir
+
+test zipfs-2.3.4 {zipfs exists} -constraints zipfs -body {
+    zipfs exists /def/cp850.enc
+} -result 1
+
+test zipfs-2.3.5 {zipfs unmount while busy} -constraints zipfs -body {
+    zipfs unmount /def
+} -returnCodes error -result {filesystem is busy}
+
+test zipfs-2.3.6 {zipfs unmount} -constraints zipfs -body {
+    close $zipfd
+    zipfs unmount /def
+    zipfs exists /def/cp850.enc
+} -result 0
+
+catch {file delete -force $tmpdir}
+
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End: