merge core-8-branch.

Also add range checks to Tcl_GetUniChar() and Tcl_Range(), as suggested by Don Porter.

8 files changed, 54 insertions, 19 deletions

diff --git a/doc/StringObj.3 b/doc/StringObj.3
index 8d9bb56..e011c27 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -204,7 +204,8 @@ where the caller does not need the length of the unicode string
 representation.
 .PP
 \fBTcl_GetUniChar\fR returns the \fIindex\fR'th character in the
-value's Unicode representation.
+value's Unicode representation. If the index is out of range or
+it references a low surrogate preceded by a high surrogate, it returns -1;
 .PP
 \fBTcl_GetRange\fR returns a newly created value comprised of the
 characters between \fIfirst\fR and \fIlast\fR (inclusive) in the
diff --git a/doc/format.n b/doc/format.n
index 4eb566d..6f5f7bd 100644
--- a/doc/format.n
+++ b/doc/format.n
@@ -83,7 +83,7 @@ Specifies that the number should be padded on the left with
 zeroes instead of spaces.
 .TP 10
 \fB#\fR
-Requests an alternate output form. For \fBo\fR and \fBO\fR
+Requests an alternate output form. For \fBo\fR
 conversions it guarantees that the first digit is always \fB0\fR.
 For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
 will be added to the beginning of the result unless it is zero.
@@ -171,7 +171,7 @@ for \fBx\fR and
 for \fBX\fR).
 .TP 10
 \fBb\fR
