Merge 9.0

7 files changed, 106 insertions, 31 deletions

diff --git a/tests/chanio.test b/tests/chanio.test
index b520fb2..f02711e 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -252,7 +252,7 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -bod
 test chan-io-3.4 {WriteChars: loop over stage buffer} -body {
     # stage buffer maps to more than can be queued at once.
     set f [open $path(test1) w]
-    chan configure $f -encoding jis0208 -buffersize 16
+    chan configure $f -encoding jis0208 -buffersize 16 -nocomplainencoding 1
     chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     chan close $f
@@ -265,7 +265,7 @@ test chan-io-3.5 {WriteChars: saved != 0} -body {
     # be moved to beginning of next channel buffer to preserve requested
     # buffersize.
     set f [open $path(test1) w]
-    chan configure $f -encoding jis0208 -buffersize 17
+    chan configure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
     chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     chan close $f
@@ -298,7 +298,7 @@ test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
     # on flush. The truncated bytes are moved to the beginning of the next
     # channel buffer.
     set f [open $path(test1) w]
-    chan configure $f -encoding jis0208 -buffersize 17
+    chan configure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
     chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     chan close $f
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 9cb7724..8805906 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -186,7 +186,7 @@ test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
 } -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system}
 test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
     encoding convertto
-} -result {wrong # args: should be "encoding convertto ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -result {wrong # args: should be "encoding convertto ?-strict? ?-failindex var? ?encoding? data" or "encoding convertto -nocomplain ?encoding? data"}
 test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
     encoding convertto foo bar
 } -result {unknown encoding "foo"}
@@ -208,7 +208,7 @@ test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup {
 } -result 8C
 test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
     encoding convertfrom
-} -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -result {wrong # args: should be "encoding convertfrom ?-strict? ?-failindex var? ?encoding? data" or "encoding convertfrom -nocomplain ?encoding? data"}
 test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
     encoding convertfrom foo bar
 } -result {unknown encoding "foo"}
@@ -245,10 +245,10 @@ test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
 
 test cmdAH-4.14.1 {Syntax error, -nocomplain and -failindex, no encoding} -body {
     encoding convertfrom -nocomplain -failindex 2 ABC
-} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-strict? ?-failindex var? ?encoding? data" or "encoding convertfrom -nocomplain ?encoding? data"}
 test cmdAH-4.14.2 {Syntax error, -nocomplain and -failindex, no encoding} -body {
     encoding convertto -nocomplain -failindex 2 ABC
-} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-strict? ?-failindex var? ?encoding? data" or "encoding convertto -nocomplain ?encoding? data"}
 test cmdAH-4.15.1 {Syntax error, -failindex and -nocomplain, no encoding} -body {
     encoding convertfrom -failindex 2 -nocomplain ABC
 } -returnCodes 1 -result {unknown encoding "-nocomplain"}
