Merge 9.0

10 files changed, 81 insertions, 48 deletions

diff --git a/doc/Encoding.3 b/doc/Encoding.3
index 52e7852..f37452d 100644
--- a/doc/Encoding.3
+++ b/doc/Encoding.3
@@ -103,7 +103,9 @@ byte is converted and then to reset to an initial state.
 not return immediately upon reading a source character that does not exist in
 the target encoding, but it will substitute a default fallback character for
 all of such characters. The flag \fBTCL_ENCODING_STOPONERROR\fR has no effect,
-it only has meaning in Tcl 8.x. The flag \fBTCL_ENCODING_MODIFIED\fR makes
+it only has meaning in Tcl 8.x. The flag \fBTCL_ENCODING_STRICT\fR makes the
+encoder/decoder more strict in what it considers to be an invalid byte
+sequence. The flag \fBTCL_ENCODING_MODIFIED\fR makes
 \fBTcl_UtfToExternalDStringEx\fR and \fBTcl_UtfToExternal\fR produce the byte
 sequence \exC0\ex80 in stead of \ex00, for the utf-8/cesu-8 encoders.
 .AP Tcl_EncodingState *statePtr in/out
diff --git a/doc/TraceVar.3 b/doc/TraceVar.3
index a182f14..90c90b9 100644
--- a/doc/TraceVar.3
+++ b/doc/TraceVar.3
@@ -137,9 +137,11 @@ trace was created.
 \fIclientData\fR typically points to an application-specific
 data structure that describes what to do when \fIproc\fR
 is invoked.
-\fIName1\fR and \fIname2\fR give the name of the traced variable
-in the normal two-part form (see the description of \fBTcl_TraceVar2\fR
-below for details).
+\fIName1\fR and \fIname2\fR give the name of the variable that
+triggered the callback in the normal two-part form (see the description
+of \fBTcl_TraceVar2\fR below for details).  In case \fIname1\fR is an
+alias to an array element (created through facilities such as \fBupvar\fR),
+\fIname2\fR holds the index of the array element, rather than NULL.
 \fIFlags\fR is an OR-ed combination of bits providing several
 pieces of information.
 One of the bits \fBTCL_TRACE_READS\fR, \fBTCL_TRACE_WRITES\fR,
diff --git a/doc/http.n b/doc/http.n
index c08d221..59f15b6 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -613,13 +613,11 @@ The "request line" is the first line of a HTTP client request, and has three
 elements separated by spaces: the HTTP method, the URL relative to the server,
 and the HTTP version. Examples:
 .PP
-.DS
 .RS
 GET / HTTP/1.1
 GET /introduction.html?subject=plumbing HTTP/1.1
 POST /forms/order.html HTTP/1.1
 .RE
-.DE
 .TP
 \fB::http::requestHeaders\fR \fItoken\fR ?\fIheaderName\fR?
 .
@@ -650,12 +648,10 @@ elements separated by spaces: the HTTP version, a three-digit numerical
 "status code", and a "reason phrase".  Only the reason phrase may contain
 spaces.  Examples:
 .PP
-.DS
 .RS
 HTTP/1.1 200 OK
 HTTP/1.0 404 Not Found
 .RE
-.DE
 .RS
 The "status code" is a three-digit number in the range 100 to 599.
 A value of 200 is the normal return from a GET request, and its matching
@@ -1589,7 +1585,7 @@ that \fB::tls::socketCmd\fR has this value, it replaces it with the value
 i.e. if the script or the Tcl installation has replaced the value "::socket"
 with the name of a different command, then http does not change the value.
 The script or installation that modified \fB::tls::socketCmd\fR is responsible
-for integrating \fR::http::socket\fR into its own replacement command.
+for integrating \fB::http::socket\fR into its own replacement command.
 .PP
 .SS "WITH A CHILD INTERPRETER"
 .PP
diff --git a/doc/vwait.n b/doc/vwait.n
index 5f240d6..e595a74 100644
--- a/doc/vwait.n
+++ b/doc/vwait.n
@@ -12,8 +12,8 @@
 vwait \- Process events until a variable is written
 .SH SYNOPSIS
 \fBvwait\fR \fIvarName\fR
