merge 8.6.4

11 files changed, 162 insertions, 7 deletions

diff --git a/tests/append.test b/tests/append.test
index 69c6381..8fa4e61 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -292,6 +292,23 @@ test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env
 } -cleanup {
     unset -nocomplain ::env(__DUMMY__)
 } -result {0 {new value}}
+
+test append-10.1 {Bug 214cc0eb22: lappend with no values} {
+    set lst "# 1 2 3"
+    [subst lappend] lst
+} "# 1 2 3"
+test append-10.2 {Bug 214cc0eb22: lappend with no values} -body {
+    set lst "1 \{ 2"
+    [subst lappend] lst
+} -returnCodes error -result {unmatched open brace in list}
+test append-10.3 {Bug 214cc0eb22: expanded lappend with no values} {
+    set lst "# 1 2 3"
+    [subst lappend] lst {*}[list]
+} "# 1 2 3"
+test append-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body {
+    set lst "1 \{ 2"
+    [subst lappend] lst {*}[list]
+} -returnCodes error -result {unmatched open brace in list}
 
 unset -nocomplain i x result y
 catch {rename foo ""}
diff --git a/tests/appendComp.test b/tests/appendComp.test
index f85c3ba..bbf5f9c 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -438,6 +438,27 @@ test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing
 } -cleanup {
     unset -nocomplain ::env(__DUMMY__)
 } -result {0 {new value}}
+
+test appendComp-10.1 {Bug 214cc0eb22: lappend with no values} {
+    apply {lst {
+	lappend lst
+    }} "# 1 2 3"
+} "# 1 2 3"
+test appendComp-10.2 {Bug 214cc0eb22: lappend with no values} -body {
+    apply {lst {
+	lappend lst
+    }} "1 \{ 2"
+} -returnCodes error -result {unmatched open brace in list}
+test appendComp-10.3 {Bug 214cc0eb22: expanded lappend with no values} {
+    apply {lst {
+	lappend lst {*}[list]
+    }} "# 1 2 3"
+} "# 1 2 3"
+test appendComp-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body {
+    apply {lst {
+	lappend lst {*}[list]
+    }} "1 \{ 2"
+} -returnCodes error -result {unmatched open brace in list}
 
 catch {unset i x result y}
 catch {rename foo ""}
diff --git a/tests/compile.test b/tests/compile.test
index 22ebc7d..d4a31d4 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -455,14 +455,22 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} {
     list [catch {exec [interpreter] << $script} msg] $msg
 } {0 OK}
 
-# Special test for compiling tokens from a copy of the source string. [Bug
-# 599788]
+# Tests compile-14.* for [Bug 599788] [Bug 0c043a175a47da8c2342]
 test compile-14.1 {testing errors in element name; segfault?} {} {
      catch {set a([error])} msg1
      catch {set bubba([join $abba $jubba]) $vol} msg2
      list $msg1 $msg2
 } {{wrong # args: should be "error message ?errorInfo? ?errorCode?"} {can't read "abba": no such variable}}
 
+test compile-14.2 {testing element name "$"} -body {
+    unset -nocomplain a
+    set a() 1
+    set a(1) 2 
+    set a($) 3
+    list [set a()] [set a(1)] [set a($)] [unset a() a(1); lindex [array names a] 0]
+} -cleanup {unset a} -result [list 1 2 3 {$}]
+
+
 # Tests compile-15.* cover Tcl Bug 633204
 test compile-15.1 {proper TCL_RETURN code from [return]} {
     apply {{} {catch return}}
diff --git a/tests/io.test b/tests/io.test
index b09d55a..06ae81d 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7900,6 +7900,44 @@ test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup {
     close $c
     removeFile out
 } -result 100
+test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup {
+    proc driver {cmd args} {
+        variable buffer
+        variable index
+        set chan [lindex $args 0]
+        switch -- $cmd {
+            initialize {
+                set index($chan) 0
+                set buffer($chan) [encoding convertto utf-8 \
+                        line\n[string repeat a 100]line\n]
+                return {initialize finalize watch read}
+            }
+            finalize {
+                unset index($chan) buffer($chan)
+                return
+            }
+            watch {}
+            read {
+                set n [lindex $args 1]
+                set new [expr {$index($chan) + $n}]
+                set result [string range $buffer($chan) $index($chan) $new-1]
+                set index($chan) $new
+                return $result
+            }
+        }
+    }
+    set c [chan create read [namespace which driver]]
+    chan configure $c -encoding utf-8 -translation lf -buffersize 107
+    set out [makeFile {} out]
+    set outChan [open $out w]
+    chan configure $outChan -encoding utf-8 -translation lf
+} -body {
+    list [gets $c] [chan copy $c $outChan -size 100] [gets $c]
+} -cleanup {
+    close $outChan
+    close $c
+    removeFile out
+} -result {line 100 line}
 
 test io-54.1 {Recursive channel events} {socket fileevent} {
     # This test checks to see if file events are delivered during recursive
@@ -8485,6 +8523,25 @@ test io-73.3 {[5adc350683] [gets] after EOF} -setup {
     removeFile io-73.3
 } -result {1 1 {more data} 0 {} 1}
 
+test io-73.4 {[5adc350683] [read] after EOF} -setup {
+    set fn [makeFile {} io-73.4]
+    set rfd [open $fn r]
+    set wfd [open $fn a]
+    chan configure $wfd -buffering line
+    read $rfd
+} -body {
+    set result [eof $rfd]
+    puts $wfd "more data"
+    lappend result [eof $rfd]
+    lappend result [read $rfd]
+    lappend result [eof $rfd]
+} -cleanup {
+    close $wfd
+    close $rfd
+    removeFile io-73.4
+} -result {1 1 {more data
+} 1}
+
 # ### ### ### ######### ######### #########
 
 # cleanup
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 57f8d47..4fbc380 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -294,7 +294,7 @@ test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOr
     close $srv
     unset cli srv port
     rename iocmdSRV {}
-} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}
+} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -connecting, -peername, or -sockname}
 test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
     set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $srv -sockname] 2]