@@ -257,19 +257,19 @@ test cmdAH-4.15.2 {Syntax error, -failindex and -nocomplain, no encoding} -body
 } -returnCodes 1 -result {unknown encoding "-nocomplain"}
 test cmdAH-4.16.1 {Syntax error, -nocomplain and -failindex, encoding} -body {
     encoding convertfrom -nocomplain -failindex 2 utf-8 ABC
-} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-strict? ?-failindex var? ?encoding? data" or "encoding convertfrom -nocomplain ?encoding? data"}
 test cmdAH-4.16.2 {Syntax error, -nocomplain and -failindex, encoding} -body {
     encoding convertto -nocomplain -failindex 2 utf-8 ABC
-} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-strict? ?-failindex var? ?encoding? data" or "encoding convertto -nocomplain ?encoding? data"}
 test cmdAH-4.17.1 {Syntax error, -failindex and -nocomplain, encoding} -body {
     encoding convertfrom -failindex 2 -nocomplain utf-8 ABC
-} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "encoding convertfrom ?-strict? ?-failindex var? ?encoding? data" or "encoding convertfrom -nocomplain ?encoding? data"}
 test cmdAH-4.17.2 {Syntax error, -failindex and -nocomplain, encoding} -body {
     encoding convertto -failindex 2 -nocomplain utf-8 ABC
-} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "encoding convertto ?-strict? ?-failindex var? ?encoding? data" or "encoding convertto -nocomplain ?encoding? data"}
 test cmdAH-4.18.1 {Syntax error, -failindex with no var, no encoding} -body {
     encoding convertfrom -failindex ABC
-} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-strict? ?-failindex var? ?encoding? data" or "::tcl::encoding::convertfrom -nocomplain ?encoding? data"}
 test cmdAH-4.18.2 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {
     proc encoding_test {} {
         encoding convertfrom -failindex ABC
@@ -277,12 +277,12 @@ test cmdAH-4.18.2 {Syntax error, -failindex with no var, no encoding (byte compi
 } -body {
     # Compile and execute
     encoding_test
-} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain|-strict|-failindex var? ?encoding? data"} -cleanup {
+} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-strict? ?-failindex var? ?encoding? data" or "::tcl::encoding::convertfrom -nocomplain ?encoding? data"} -cleanup {
     rename encoding_test ""
 }
 test cmdAH-4.18.3 {Syntax error, -failindex with no var, no encoding} -body {
     encoding convertto -failindex ABC
-} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-strict? ?-failindex var? ?encoding? data" or "::tcl::encoding::convertto -nocomplain ?encoding? data"}
 test cmdAH-4.18.4 {Syntax error, -failindex with no var, no encoding (byte compiled)} -setup {
     proc encoding_test {} {
         encoding convertto -failindex ABC
@@ -290,7 +290,7 @@ test cmdAH-4.18.4 {Syntax error, -failindex with no var, no encoding (byte compi
 } -body {
     # Compile and execute
     encoding_test
-} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain|-strict|-failindex var? ?encoding? data"} -cleanup {
+} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-strict? ?-failindex var? ?encoding? data" or "::tcl::encoding::convertto -nocomplain ?encoding? data"} -cleanup {
     rename encoding_test ""
 }
 test cmdAH-4.19.1 {convertrom -failindex with correct data} -body {
@@ -327,7 +327,7 @@ test cmdAH-4.20.1 {convertrom -failindex with incomplete utf8} -body {
     set x [encoding convertfrom -failindex i utf-8 A\xc3]
     binary scan $x H* y
     list $y $i
-} -returnCodes 0 -result {41c3 -1}
+} -returnCodes 0 -result {41 1}
 test cmdAH-4.20.2 {convertrom -failindex with incomplete utf8 (byte compiled)} -setup {
     proc encoding_test {} {
 	set x [encoding convertfrom -failindex i utf-8 A\xc3]
@@ -337,7 +337,41 @@ test cmdAH-4.20.2 {convertrom -failindex with incomplete utf8 (byte compiled)} -
 } -body {
     # Compile and execute
     encoding_test
-} -returnCodes 0 -result {41c3 -1} -cleanup {
+} -returnCodes 0 -result {41 1} -cleanup {
+    rename encoding_test ""
+}
+test cmdAH-4.20.3 {convertrom -failindex with incomplete utf8} -body {
+    set x [encoding convertfrom -strict -failindex i utf-8 A\xc3]
+    binary scan $x H* y
+    list $y $i
+} -returnCodes 0 -result {41 1}
+test cmdAH-4.20.4 {convertrom -failindex with incomplete utf8 (byte compiled)} -setup {
+    proc encoding_test {} {
+	set x [encoding convertfrom -strict -failindex i utf-8 A\xc3]
+	binary scan $x H* y
+	list $y $i
+    }
+} -body {
+    # Compile and execute
+    encoding_test
+} -returnCodes 0 -result {41 1} -cleanup {
+    rename encoding_test ""
+}
+test cmdAH-4.20.5 {convertrom -failindex with incomplete utf8} -body {
+    set x [encoding convertfrom -failindex i -strict utf-8 A\xc3]
+    binary scan $x H* y
+    list $y $i
+} -returnCodes 0 -result {41 1}
+test cmdAH-4.20.6 {convertrom -failindex with incomplete utf8 (byte compiled)} -setup {
+    proc encoding_test {} {
+	set x [encoding convertfrom -failindex i -strict utf-8 A\xc3]
+	binary scan $x H* y
+	list $y $i
+    }
+} -body {
+    # Compile and execute
+    encoding_test
+} -returnCodes 0 -result {41 1} -cleanup {
     rename encoding_test ""
 }
 test cmdAH-4.21.1 {convertto -failindex with wrong character} -body {
diff --git a/tests/encoding.test b/tests/encoding.test
index cdcfd45..48b0203 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -682,10 +682,10 @@ test encoding-24.21 {Parse with -nocomplain but without providing encoding} {
 } 1
 test encoding-24.22 {Syntax error, two encodings} -body {
     encoding convertfrom iso8859-1 utf-8 "ZX\uD800"
-} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertfrom ?-strict? ?-failindex var? ?encoding? data" or "::tcl::encoding::convertfrom -nocomplain ?encoding? data"}
 test encoding-24.23 {Syntax error, two encodings} -body {
     encoding convertto iso8859-1 utf-8 "ZX\uD800"
-} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -returnCodes 1 -result {wrong # args: should be "::tcl::encoding::convertto ?-strict? ?-failindex var? ?encoding? data" or "::tcl::encoding::convertto -nocomplain ?encoding? data"}
 test encoding-24.24 {Parse invalid utf-8 with -strict} -body {
     encoding convertfrom -strict utf-8 "\xC0\x80\x00\x00"
 } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
diff --git a/tests/expr.test b/tests/expr.test
index 62b1c27..a20aee1 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -7450,11 +7450,52 @@ test expr-62.10 {TIP 582: comments can go inside function calls} {
     expr {max# comment
 	     (1,2)}
 } 2
+
+# Bug e3dcab1d14 TODO: Need to work out a test case that fails
+# without tcl_precision, which has been eliminated in 9.0
+
+# proc do-one-test-expr-63 {e p float athreshold} {
+#     # e - power of 2 to test
+#     # p - tcl_precision to test wuth
+#     # float - floating point value 2**-$p
+#     # athreshold - tolerable absolute error (1/2 decimal digit in
+#     #              least significant place plus 1/2 least significant bit)
+#     set trouble {}
+#     set ::tcl_precision $p
+#     set xfmt x[expr $float]
+#     set ::tcl_precision 0
+#     set fmt [string range $xfmt 1 end]
+#     set aerror [expr {abs($fmt - $float)}]
+#     if {$aerror > $athreshold} {
+#         return "Result $fmt is more than $athreshold away from $float"
+#     } else {
+#         return {}
+#     }
+# }
+
+# proc run-test-expr-63 {} {
+#     for {set e 0} {$e <= 1023} {incr e} {
+#         set pt [expr {floor($e*log(2)/log(10))}]
+#         for {set p 6} {$p <= 17} {incr p} {
+#             set athreshold [expr {0.5*10.0**-($pt+$p) + 2.0**-($e+53)}]
+#             set numer [expr {5**$e}]
+#             set xfloat x[expr {2.**-$e}]
+#             set float [string range $xfloat 1 end]
+#             test expr-63.$p.$e "convert 2**-$e to decimal at precision $p" {
+#                 do-one-test-expr-63 $e $p $float $athreshold
+#             } {}
+#         }
+#     }
+#     rename do-one-test-expr-63 {}
+#     rename run-test-expr-63 {}
+# }
+# run-test-expr-63
 
 # cleanup
 unset -nocomplain a
 unset -nocomplain min
 unset -nocomplain max
+
 ::tcltest::cleanupTests
 return
 
diff --git a/tests/io.test b/tests/io.test
index f3f0ae4..919ea8b 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -272,7 +272,7 @@ test io-3.4 {WriteChars: loop over stage buffer} -body {
     # stage buffer maps to more than can be queued at once.
 
     set f [open $path(test1) w]
-    fconfigure $f -encoding jis0208 -buffersize 16
+    fconfigure $f -encoding jis0208 -buffersize 16 -nocomplainencoding 1
     puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     close $f
@@ -286,7 +286,7 @@ test io-3.5 {WriteChars: saved != 0} -body {
     # requested buffersize.
 
     set f [open $path(test1) w]
-    fconfigure $f -encoding jis0208 -buffersize 17
+    fconfigure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
     puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     close $f
@@ -319,7 +319,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
     # of the next channel buffer.
 
     set f [open $path(test1) w]
-    fconfigure $f -encoding jis0208 -buffersize 17
+    fconfigure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
     puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
     set x [list [contents $path(test1)]]
     close $f
diff --git a/tests/safe.test b/tests/safe.test
index 9c05091..7b73eb2 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -1473,7 +1473,7 @@ test safe-11.7 {testing safe encoding} -setup {
     interp eval $i encoding convertfrom
 } -returnCodes error -cleanup {
     safe::interpDelete $i
-} -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -result {wrong # args: should be "encoding convertfrom ?-strict? ?-failindex var? ?encoding? data" or "encoding convertfrom -nocomplain ?encoding? data"}
 test safe-11.7.1 {testing safe encoding} -setup {
     set i [safe::interpCreate]
 } -body {
@@ -1482,7 +1482,7 @@ test safe-11.7.1 {testing safe encoding} -setup {
 } -match glob -cleanup {
     unset -nocomplain m o
     safe::interpDelete $i
-} -result {wrong # args: should be "encoding convertfrom ?-nocomplain|-strict|-failindex var? ?encoding? data"
+} -result {wrong # args: should be "encoding convertfrom ?-strict? ?-failindex var? ?encoding? data" or "encoding convertfrom -nocomplain ?encoding? data"
     while executing
 "encoding convertfrom"
     invoked from within
@@ -1495,7 +1495,7 @@ test safe-11.8 {testing safe encoding} -setup {
     interp eval $i encoding convertto
 } -returnCodes error -cleanup {
     safe::interpDelete $i
-} -result {wrong # args: should be "encoding convertto ?-nocomplain|-strict|-failindex var? ?encoding? data"}
+} -result {wrong # args: should be "encoding convertto ?-strict? ?-failindex var? ?encoding? data" or "encoding convertto -nocomplain ?encoding? data"}
 test safe-11.8.1 {testing safe encoding} -setup {
     set i [safe::interpCreate]
 } -body {
@@ -1504,7 +1504,7 @@ test safe-11.8.1 {testing safe encoding} -setup {
 } -match glob -cleanup {
     unset -nocomplain m o
     safe::interpDelete $i
-} -result {wrong # args: should be "encoding convertto ?-nocomplain|-strict|-failindex var? ?encoding? data"
+} -result {wrong # args: should be "encoding convertto ?-strict? ?-failindex var? ?encoding? data" or "encoding convertto -nocomplain ?encoding? data"
     while executing
 "encoding convertto"
     invoked from within
diff --git a/tests/string.test b/tests/string.test
index 045d466..c8a4b2e 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -33,7 +33,7 @@ proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}
 testConstraint testobj [expr {[info commands testobj] ne {}}]
 testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
 testConstraint testevalex [expr {[info commands testevalex] ne {}}]
-testConstraint utf32 [expr {[string length \U010000] == 1}]
+testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]
 testConstraint testbytestring   [llength [info commands testbytestring]]
 testConstraint utf32 [expr {[testConstraint fullutf]
 		&& [string length [format %c 0x10000]] == 1}]
@@ -135,7 +135,7 @@ test string-2.11.3.$noComp {string compare, unicode} {
     run {string compare ÜÜÜüü ÜÜÜÜÜ}
 } 1
 test string-2.12.$noComp {string compare, high bit} {
-    # This test will fail if the underlying comparison
+    # This test fails if the underlying comparison
     # is using signed chars instead of unsigned chars.
     # (like SunOS's default memcmp thus the compat/memcmp.c)
     run {string compare "\x80" "@"}
@@ -199,10 +199,10 @@ test string-2.26.$noComp {string compare -nocase, null strings} {
 test string-2.27.$noComp {string compare -nocase, null strings} {
     run {string compare -nocase foo ""}
 } 1
-test string-2.28.$noComp {string compare with length, unequal strings} {
+test string-2.28.$noComp {string compare with length, unequal strings, partial first string} {
     run {string compare -length 2 abc abde}
 } 0
-test string-2.29.$noComp {string compare with length, unequal strings} {
+test string-2.29.$noComp {string compare with length, unequal strings 2, full first string} {
     run {string compare -length 2 ab abde}
 } 0
 test string-2.30.$noComp {string compare with NUL character vs. other ASCII} {
@@ -290,7 +290,7 @@ test string-3.19.$noComp {string equal, unicode} {
     run {string equal ÜÜÜüü ÜÜÜÜÜ}
 } 0
 test string-3.20.$noComp {string equal, high bit} {
-    # This test will fail if the underlying comparison
+    # This test fails if the underlying comparison
     # is using signed chars instead of unsigned chars.
     # (like SunOS's default memcmp thus the compat/memcmp.c)
     run {string equal "\x80" "@"}