-Convert integer to binary string, using digits 0 and 1.
+Convert integer to unsigned binary string, using digits 0 and 1.
 .TP 10
 \fBc\fR
 Convert integer to the Unicode character it represents.
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index c6841b8..0ec68d4 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -459,9 +459,9 @@ Tcl_GetCharLength(
  *
  * Tcl_GetUniChar --
  *
- *	Get the index'th Unicode character from the String object. The index
- *	is assumed to be in the appropriate range. If index references a lower
- *	surrogate preceded by a higher surrogate, the result = -1;
+ *	Get the index'th Unicode character from the String object. If index
+ *	is out of range or it references a low surrogate preceded by a high
+ *	surrogate, the result = -1;
  *
  * Results:
  *	Returns the index'th Unicode character in the Object.
@@ -479,7 +479,11 @@ Tcl_GetUniChar(
     int index)			/* Get the index'th Unicode character. */
 {
     String *stringPtr;
-    int ch;
+    int ch, length;
+
+    if (index < 0) {
+	return -1;
+    }
 
     /*
      * Optimize the case where we're really dealing with a bytearray object
@@ -488,7 +492,10 @@ Tcl_GetUniChar(
      */
 
     if (TclIsPureByteArray(objPtr)) {
-	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
+	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
+	if (index >- length) {
+		return -1;
+	}
 
 	return (int) bytes[index];
     }
@@ -515,6 +522,9 @@ Tcl_GetUniChar(
 	stringPtr = GET_STRING(objPtr);
     }
 
+    if (index >= stringPtr->numChars) {
+	return -1;
+    }
 	ch = stringPtr->unicode[index];
 #if TCL_UTF_MAX == 4
 	/* See: bug [11ae2be95dac9417] */
@@ -630,7 +640,11 @@ Tcl_GetRange(
 {
     Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
     String *stringPtr;
+    int length;
 
+    if (first < 0) {
+	first = 0;
+	}
     /*
      * Optimize the case where we're really dealing with a bytearray object
      * without string representation; we don't need to convert to a string to
@@ -638,8 +652,13 @@ Tcl_GetRange(
      */
 
     if (TclIsPureByteArray(objPtr)) {
-	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
-
+	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
+	if (last >= length) {
+	    last = length - 1;
+	}
+	if (last < first) {
+	    return Tcl_NewObj();
+	}
 	return Tcl_NewByteArrayObj(bytes+first, last-first+1);
     }
 
@@ -659,6 +678,12 @@ Tcl_GetRange(
 	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
 	}
 	if (stringPtr->numChars == objPtr->length) {
+	    if (last >= stringPtr->numChars) {
+		last = stringPtr->numChars - 1;
+	    }
+	    if (last < first) {
+		return Tcl_NewObj();
+	    }
 	    newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
 
 	    /*
@@ -673,7 +698,12 @@ Tcl_GetRange(
 	FillUnicodeRep(objPtr);
 	stringPtr = GET_STRING(objPtr);
     }
-
+	if (last > stringPtr->numChars) {
+	    last = stringPtr->numChars;
+	}
+	if (last < first) {
+	    return Tcl_NewObj();
+	}
 #if TCL_UTF_MAX == 4
 	/* See: bug [11ae2be95dac9417] */
 	if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00)
diff --git a/tests/chanio.test b/tests/chanio.test
index 8c74566..92f1c03 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -5866,6 +5866,8 @@ test chan-io-47.6 {file events on shared files, deleting file events} -setup {
     testfevent delete
     chan close $f
 } -result {{script 1} {}}
+unset path(foo)
+removeFile foo
 
 set path(bar) [makeFile {} bar]
 
@@ -5961,6 +5963,9 @@ test chan-io-48.3 {testing readability conditions} -setup {
 } -cleanup {
     chan close $f
 } -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
+unset path(bar)
+removeFile bar 
+
 test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup {
     file delete $path(test1)
     set c 0
@@ -6790,8 +6795,6 @@ test chan-io-52.11 {TclCopyChannel & encodings} -setup {
     chan close $in
     chan close $out
     file size $path(kyrillic.txt)
-} -cleanup {
-    file delete $path(utf8-fcopy.txt)
 } -result 3
 
 test chan-io-53.1 {CopyData} -setup {
diff --git a/tests/exec.test b/tests/exec.test
index dffd960..3d1cd56 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -300,7 +300,6 @@ test exec-6.3 {redirecting stderr through a pipeline} {exec stdio} {
 # I/O redirection: combinations.
 
 set path(gorp.file2) [makeFile {} gorp.file2]
-file delete $path(gorp.file2)
 
 test exec-7.1 {multiple I/O redirections} {exec} {
     exec << "command input" > $path(gorp.file2) [interpreter] $path(cat) < $path(gorp.file)
diff --git a/tests/info.test b/tests/info.test
index fd89b47..8176ad3 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -2398,7 +2398,7 @@ test info-33.35 {{*}, literal, simple, bytecompiled} -body {
 # -------------------------------------------------------------------------
 unset -nocomplain res
 
-test info-39.0 {Bug 4b61afd660} -setup {
+test info-39.2 {Bug 4b61afd660} -setup {
     proc probe {} {
 	return [dict get [info frame -1] line]
     }
diff --git a/tests/io.test b/tests/io.test
index 3fc370d..f73f49a 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6163,6 +6163,8 @@ test io-47.6 {file events on shared files, deleting file events} {testfevent fil
     close $f
     set x
 } {{script 1} {}}
+unset path(foo)
+removeFile foo
 
 set path(bar) [makeFile {} bar]
 
@@ -6265,6 +6267,9 @@ test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles openpipe
     close $f
     list $x $l
 } {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
+unset path(bar)
+removeFile bar
+
 test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} {
     file delete $path(test1)
     set f [open $path(test1) w]
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index cd89a02..b4ba04a 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -384,7 +384,6 @@ test iocmd-10.5 {fblocked command} {
 set path(test4) [makeFile {} test4]
 set path(test5) [makeFile {} test5]
 
-file delete $path(test5)
 test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
     set f [open $path(test4) w]
     close $f
@@ -3836,8 +3835,6 @@ foreach file [list test1 test2 test3 test4] {
 }
 # delay long enough for background processes to finish
 after 500
-foreach file [list test5] {
-    removeFile $file
-}
+removeFile test5
 cleanupTests
 return