diff --git a/tests/lreplace.test b/tests/lreplace.test
index b976788..d1319c6 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -137,6 +137,15 @@ test lreplace-4.1 {Bug ccc2c2cc98: lreplace edge case} {
 test lreplace-4.2 {Bug ccc2c2cc98: lreplace edge case} {
     lreplace { } 1 1
 } {}
+test lreplace-4.3 {lreplace edge case} {
+    lreplace {1 2 3} 2 0
+} {1 2 3}
+test lreplace-4.4 {lreplace edge case} {
+    lreplace {1 2 3 4 5} 3 1
+} {1 2 3 4 5}
+test lreplace-4.5 {lreplace edge case} {
+    lreplace {1 2 3 4 5} 3 0 _
+} {1 2 3 _ 4 5}
 
 # cleanup
 catch {unset foo}
diff --git a/tests/parse.test b/tests/parse.test
index 5d8afeb..d73c725 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -663,6 +663,9 @@ test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array refer
 test parse-12.25 {Tcl_ParseVarName procedure, nested array reference} testparser {
     testparser {$x(a$y(b$z))} 0
 } {- {$x(a$y(b$z))} 1 word {$x(a$y(b$z))} 8 variable {$x(a$y(b$z))} 7 text x 0 text a 0 variable {$y(b$z)} 4 text y 0 text b 0 variable {$z} 1 text z 0 {}}
+test parse-12.26 {Tcl_ParseVarName [d2ffcca163] non-ascii} testparser {
+    testparser "$\u0433" -1
+} "- {$\u0433} 1 word {$\u0433} 2 text {$} 0 text \u0433 0 {}"
 
 test parse-13.1 {Tcl_ParseVar procedure} testparsevar {
     set abc 24
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index 5c7986a..ef05454 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -1064,6 +1064,15 @@ test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body {
     dict get $o -errorcode
 } -result {TCL PARSE EXPR BADNUMBER BINARY}
 
+test parseExpr-22.19 {Bug d2ffcca163} -constraints testexprparser -body {
+    testexprparser \u0433 -1
+} -returnCodes error -match glob -result {*invalid character*}
+test parseExpr-22.20 {Bug d2ffcca163} -constraints testexprparser -body {
+    testexprparser \u043f -1
+} -returnCodes error -match glob -result {*invalid character*}
+test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body {
+    testexprparser in\u0433(0) -1
+} -returnCodes error -match glob -result {missing operand*}
 
 # cleanup
 cleanupTests
diff --git a/tests/socket.test b/tests/socket.test
index eeea044..4f90e51 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -2343,6 +2343,24 @@ test socket-14.17 {empty -sockname while [socket -async] connecting} \
         catch {close $client}
     } -result {}
 
+# test for bug c6ed4acfd8: running async socket connect with other connect
+# established will block tcl as it goes in an infinite loop in vwait
+test socket-14.18 {bug c6ed4acfd8: running async socket connect made other connect block} \
+    -constraints {socket} \
+    -body {
+        proc accept {channel address port} {}
+        set port [randport]
+        set ssock [socket -server accept $port]
+        set csock1 [socket -async localhost [randport]]
+        set csock2 [socket localhost $port]
+        after 1000 {set done ok}
+        vwait done
+} -cleanup {
+        catch {close $ssock}
+        catch {close $csock1}
+        catch {close $csock2}
+    } -result {}
+
 set num 0
 
 set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}}
diff --git a/tests/stringComp.test b/tests/stringComp.test
index f9f6bda..a66525e 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -720,6 +720,14 @@ test stringComp-14.2 {Bug 82e7f67325} memory {
 	}} {a b}
     }
 } {0}
+test stringComp-14.3 {Bug 0dca3bfa8f} {
+    apply {arg {
+	set argCopy $arg
+	set arg [string replace $arg 1 2 aa]
+	# Crashes in comparison before fix
+	expr {$arg ne $argCopy}
+    }} abcde
+} 1
 
 ## string tolower
 ## not yet bc
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index ab675d7..a808c82 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -1314,14 +1314,14 @@ test winFCmd-18.1.2 {Windows reserved path names} -constraints win -body {
     file pathtype com4
 } -result "absolute"
 test winFCmd-18.1.3 {Windows reserved path names} -constraints win -body {
-    file pathtype com5
-} -result "relative"
+    file pathtype com9
+} -result "absolute"
 test winFCmd-18.1.4 {Windows reserved path names} -constraints win -body {
     file pathtype lpt3
 } -result "absolute"
 test winFCmd-18.1.5 {Windows reserved path names} -constraints win -body {
-    file pathtype lpt4
-} -result "relative"
+    file pathtype lpt9
+} -result "absolute"
 test winFCmd-18.1.6 {Windows reserved path names} -constraints win -body {
     file pathtype nul
 } -result "absolute"
@@ -1423,6 +1423,11 @@ test winFCmd-19.8 {Windows extended path names} -constraints nt -setup {
     catch {file delete $tmpfile}
 } -result [list 0 {} [list "tcl[pid].tmp "]]
 
+test winFCmd-19.9 {Windows devices path names} -constraints nt -body {
+    file normalize //./com1
+} -result //./com1
+
+
 # This block of code used to occur after the "return" call, so I'm
 # commenting it out and assuming that this code is still under construction.
 #foreach source {tef ted tnf tnd "" nul com1} {