-.PP
-\fBvwait\fR ?\Ioptions\fR? ?\fIvarName ...\fR?
+.sp
+\fBvwait\fR ?\fIoptions\fR? ?\fIvarName ...\fR?
 .BE
 .SH DESCRIPTION
 .PP
@@ -66,7 +66,7 @@ Events of the windowing system are not handled during the wait operation.
 \fIChannel\fR must name a Tcl channel open for reading. If \fIchannel\fR
 is or becomes readable the wait operation completes.
 .TP
-\fB\-timeout\fR milliseconds\fR
+\fB\-timeout\fR \fImilliseconds\fR
 .
 The wait operation is constrained to \fImilliseconds\fR.
 .TP
diff --git a/generic/tcl.h b/generic/tcl.h
index f1d27ef..b87f361 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1895,6 +1895,8 @@ typedef struct Tcl_EncodingType {
  *				reset to an initial state. If the source
  *				buffer contains the entire input stream to be
  *				converted, this flag should be set.
+ * TCL_ENCODING_STRICT -	Be more strict in accepting what
+ *				is considered a 'invalid byte sequence'.
  * TCL_ENCODING_STOPONERROR -	Not used any more.
  * TCL_ENCODING_NO_TERMINATE - 	If set, Tcl_ExternalToUtf does not append a
  *				terminating NUL byte.  Since it does not need
@@ -1926,12 +1928,12 @@ typedef struct Tcl_EncodingType {
 
 #define TCL_ENCODING_START		0x01
 #define TCL_ENCODING_END		0x02
+#define TCL_ENCODING_STRICT			0x04
 #define TCL_ENCODING_STOPONERROR	0x0 /* Not used any more */
 #define TCL_ENCODING_NO_TERMINATE	0x08
 #define TCL_ENCODING_CHAR_LIMIT		0x10
 #define TCL_ENCODING_MODIFIED		0x20
 #define TCL_ENCODING_NOCOMPLAIN		0x40
-#define TCL_ENCODING_STRICT			0x44
 
 /*
  * The following definitions are the error codes returned by the conversion
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 7e7c1a6..66da441 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -2228,7 +2228,7 @@ BinaryProc(
  *-------------------------------------------------------------------------
  */
 
-#define STOPONERROR ((flags & TCL_ENCODING_STRICT) != TCL_ENCODING_NOCOMPLAIN)
+#define STOPONERROR (!(flags & TCL_ENCODING_NOCOMPLAIN))
 
 static int
 UtfToUtfProc(
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 8d54045..aabbbd8 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4361,14 +4361,16 @@ Write(
     }
 
     /*
-     * Transfer encoding strict/nocomplain option to the encoding flags
+     * Transfer encoding nocomplain/strict option to the encoding flags
      */
 
+    if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
+	statePtr->outputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
+    } else {
+	statePtr->outputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN;
+    }
     if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) {
 	statePtr->outputEncodingFlags |= TCL_ENCODING_STRICT;
-    } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
-	statePtr->outputEncodingFlags &= ~TCL_ENCODING_STRICT;
-	statePtr->outputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
     } else {
 	statePtr->outputEncodingFlags &= ~TCL_ENCODING_STRICT;
     }
@@ -4694,11 +4696,13 @@ Tcl_GetsObj(
      * Transfer encoding nocomplain/strict option to the encoding flags
      */
 
+    if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
+	statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
+    } else {
+	statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN;
+    }
     if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) {
 	statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT;
-    } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
-	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
-	statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
     } else {
 	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
     }
@@ -5465,11 +5469,13 @@ FilterInputBytes(
      * Transfer encoding nocomplain/strict option to the encoding flags
      */
 
+    if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
+	statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
+    } else {
+	statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN;
+    }
     if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) {
 	statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT;
-    } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
-	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
-	statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
     } else {
 	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
     }
@@ -6251,11 +6257,13 @@ ReadChars(
      * Transfer encoding nocomplain/strict option to the encoding flags
      */
 
+    if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
+	statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
+    } else {
+	statePtr->inputEncodingFlags &= ~TCL_ENCODING_NOCOMPLAIN;
+    }
     if (GotFlag(statePtr, CHANNEL_ENCODING_STRICT)) {
 	statePtr->inputEncodingFlags |= TCL_ENCODING_STRICT;
-    } else if (GotFlag(statePtr, CHANNEL_ENCODING_NOCOMPLAIN)) {
-	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
-	statePtr->inputEncodingFlags |= TCL_ENCODING_NOCOMPLAIN;
     } else {
 	statePtr->inputEncodingFlags &= ~TCL_ENCODING_STRICT;
     }
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 326aede..88685ec 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -1260,6 +1260,7 @@ proc http::CreateToken {url args} {
 			   [GetFieldValue $state(-headers) Upgrade]]
     set state(upgradeRequest) [expr {    "upgrade" in $connectionValues
 				      && [llength $upgradeValues] >= 1}]
+    set state(connectionValues) $connectionValues
 
     if {$isQuery || $isQueryChannel} {
 	# It's a POST.
@@ -2104,24 +2105,25 @@ proc http::Connected {token proto phost srvurl} {
 	if {($state(-protocol) > 1.0) && $state(-keepalive)} {
 	    # Send this header, because a 1.1 server is not compelled to treat
 	    # this as the default.
-	    SendHeader $token Connection keep-alive
-	}
-	if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
-	    SendHeader $token Connection close ;# RFC2616 sec 8.1.2.1
-	}
-	if {($state(-protocol) < 1.1)} {
+	    set ConnVal keep-alive
+	} elseif {($state(-protocol) > 1.0)} {
+	    # RFC2616 sec 8.1.2.1
+	    set ConnVal close
+	} else {
+	    # ($state(-protocol) <= 1.0)
 	    # RFC7230 A.1
 	    # Some server implementations of HTTP/1.0 have a faulty
 	    # implementation of RFC 2068 Keep-Alive.
 	    # Don't leave this to chance.
 	    # For HTTP/1.0 we have already "set state(connection) close"
 	    # and "state(-keepalive) 0".
-	    SendHeader $token Connection close
+	    set ConnVal close
 	}
 	# RFC7230 A.1 - "clients are encouraged not to send the
 	# Proxy-Connection header field in any requests"
 	set accept_encoding_seen 0
 	set content_type_seen 0
+	set connection_seen 0
 	foreach {key value} $state(-headers) {
 	    set value [string map [list \n "" \r ""] $value]
 	    set key [string map {" " -} [string trim $key]]
@@ -2141,6 +2143,24 @@ proc http::Connected {token proto phost srvurl} {
 		set contDone 1
 		set state(querylength) $value
 	    }
+	    if {[string equal -nocase $key "connection"]} {
+		# Remove "close" or "keep-alive" and use our own value.
+		# In an upgrade request, the upgrade is not guaranteed.
+		# Value "close" or "keep-alive" tells the server what to do
+		# if it refuses the upgrade.  We send a single "Connection"
+		# header because some websocket servers, e.g. civetweb, reject
+		# multiple headers. Bug [d01de3281f] of tcllib/websocket.
+		set connection_seen 1
+		set listVal $state(connectionValues)
+		if {[set pos [lsearch $listVal close]] != -1} {
+		    set listVal [lreplace $listVal $pos $pos]
+		}
+		if {[set pos [lsearch $listVal keep-alive]] != -1} {
+		    set listVal [lreplace $listVal $pos $pos]
+		}
+		lappend listVal $ConnVal
+		set value [join $listVal {, }]
+	    }
 	    if {[string length $key]} {
 		SendHeader $token $key $value
 	    }
@@ -2159,6 +2179,9 @@ proc http::Connected {token proto phost srvurl} {
 	    SendHeader $token Accept-Encoding identity
 	} else {
 	}
+	if {!$connection_seen} {
+	    SendHeader $token Connection $ConnVal
+	}
 	if {$isQueryChannel && ($state(querylength) == 0)} {
 	    # Try to determine size of data in channel. If we cannot seek, the
 	    # surrounding catch will trap us
diff --git a/tests/http.test b/tests/http.test
index c5aa2f5..11bf0f9 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -408,10 +408,10 @@ test http-3.27 {http::geturl: -headers override -type} -body {
     http::cleanup $token
 } -match regexp -result {(?n)Host .*
 User-Agent .*
-Connection close
 Content-Type {text/plain;charset=utf-8}
 Accept \*/\*
 Accept-Encoding .*
+Connection close
 Content-Length 5}
 test http-3.28 {http::geturl: -headers override -type default} -body {
     set token [http::geturl $url/headers -query dummy \
@@ -421,10 +421,10 @@ test http-3.28 {http::geturl: -headers override -type default} -body {
     http::cleanup $token
 } -match regexp -result {(?n)Host .*
 User-Agent .*
-Connection close
 Content-Type {text/plain;charset=utf-8}
 Accept \*/\*
 Accept-Encoding .*
+Connection close
 Content-Length 5}
 test http-3.29 {http::geturl IPv6 address} -body {
     # We only want to see if the URL gets parsed correctly. This is
@@ -461,9 +461,9 @@ test http-3.32 {http::geturl: -headers override -accept default} -body {
     http::cleanup $token
 } -match regexp -result {(?n)Host .*
 User-Agent .*
-Connection close
 Accept text/plain,application/tcl-test-value
 Accept-Encoding .*
+Connection close
 Content-Type application/x-www-form-urlencoded
 Content-Length 5}
 # Bug 838e99a76d
diff --git a/tests/io.test b/tests/io.test
index 4fd1a6b..3241625 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -9146,7 +9146,7 @@ test io-75.10 {incomplete shiftjis encoding read is ignored} -setup {
 
 
 
-test io-75.0 {channel modes} -setup {
+test io-76.0 {channel modes} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile r]
 } -constraints testchannel -body {
@@ -9156,7 +9156,7 @@ test io-75.0 {channel modes} -setup {
     removeFile dummy
 } -result {read {}}
 
-test io-75.1 {channel modes} -setup {
+test io-76.1 {channel modes} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile w]
 } -constraints testchannel -body {
@@ -9166,7 +9166,7 @@ test io-75.1 {channel modes} -setup {
     removeFile dummy
 } -result {{} write}
 
-test io-75.2 {channel modes} -setup {
+test io-76.2 {channel modes} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile r+]
 } -constraints testchannel -body {
@@ -9176,7 +9176,7 @@ test io-75.2 {channel modes} -setup {
     removeFile dummy
 } -result {read write}
 
-test io-75.3 {channel mode dropping} -setup {
+test io-76.3 {channel mode dropping} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile r]
 } -constraints testchannel -body {
@@ -9187,7 +9187,7 @@ test io-75.3 {channel mode dropping} -setup {
     removeFile dummy
 } -result {{read {}} {read {}}}
 
-test io-75.4 {channel mode dropping} -setup {
+test io-76.4 {channel mode dropping} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile r]
 } -constraints testchannel -body {
@@ -9197,7 +9197,7 @@ test io-75.4 {channel mode dropping} -setup {
     removeFile dummy
 } -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
 
-test io-75.5 {channel mode dropping} -setup {
+test io-76.5 {channel mode dropping} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile w]
 } -constraints testchannel -body {
@@ -9208,7 +9208,7 @@ test io-75.5 {channel mode dropping} -setup {
     removeFile dummy
 } -result {{{} write} {{} write}}
 
-test io-75.6 {channel mode dropping} -setup {
+test io-76.6 {channel mode dropping} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile w]
 } -constraints testchannel -body {
@@ -9218,7 +9218,7 @@ test io-75.6 {channel mode dropping} -setup {
     removeFile dummy
 } -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
 
-test io-75.7 {channel mode dropping} -setup {
+test io-76.7 {channel mode dropping} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile r+]
 } -constraints testchannel -body {
@@ -9229,7 +9229,7 @@ test io-75.7 {channel mode dropping} -setup {
     removeFile dummy
 } -result {{{} write} {read write}}
 
-test io-75.8 {channel mode dropping} -setup {
+test io-76.8 {channel mode dropping} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile r+]
 } -constraints testchannel -body {
@@ -9240,7 +9240,7 @@ test io-75.8 {channel mode dropping} -setup {
     removeFile dummy
 } -result {{read {}} {read write}}
 
-test io-75.9 {channel mode dropping} -setup {
+test io-76.9 {channel mode dropping} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile r+]
 } -constraints testchannel -body {
@@ -9251,7 +9251,7 @@ test io-75.9 {channel mode dropping} -setup {
     removeFile dummy
 } -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
 
-test io-75.10 {channel mode dropping} -setup {
+test io-76.10 {channel mode dropping} -setup {
     set datafile [makeFile {some characters} dummy]
     set f [open $datafile r+]
 } -constraints testchannel -body {