Merge core-8-branch.

25 files changed, 720 insertions, 295 deletions

diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 4f743cc..c2424d6 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -656,7 +656,7 @@ EncodingConvertfromObjCmd(
 	    char buf[TCL_INTEGER_SPACE];
 	    sprintf(buf, "%u", result);
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %"
-		    "u: '\\x%X'", result, UCHAR(bytesPtr[result])));
+		    "u: '\\x%02X'", result, UCHAR(bytesPtr[result])));
 	    Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE",
 		    buf, NULL);
 	    Tcl_DStringFree(&ds);
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 1893d22..77f0db5 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4324,7 +4324,7 @@ extern const TclStubs *tclStubsPtr;
 		    _t.reserved = -1; \
 		    tclStubsPtr->tcl_GetTime((&_t.now)); \
 		    if (_t.reserved != -1) { \
-			_t.now.usec = _t.reserved; \
+			_t.now.usec = (long) _t.reserved; \
 		    } \
 		    *(t) = _t.now; \
 		} while (0)
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index f32baac..f15b479 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1352,6 +1352,9 @@ Tcl_ExternalToUtf(
     }
 
     if (!noTerminate) {
+        if (dstLen < 1) {
+            return TCL_CONVERT_NOSPACE;
+        }
 	/*
 	 * If there are any null characters in the middle of the buffer,
 	 * they will converted to the UTF-8 null character (\xC0\x80). To get
@@ -1360,6 +1363,10 @@ Tcl_ExternalToUtf(
 	 */
 
 	dstLen--;
+    } else {
+        if (dstLen < 0) {
+            return TCL_CONVERT_NOSPACE;
+        }
     }
     if (encodingPtr->toUtfProc == UtfToUtfProc) {
 	flags |= ENCODING_INPUT;
@@ -1585,10 +1592,17 @@ Tcl_UtfToExternal(
 	dstCharsPtr = &dstChars;
     }
 
+    if (dstLen < encodingPtr->nullSize) {
+        return TCL_CONVERT_NOSPACE;
+    }
     dstLen -= encodingPtr->nullSize;
     result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
 	    flags, statePtr, dst, dstLen, srcReadPtr,
 	    dstWrotePtr, dstCharsPtr);
+    /*
+     * Buffer is terminated irrespective of result. Not sure this is
+     * reasonable but keep for historical/compatibility reasons.
+     */
     memset(&dst[*dstWrotePtr], '\0', encodingPtr->nullSize);
 
     return result;
@@ -2602,13 +2616,18 @@ Utf32ToUtfProc(
 	    /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */
 	    dst += Tcl_UniCharToUtf(-1, dst);
 	}
-	if  ((unsigned)ch > 0x10FFFF || (((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)
-		&& ((ch  & ~0x7FF) == 0xD800))) {
-	    if (STOPONERROR) {
+
+	if ((unsigned)ch > 0x10FFFF) {
+	    ch = 0xFFFD;
+	    if ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT) {
 		result = TCL_CONVERT_SYNTAX;
-		ch = 0;
 		break;
 	    }
+	} else if (((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)
+		&& ((ch  & ~0x7FF) == 0xD800)) {
+	    result = TCL_CONVERT_SYNTAX;
+	    ch = 0;
+	    break;
 	}
 
 	/*
@@ -2628,6 +2647,7 @@ Utf32ToUtfProc(
 	/* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */
 	dst += Tcl_UniCharToUtf(-1, dst);
     }
+
     if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {
 	/* We have a single byte left-over at the end */
 	if (dst > dstEnd) {
@@ -2835,6 +2855,13 @@ Utf16ToUtfProc(
 	    ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF);
 	}
 	if (((prev  & ~0x3FF) == 0xD800) && ((ch  & ~0x3FF) != 0xDC00)) {
+	    if (((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)) {
+		result = TCL_CONVERT_UNKNOWN;
+		src -= 2; /* Go back to beginning of high surrogate */
+		dst--; /* Also undo writing a single byte too much */
+		numChars--;
+		break;
+	    }
 	    /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */
 	    dst += Tcl_UniCharToUtf(-1, dst);
 	}
@@ -2844,17 +2871,31 @@ Utf16ToUtfProc(
 	 * unsigned short-size data.
 	 */
 
-	if (ch && ch < 0x80) {
+	if ((unsigned)ch - 1 < 0x7F) {
 	    *dst++ = (ch & 0xFF);
+	} else if (((prev  & ~0x3FF) == 0xD800) || ((ch  & ~0x3FF) == 0xD800)) {
+	    dst += Tcl_UniCharToUtf(ch, dst);
+	} else if (((ch  & ~0x3FF) == 0xDC00) && ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT)) {
+	    /* Lo surrogate not preceded by Hi surrogate */
+	    result = TCL_CONVERT_UNKNOWN;
+	    break;
 	} else {
+	    *dst = 0; /* In case of lower surrogate, don't try to combine */
 	    dst += Tcl_UniCharToUtf(ch, dst);
 	}
 	src += sizeof(unsigned short);
     }
 
     if ((ch  & ~0x3FF) == 0xD800) {
-	/* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */
-	dst += Tcl_UniCharToUtf(-1, dst);
+	if ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT) {
+	    result = TCL_CONVERT_UNKNOWN;
+	    src -= 2;
+	    dst--;
+	    numChars--;
+	} else {
+	    /* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */
+	    dst += Tcl_UniCharToUtf(-1, dst);
+	}
     }
     if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {
 	/* We have a single byte left-over at the end */
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 723d2e5..328e410 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -4849,6 +4849,7 @@ ExtendStringRepWithUnicode(
 
   copyBytes:
     dst = objPtr->bytes + origLength;
+    *dst = '\0';
     for (i = 0; i < numChars; i++) {
 	dst += Tcl_UniCharToUtf(unicode[i], dst);
     }
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b3df8ec..668a05a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -2016,6 +2016,238 @@ static void SpecialFree(
 }
 
 /*
+ *------------------------------------------------------------------------
+ *
+ * UtfTransformFn --
+ *
+ *    Implements a direct call into Tcl_UtfToExternal and Tcl_ExternalToUtf
+ *    as otherwise there is no script level command that directly exercises
+ *    these functions (i/o command cannot test all combinations)
+ *    The arguments at the script level are roughly those of the above
+ *    functions:
+ *        encodingname srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?
+ *
+ * Results:
+ *    TCL_OK or TCL_ERROR. This any errors running the test, NOT the
+ *    result of Tcl_UtfToExternal or Tcl_ExternalToUtf.
+ *
+ * Side effects:
+ *
+ *    The result in the interpreter is a list of the return code from the
+ *    Tcl_UtfToExternal/Tcl_ExternalToUtf functions, the encoding state, and
+ *    an encoded binary string of length dstLen. Note the string is the
+ *    entire output buffer, not just the part containing the decoded
+ *    portion. This allows for additional checks at test script level.
+ *
+ *    If any of the srcreadvar, dstwrotevar and
+ *    dstcharsvar are specified and not empty, they are treated as names
+ *    of variables where the *srcRead, *dstWrote and *dstChars output
+ *    from the functions are stored.
+ *
+ *    The function also checks internally whether nuls are correctly
+ *    appended as requested but the TCL_ENCODING_NO_TERMINATE flag
+ *    and that no buffer overflows occur.
+ *------------------------------------------------------------------------
+ */
+typedef int
+UtfTransformFn(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr,
+               char *dst, Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
+static int UtfExtWrapper(
+    Tcl_Interp *interp, UtfTransformFn *transformer, int objc, Tcl_Obj *const objv[])
+{
+    Tcl_Encoding encoding;
+    Tcl_EncodingState encState, *encStatePtr;
+    Tcl_Size srcLen, bufLen;
+    const unsigned char *bytes;
+    unsigned char *bufPtr;
+    int srcRead, dstLen, dstWrote, dstChars;
+    Tcl_Obj *srcReadVar, *dstWroteVar, *dstCharsVar;
+    int result;
+    int flags;
+    Tcl_Obj **flagObjs;
+    int nflags;
+
+    if (objc < 7 || objc > 10) {
+        Tcl_WrongNumArgs(interp,
+                         2,
+                         objv,
+                         "encoding srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?");
+        return TCL_ERROR;
+    }
+    if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    /* Flags may be specified as list of integers and keywords */
+    flags = 0;
+    if (Tcl_ListObjGetElements(interp, objv[4], &nflags, &flagObjs) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    struct {
+	const char *flagKey;
+	int flag;
+    } flagMap[] = {
+	{"start", TCL_ENCODING_START},
+	{"end", TCL_ENCODING_END},
+	{"stoponerror", TCL_ENCODING_STOPONERROR},
+	{"noterminate", TCL_ENCODING_NO_TERMINATE},
+	{"charlimit", TCL_ENCODING_CHAR_LIMIT},
+	{NULL, 0}
+    };
+    int i;
+    for (i = 0; i < nflags; ++i) {
+	int flag;
+	if (Tcl_GetIntFromObj(NULL, flagObjs[i], &flag) == TCL_OK) {
+	    flags |= flag;
+	}
+	else {
+	    int idx;
+	    if (Tcl_GetIndexFromObjStruct(interp,
+					  flagObjs[i],
+					  flagMap,
+					  sizeof(flagMap[0]),
+					  "flag",
+					  0,
+					  &idx) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    flags |= flagMap[idx].flag;
+	}
+    }
+
+    /* Assumes state is integer if not "" */
+    Tcl_WideInt wide;
+    if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) {
+        encState = (Tcl_EncodingState) wide;
+        encStatePtr = &encState;
+    } else if (Tcl_GetCharLength(objv[5]) == 0) {
+        encStatePtr = NULL;
+    } else {
+        return TCL_ERROR;
+    }
+
+    if (Tcl_GetIntFromObj(interp, objv[6], &dstLen) != TCL_OK) {
+        return TCL_ERROR;
+    }
+    srcReadVar = NULL;
+    dstWroteVar = NULL;
+    dstCharsVar = NULL;
+    if (objc > 7) {
+	/* Has caller requested srcRead? */
+	if (Tcl_GetCharLength(objv[7])) {
+	    srcReadVar = objv[7];
+	}
+	if (objc > 8) {
+	    /* Ditto for dstWrote */
+            if (Tcl_GetCharLength(objv[8])) {
+                dstWroteVar = objv[8];
+            }
+	    if (objc > 9) {
+                if (Tcl_GetCharLength(objv[9])) {
+                    dstCharsVar = objv[9];
+		}
+	    }
+	}
+    }
+    if (flags & TCL_ENCODING_CHAR_LIMIT) {
+	/* Caller should have specified the dest char limit */
+	Tcl_Obj *valueObj;
+	if (dstCharsVar == NULL ||
+	    (valueObj = Tcl_ObjGetVar2(interp, dstCharsVar, NULL, 0)) == NULL
+	) {
+	    Tcl_SetResult(interp,
+			 "dstCharsVar must be specified with integer value if "
+			 "TCL_ENCODING_CHAR_LIMIT set in flags.", TCL_STATIC);
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIntFromObj(interp, valueObj, &dstChars) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else {
+	dstChars = 0; /* Only used for output */
+    }
+
+    bufLen = dstLen + 4; /* 4 -> overflow detection */
+    bufPtr = (unsigned char *)Tcl_Alloc(bufLen);
+    memset(bufPtr, 0xFF, dstLen); /* Need to check nul terminator */
+    memmove(bufPtr + dstLen, "\xAB\xCD\xEF\xAB", 4);   /* overflow detection */
+    bytes = Tcl_GetByteArrayFromObj(objv[3], &srcLen); /* Last! to avoid shimmering */
+    result = (*transformer)(interp, encoding, (const char *) bytes, srcLen, flags,
+                            encStatePtr, (char *) bufPtr, dstLen,
+                               srcReadVar ? &srcRead : NULL,
+                               &dstWrote,
+                               dstCharsVar ? &dstChars : NULL);
+    if (memcmp(bufPtr + bufLen - 4, "\xAB\xCD\xEF\xAB", 4)) {
+        Tcl_SetResult(interp,
+                      "Tcl_ExternalToUtf wrote past output buffer",
+                      TCL_STATIC);
+        result = TCL_ERROR;
+    } else if (result != TCL_ERROR) {
+
+        Tcl_Obj *resultObjs[3];
+
+        switch (result) {
+        case TCL_OK:
+            resultObjs[0] = Tcl_NewStringObj("ok", -1);
+            break;
+        case TCL_CONVERT_MULTIBYTE:
+            resultObjs[0] = Tcl_NewStringObj("multibyte", -1);
+            break;
+        case TCL_CONVERT_SYNTAX:
+            resultObjs[0] = Tcl_NewStringObj("syntax", -1);
+            break;
+        case TCL_CONVERT_UNKNOWN:
+            resultObjs[0] = Tcl_NewStringObj("unknown", -1);
+            break;
+        case TCL_CONVERT_NOSPACE:
+            resultObjs[0] = Tcl_NewStringObj("nospace", -1);
+            break;
+        default:
+            resultObjs[0] = Tcl_NewIntObj(result);
+            break;
+        }
+        result = TCL_OK;
+        resultObjs[1] =
+            encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)encState) : Tcl_NewObj();
+        resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen);
+        if (srcReadVar) {
+	    if (Tcl_ObjSetVar2(interp,
+			       srcReadVar,
+			       NULL,
+			       Tcl_NewIntObj(srcRead),
+			       TCL_LEAVE_ERR_MSG) == NULL) {
+		result = TCL_ERROR;
+	    }
+	}
+        if (dstWroteVar) {
+	    if (Tcl_ObjSetVar2(interp,
+			       dstWroteVar,
+			       NULL,
+			       Tcl_NewIntObj(dstWrote),
+			       TCL_LEAVE_ERR_MSG) == NULL) {
+		result = TCL_ERROR;
+	    }
+	}
+        if (dstCharsVar) {
+	    if (Tcl_ObjSetVar2(interp,
+			       dstCharsVar,
+			       NULL,
+			       Tcl_NewIntObj(dstChars),
+			       TCL_LEAVE_ERR_MSG) == NULL) {
+		result = TCL_ERROR;
+	    }
+	}
+        Tcl_SetObjResult(interp, Tcl_NewListObj(3, resultObjs));
+    }
+
+    ckfree(bufPtr);
+    Tcl_FreeEncoding(encoding); /* Free returned reference */
+    return result;
+}
+
+
+/*
  *----------------------------------------------------------------------
  *
  * TestencodingCmd --
@@ -2044,10 +2276,10 @@ TestencodingObjCmd(
     const char *string;
     TclEncoding *encodingPtr;
     static const char *const optionStrings[] = {
-	"create", "delete", "nullength", NULL
+	"create", "delete", "nullength", "Tcl_ExternalToUtf", "Tcl_UtfToExternal", NULL
     };
     enum options {
-	ENC_CREATE, ENC_DELETE, ENC_NULLENGTH
+	ENC_CREATE, ENC_DELETE, ENC_NULLENGTH, ENC_EXTTOUTF, ENC_UTFTOEXT
     };
 
     if (objc < 2) {
@@ -2116,6 +2348,12 @@ TestencodingObjCmd(
 	Tcl_SetObjResult(interp,
 			 Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding)));
 	Tcl_FreeEncoding(encoding);
+        break;
+
+    case ENC_EXTTOUTF:
+        return UtfExtWrapper(interp,Tcl_ExternalToUtf,objc,objv);
+    case ENC_UTFTOEXT:
+        return UtfExtWrapper(interp,Tcl_UtfToExternal,objc,objv);
     }
     return TCL_OK;
 }
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index c9a910a..66657d9 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -1269,7 +1269,7 @@ TeststringobjCmd(
     static const char *const options[] = {
 	"append", "appendstrings", "get", "get2", "length", "length2",
 	"set", "set2", "setlength", "maxchars", "range", "appendself",
-	"appendself2", NULL
+	"appendself2", "newunicode", NULL
     };
 
     if (objc < 3) {
@@ -1513,7 +1513,24 @@ TeststringobjCmd(
 	    Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + length, size - length);
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
 	    break;
-    }
+	case 13: /* newunicode*/
+	    unicode = (unsigned short *) ckalloc((objc - 3) * sizeof(unsigned short));
+	    for (i = 0; i < (objc - 3); ++i) {
+		int val;
+		if (Tcl_GetIntFromObj(interp, objv[i + 3], &val) != TCL_OK) {
+		    break;
+		}
+		unicode[i] = (unsigned short)val;
+	    }
+	    if (i < (objc-3)) {
+		ckfree(unicode);
+		return TCL_ERROR;
+	    }
+	    SetVarToObj(varPtr, varIndex, Tcl_NewUnicodeObj(unicode, objc - 3));
+	    Tcl_SetObjResult(interp, varPtr[varIndex]);
+	    ckfree(unicode);
+	    break;
+	}
 
     return TCL_OK;
 }
diff --git a/library/manifest.txt b/library/manifest.txt
index cc1e223..5a999f4 100644
--- a/library/manifest.txt
+++ b/library/manifest.txt
@@ -12,7 +12,7 @@ apply {{dir} {
     0 tcl::idna       1.0.1  {cookiejar idna.tcl}
     0 platform        1.0.19 {platform platform.tcl}
     0 platform::shell 1.1.4  {platform shell.tcl}
-    1 tcltest         2.5.5  {tcltest tcltest.tcl}
+    1 tcltest         2.5.6  {tcltest tcltest.tcl}
   } {
     if {$isafe && !$safe} continue
     package ifneeded $package $version  [list source [file join $dir {*}$file]]
diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl
index 18b05e5..9903e32 100644
--- a/library/tcltest/pkgIndex.tcl
+++ b/library/tcltest/pkgIndex.tcl
@@ -9,4 +9,4 @@
 # full path name of this file's directory.
 
 if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
-package ifneeded tcltest 2.5.5 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.5.6 [list source [file join $dir tcltest.tcl]]
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 7344f9f..6cb7d92 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -22,7 +22,7 @@ namespace eval tcltest {
     # When the version number changes, be sure to update the pkgIndex.tcl file,
     # and the install directory in the Makefiles.  When the minor version
     # changes (new feature) be sure to update the man page as well.
-    variable Version 2.5.5
+    variable Version 2.5.6
 
     # Compatibility support for dumb variables defined in tcltest 1
     # Do not use these.  Call [package provide Tcl] and [info patchlevel]
@@ -1134,6 +1134,39 @@ proc tcltest::SafeFetch {n1 n2 op} {
     }
 }
 
+
+# tcltest::Asciify --
+#
+#       Transforms the passed string to contain only printable ascii characters.
+#       Useful for printing to terminals. Non-printables are mapped to
+#       \x, \u or \U sequences.
+#
+# Arguments:
+#       s - string to transform
+#
+# Results:
+#       The transformed strings
+#
+# Side effects:
+#       None.
+
+proc tcltest::Asciify {s} {
+    set print ""
+    foreach c [split $s ""] {
+        set i [scan $c %c]
+        if {[string is print $c] && ($i <= 127)} {
+            append print $c
+        } elseif {$i <= 0xFF} {
+            append print \\x[format %02X $i]
+        } elseif {$i <= 0xFFFF} {
+            append print \\u[format %04X $i]
+        } else {
+            append print \\U[format %08X $i]
+        }
+    }
+    return $print
+}
+
 # tcltest::ConstraintInitializer --
 #
 #	Get or set a script that when evaluated in the tcltest namespace
@@ -2221,9 +2254,9 @@ proc tcltest::test {name description args} {
 	if {$scriptCompare} {
 	    puts [outputChannel] "---- Error testing result: $scriptMatch"
 	} else {
-	    puts [outputChannel] "---- Result was:\n$actualAnswer"
+	    puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
 	    puts [outputChannel] "---- Result should have been\
-		    ($match matching):\n$result"
+		    ($match matching):\n[Asciify $result]"
 	}
     }
     if {$errorCodeFailure} {
diff --git a/tests/chanio.test b/tests/chanio.test
index 0176c13..6814224 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -121,7 +121,7 @@ test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
     chan puts -nonewline $f "a\x4D\x00"
     chan close $f
     contents $path(test1)
-} "aM\x00"
+} aM\x00
 test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
     set f [open $path(test1) w]
     chan configure $f -encoding shiftjis
@@ -286,7 +286,7 @@ test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} -body {
     # last byte of Ａ plus the all of Ｂ) appended.
     set f [open $path(test1) w]
     chan configure $f -encoding shiftjis -buffersize 16
-    chan puts -nonewline $f "12345678901234ＡＢ"
+    chan puts -nonewline $f 12345678901234ＡＢ
     set x [list [contents $path(test1)]]
     chan close $f
     lappend x [contents $path(test1)]
@@ -1218,7 +1218,7 @@ test chan-io-8.7 {PeekAhead: cleanup} -setup {
     chan puts -nonewline $f "abcdefghijklmno\r"
     # here
     lappend x [chan gets $f line] $line [testchannel queuedcr $f]
-    chan puts -nonewline $f "\x1A"
+    chan puts -nonewline $f \x1A
     lappend x [chan gets $f line] $line
 } -cleanup {
     chan close $f
@@ -1374,22 +1374,22 @@ test chan-io-12.4 {ReadChars: split-up char} -setup {
     chan configure $f -encoding shiftjis
     vwait [namespace which -variable x]
     chan configure $f -encoding binary -blocking 1
-    chan puts -nonewline $f "\x7B"
+    chan puts -nonewline $f \x7B
     after 500			;# Give the cat process time to catch up
     chan configure $f -encoding shiftjis -blocking 0
     vwait [namespace which -variable x]
     return $x
 } -cleanup {
     chan close $f
-} -result [list "123456789012345" 1 "本" 0]
+} -result [list "123456789012345" 1 本 0]
 test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
     variable x {}
 } -constraints {stdio fileevent} -body {
     set path(test1) [makeFile {
 	chan configure stdout -encoding binary -buffering none
-	chan gets stdin; chan puts -nonewline "\xE7"
-	chan gets stdin; chan puts -nonewline "\x89"
-	chan gets stdin; chan puts -nonewline "\xA6"
+	chan gets stdin; chan puts -nonewline \xE7
+	chan gets stdin; chan puts -nonewline \x89
+	chan gets stdin; chan puts -nonewline \xA6
     } test1]
     set f [openpipe r+ $path(test1)]
     chan event $f readable [namespace code {
@@ -4982,7 +4982,7 @@ test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} -setup {
 test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
     # This test crashes the interp if Bug #427196 is not fixed
     set chan [open [info script] r]
-    chan configure $chan -buffersize 10
+    chan configure $chan -buffersize 10 -encoding utf-8
     set var [chan read $chan 2]
     chan configure $chan -buffersize 32
     append var [chan read $chan]
@@ -5213,7 +5213,7 @@ test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_
 } -constraints {stdio fileevent} -body {
     set f [openpipe r+ $path(cat)]
     chan configure $f -encoding binary
-    chan puts -nonewline $f "\xE7"
+    chan puts -nonewline $f \xE7
     chan flush $f
     chan configure $f -encoding utf-8 -blocking 0
     chan event $f readable [namespace code { lappend x [chan read $f] }]
@@ -6850,7 +6850,7 @@ set path(utf8-rp.txt)    [makeFile {} utf8-rp.txt]
 # Create kyrillic file, use lf translation to avoid os eol issues
 set out [open $path(kyrillic.txt) w]
 chan configure $out -encoding koi8-r -translation lf
-chan puts       $out "АА"
+chan puts       $out АА
 chan close      $out
 test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
     # Copy kyrillic to UTF-8, using chan copy.
@@ -6888,7 +6888,7 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
 test chan-io-52.11 {TclCopyChannel & encodings} -setup {
     set f [open $path(utf8-fcopy.txt) w]
     fconfigure $f -encoding utf-8 -translation lf
-    puts $f "АА"
+    puts $f АА
     close $f
 } -constraints {fcopy} -body {
     # binary to encoding => the input has to be in utf-8 to make sense to the
diff --git a/tests/encoding.test b/tests/encoding.test
index 81323f4..d9ec3ab 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -553,15 +553,27 @@ test encoding-16.18 {
 	return done
     } [namespace current]]
 } -result done
-test encoding-16.19 {UnicodeToUtfProc, bug [d19fe0a5b]} -body {
+test encoding-16.19 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom utf-16 "\x41\x41\x41"
 } -result \u4141\uFFFD
-test encoding-16.20 {UnicodeToUtfProc, bug [d19fe0a5b]} -constraints deprecated -body {
+test encoding-16.20 {Utf16ToUtfProc, bug [d19fe0a5b]} -constraints deprecated -body {
     encoding convertfrom utf-16 "\xD8\xD8"
 } -result \uD8D8
-test encoding-16.21 {UnicodeToUtfProc, bug [d19fe0a5b]} -body {
+test encoding-16.21 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom utf-32 "\x00\x00\x00\x00\x41\x41"
 } -result \x00\uFFFD
+test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
+    encoding convertfrom -strict utf-16le \x00\xD8
+} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
+test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body {
+    encoding convertfrom -strict utf-16le \x00\xDC
+} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'}
+test encoding-16.24 {Utf32ToUtfProc} -body {
+    encoding convertfrom utf-32 "\xFF\xFF\xFF\xFF"
+} -result \uFFFD
+test encoding-16.25 {Utf32ToUtfProc} -body {
+    encoding convertfrom utf-32 "\x01\x00\x00\x01"
+} -result \uFFFD
 
 test encoding-17.1 {UtfToUtf16Proc} -body {
     encoding convertto utf-16 "\U460DC"
@@ -593,6 +605,12 @@ test encoding-17.9 {Utf32ToUtfProc} -body {
 test encoding-17.10 {Utf32ToUtfProc} -body {
     encoding convertfrom -nocomplain utf-32 "\xFF\xFF\xFF\xFF"
 } -result \uFFFD
+test encoding-17.11 {Utf32ToUtfProc} -body {
+    encoding convertfrom -strict utf-32le "\x00\xD8\x00\x00"
+} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'}
+test encoding-17.12 {Utf32ToUtfProc} -body {
+    encoding convertfrom -strict utf-32le "\x00\xDC\x00\x00"
+} -returnCodes error -result {unexpected byte sequence starting at index 0: '\x00'}
 
 test encoding-18.1 {TableToUtfProc on invalid input} -constraints deprecated -body {
 	list [catch {encoding convertto jis0208 \\} res] $res
@@ -1032,6 +1050,46 @@ test encoding-28.0 {all encodings load} -body {
 
 runtests
 
+test encoding-bug-183a1adcc0-1 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -body {
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1} result] $result
+} -result [list 0 [list nospace {} \xff]]
+
+test encoding-bug-183a1adcc0-2 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -body {
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 0} result] $result
+} -result [list 0 [list nospace {} {}]]
+
+test encoding-bug-183a1adcc0-3 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -body {
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 2} result] $result
+} -result [list 0 [list nospace {} \x00\x00]]
+
+test encoding-bug-183a1adcc0-4 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -body {
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 3} result] $result
+} -result [list 0 [list nospace {} \x00\x00\xff]]
+
+test encoding-bug-183a1adcc0-5 {Bug [183a1adcc0] Buffer overflow Tcl_UtfToExternal} -constraints {
+    testencoding
+} -constraints {
+    knownBug
+} -body {
+    # The knownBug constraint is because test depends on TCL_UTF_MAX and
+    # also UtfToUtf16 assumes space required in destination buffer is
+    # sizeof(Tcl_UniChar) which is incorrect when TCL_UTF_MAX==4
+    # Note - buffers are initialized to \xff
+    list [catch {testencoding Tcl_UtfToExternal utf-16 A {start end} {} 4} result] $result
+} -result [list 0 [list ok {} [expr {$::tcl_platform(byteOrder) eq "littleEndian" ? "\x41\x00" : "\x00\x41"}]\x00\x00]]
+
 }
 
 test encoding-29.0 {get encoding nul terminator lengths} -constraints {
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 246d65b..22ac7b8 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -128,7 +128,7 @@ proc gethomedirglob {user} {
             set sid [string trim $sid]
             # Get path from the Windows registry
             set home [registry get "HKEY_LOCAL_MACHINE\\Software\\Microsoft\\Windows NT\\CurrentVersion\\ProfileList\\$sid" ProfileImagePath]
-            set home [string trim $home]
+            set home [string trim [string tolower $home]]
         } result]} {
             if {$home ne ""} {
                 # file join for \ -> /
@@ -139,7 +139,7 @@ proc gethomedirglob {user} {
 
     # Caller will need to use glob matching and hope user
     # name is in the home directory path
-    return *$user*
+    return *[string tolower $user]*
 }
 
 proc createfile {file {string a}} {
@@ -429,7 +429,7 @@ test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
 } -constraints {notRoot} -body {
     file mkdir tf1
     file exists tf1
-} -result {1}
+} -result 1
 
 test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
     file delete -xyz
@@ -1065,6 +1065,7 @@ test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup {
     file mkdir [file join td1 tdx]
     file mkdir [file join td2 tdy]
     testchmod 0o555 td2
+    testchmod 0o555 td2/tdy; # Above line removes inherited perms. So restore.
     file copy td1 td3
     file copy td2 td4
     list [lsort [glob td*]] [glob -directory td3 t*] \
@@ -1086,10 +1087,19 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup {
     createfile tfd2
     createfile tfd3
     createfile tfd4
-    testchmod 0o444 tfs3
-    testchmod 0o444 tfs4
-    testchmod 0o444 tfd2
-    testchmod 0o444 tfd4
+    if {$::tcl_platform(platform) eq "windows"} {
+        # On Windows testchmode will attach an ACL which file copy cannot handle
+        # so use good old attributes which file copy does understand
+        file attribute tfs3 -readonly 1
+        file attribute tfs4 -readonly 1
+        file attribute tfd2 -readonly 1
+        file attribute tfd4 -readonly 1
+    } else {
+        testchmod 0o444 tfs3
+        testchmod 0o444 tfs4
+        testchmod 0o444 tfd2
+        testchmod 0o444 tfd4
+    }
     set msg [list [catch {file copy tf1 tf2} msg] $msg]
     file copy -force tfs1 tfd1
     file copy -force tfs2 tfd2
@@ -1239,7 +1249,7 @@ test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup {
     catch {file rename tfa1 tfa2 tfa3}
 } -cleanup {
     file delete tfa1 tfa2 tfa3
-} -result {1}
+} -result 1
 test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup {
     catch {file delete -force -- tfa1 tfad}
 } -constraints {notRoot} -body {
@@ -1284,7 +1294,7 @@ test fCmd-12.1 {renamefile: source filename translation failing} -setup {
     catch {file rename ~/tfa1 tfa2}
 } -cleanup {
     set ::env(HOME) $temp
-} -result {1}
+} -result 1
 test fCmd-12.2 {renamefile: src filename translation failing} -setup {
     set temp $::env(HOME)
 } -constraints {notRoot} -body {
@@ -1296,7 +1306,7 @@ test fCmd-12.2 {renamefile: src filename translation failing} -setup {
 } -cleanup {
     set ::env(HOME) $temp
     file delete -force tfad
-} -result {1}
+} -result 1
 test fCmd-12.3 {renamefile: stat failing on source} -setup {
     catch {file delete -force -- tfa1 tfa2}
 } -constraints {notRoot} -body {
@@ -1341,7 +1351,7 @@ test fCmd-12.7 {renamefile: renaming directory into offspring} -setup {
     catch {file rename tfad tfad/dir}
 } -cleanup {
     file delete -force tfad
-} -result {1}
+} -result 1
 test fCmd-12.8 {renamefile: generic error} -setup {
     catch {file delete -force -- tfa}
 } -constraints {unix notRoot notWsl} -body {
@@ -1352,7 +1362,7 @@ test fCmd-12.8 {renamefile: generic error} -setup {
 } -cleanup {
     catch {file attributes tfa -permissions 0o777}
     file delete -force tfa
-} -result {1}
+} -result 1
 test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
     cleanup $tmpspace
 } -constraints {unix notRoot} -body {
@@ -1414,7 +1424,7 @@ test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup {
     catch { file copy tfa ~/foobar }
 } -cleanup {
     set ::env(HOME) $temp
-} -result {1}
+} -result 1
 test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
     catch {file delete -force -- tfa1 tfa2 tfa3}
 } -constraints {notRoot} -body {
@@ -1424,7 +1434,7 @@ test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
     catch {file copy tfa1 tfa2 tfa3}
 } -cleanup {
     file delete tfa1 tfa2 tfa3
-} -result {1}
+} -result 1
 test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup {
     catch {file delete -force -- tfa1 tfad}
 } -constraints {notRoot} -body {
@@ -1470,7 +1480,7 @@ test fCmd-14.1 {copyfile: source filename translation failing} -setup {
     catch {file copy ~/tfa1 tfa2}
 } -cleanup {
     set ::env(HOME) $temp
-} -result {1}
+} -result 1
 test fCmd-14.2 {copyfile: dst filename translation failing} -setup {
     set temp $::env(HOME)
 } -constraints {notRoot} -body {
@@ -1538,7 +1548,7 @@ test fCmd-14.8 {copyfile: copy directory failing} -setup {
 } -cleanup {
     file attributes tfa/dir -permissions 0o777
     file delete -force tfa tfa2
-} -result {1}
+} -result 1
 
 #
 # Coverage tests for TclMkdirCmd()
@@ -1551,7 +1561,7 @@ test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {
     catch {file mkdir ~/tfa}
 } -cleanup {
     set ::env(HOME) $temp
-} -result {1}
+} -result 1
 #
 # Can Tcl_SplitPath return argc == 0? If so them we need a test for that code.
 #
@@ -1562,7 +1572,7 @@ test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup {
     file isdirectory tfa
 } -cleanup {
     file delete tfa
-} -result {1}
+} -result 1
 test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup {
     catch {file delete -force -- tfa1 tfa2}
 } -constraints {notRoot} -body {
@@ -1581,7 +1591,7 @@ test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup {
 } -cleanup {
     file attributes tfa -permissions 0o777
     file delete -force tfa
-} -result {1}
+} -result 1
 test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup {
     catch {file delete -force -- tfa}
 } -constraints {notRoot} -body {
@@ -1589,7 +1599,7 @@ test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup
     file isdir tfa/a/b/c
 } -cleanup {
     file delete -force tfa
-} -result {1}
+} -result 1
 test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup {
     catch {file delete -force -- tfa}
 } -constraints {notRoot} -body {
@@ -1613,7 +1623,7 @@ test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body {
     file isdir tfa
 } -constraints {notRoot} -cleanup {
     file delete tfa
-} -result {1}
+} -result 1
 
 # Coverage tests for TclDeleteFilesCommand()
 test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup {
@@ -1637,7 +1647,7 @@ test fCmd-16.3 {test bad option} -constraints {notRoot} -setup {
     catch {file delete -dog tfa}
 } -cleanup {
     file delete tfa
-} -result {1}
+} -result 1
 test fCmd-16.4 {accept zero files (TIP 323)} -body {
     file delete
 } -result {}
@@ -1652,7 +1662,7 @@ test fCmd-16.6 {delete: source filename translation failing} -setup {
     catch {file delete ~/tfa}
 } -cleanup {
     set ::env(HOME) $temp
-} -result {1}
+} -result 1
 test fCmd-16.7 {remove a non-empty directory without -force} -setup {
     catch {file delete -force -- tfa}
 } -constraints {notRoot} -body {
@@ -1661,7 +1671,7 @@ test fCmd-16.7 {remove a non-empty directory without -force} -setup {
     catch {file delete tfa}
 } -cleanup {
     file delete -force tfa
-} -result {1}
+} -result 1
 test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa}
 } -body {
@@ -1670,7 +1680,7 @@ test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup {
     catch {file delete tfa}
 } -cleanup {
     file delete -force tfa
-} -result {1}
+} -result 1
 test fCmd-16.9 {error while deleting file} -setup {
     catch {file delete -force -- tfa}
 } -constraints {unix notRoot notWsl} -body {
@@ -1686,7 +1696,7 @@ test fCmd-16.9 {error while deleting file} -setup {
 } -cleanup {
     file attributes tfa -permissions 0o777
     file delete -force tfa
-} -result {1}
+} -result 1
 test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa1 tfa2}
 } -body {
@@ -1711,7 +1721,7 @@ test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup {
 } -cleanup {
      file attributes tfa1 -permissions 0o777
      file delete -force tfa1
-} -result {1}
+} -result 1
 test fCmd-17.2 {mkdir several levels deep - relative} -setup {
     catch {file delete -force -- tfa}
 } -constraints {notRoot} -body {
@@ -1728,7 +1738,7 @@ test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
     file isdir $f
 } -cleanup {
     file delete $f [file join [pwd] tfa]
-} -result {1}
+} -result 1
 
 #
 # Functionality tests for TclFileRenameCmd()
@@ -1889,7 +1899,7 @@ test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup {
     checkcontent tfa1/tfa2 $s
 } -cleanup {
     file delete -force tfa1 tfalink
-} -result {1}
+} -result 1
 test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup {
     catch {file delete -force -- tfa1 tfalink}
 } -constraints {unix notRoot} -body {
@@ -1922,7 +1932,7 @@ test fCmd-19.2 {rmdir error besides EEXIST} -setup {
 } -cleanup {
     file attributes tfa -permissions 0o777
     file delete -force tfa
-} -result {1}
+} -result 1
 test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa}
 } -body {
@@ -1950,7 +1960,7 @@ test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -se
 } -cleanup {
     file attributes tfa/a -permissions 0o777
     file delete -force tfa
-} -result {1}
+} -result 1
 test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup {
     catch {file delete -force -- tfa}
 } -constraints {unix notRoot} -body {
@@ -2003,7 +2013,7 @@ test fCmd-21.4 {copy : more than one source and target is not a directory} -setu
     catch {file copy tfa1 tfa2 tfa3}
 } -cleanup {
     file delete tfa1 tfa2 tfa3
-} -result {1}
+} -result 1
 test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa1 tfa2 tfad}
 } -body {
@@ -2128,7 +2138,7 @@ test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} -setup {
     checkcontent tfa1 $s
 } -cleanup {
     file delete tfa1
-} -result {1}
+} -result 1
 test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup {
     catch {file delete -force -- d1 tfad}
 } -constraints {notRoot} -body {
@@ -2588,7 +2598,7 @@ test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body
     expr {[info exists env(USERPROFILE)]
           && [file exists $env(USERPROFILE)/NTUSER.DAT]
           && [file readable $env(USERPROFILE)/NTUSER.DAT]}
-} -result {1}
+} -result 1
 # At least one CI environment (GitHub Actions) is set up with the page file in
 # an unusual location; skip the test if that is so.
 test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notInCIenv} -body {
diff --git a/tests/io.test b/tests/io.test
index 04c0cc8..3c0ec2e 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -5476,7 +5476,7 @@ test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
     # This test crashes the interp if Bug #427196 is not fixed
 
     set chan [open [info script] r]
-    fconfigure $chan -buffersize 10
+    fconfigure $chan -buffersize 10 -encoding utf-8
     set var [read $chan 2]
     fconfigure $chan -buffersize 32
     append var [read $chan]
@@ -5677,13 +5677,20 @@ test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
     close $f
     set x
 } 牦
-test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
+test io-39.16 {Tcl_SetChannelOption: -encoding (shortened to "-en"), errors} -body {
     file delete $path(test1)
     set f [open $path(test1) w]
-    set result [list [catch {fconfigure $f -encoding foobar} msg] $msg]
+    fconfigure $f -en foobar
+} -cleanup {
     close $f
-    set result
-} {1 {unknown encoding "foobar"}}
+} -returnCodes 1 -result {unknown encoding "foobar"}
+test io-39.16a {Tcl_SetChannelOption: -encoding (invalid shortening to "-e"), errors} -body {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -e foobar
+} -cleanup {
+    close $f
+} -returnCodes 1 -match glob -result {bad option "-e": should be one of *}
 test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
     set f [open "|[list [interpreter] $path(cat)]" r+]
     fconfigure $f -encoding binary
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index f481a17..9639576 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -671,7 +671,7 @@ namespace eval inputfilter {
     proc initialize {chan mode} {
 	return {initialize finalize read}
     }
-    
+
     proc read {chan buffer} {
 	return $buffer
     }
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 2fd4369..5c1d040 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -69,8 +69,8 @@ test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {testobj dep
     testobj freeallvars
     teststringobj set 1 abcdef
     teststringobj setlength 1 10
-    list [teststringobj length 1] [teststringobj length2 1]
-} {10 10}
+    teststringobj length 1
+} 10
 test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {testobj utf32 deprecated} {
     testobj freeallvars
     teststringobj set 1 abcdef
@@ -78,7 +78,7 @@ test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {testobj utf
     list [teststringobj length 1] [teststringobj length2 1] \
 	    [teststringobj get 1]
 } {10 10 abcdefxyzq}
-test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {testobj deprecated} {
+test stringObj-4.4 {Tcl_SetObjLength procedure, "empty string", length 0} {testobj deprecated} {
     testobj freeallvars
     testobj newobj 1
     teststringobj setlength 1 0
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 49f31d5..29d40e2 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -555,7 +555,7 @@ switch -- $::tcl_platform(platform) {
     default {
 	# note in FAT/NTFS we won't be able to protect directory with read-only attribute...
 	catch {file attributes $notWriteableDir -readonly 1}
-	catch {testchmod 0 $notWriteableDir}
+	catch {testchmod 0o444 $notWriteableDir}
     }
 }
 test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 43c7ced..3be1920 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -45,15 +45,20 @@ proc contents {file} {
     set r
 }
 
+proc cleanupRecurse {args} {
+    # Assumes no loops via links!
+    # Need to change permissions BEFORE deletion
+    testchmod 0o777 {*}$args
+    foreach victim $args {
+        if {[file isdirectory $victim]} {
+            cleanupRecurse {*}[glob -nocomplain -directory $victim td* tf* Test*]
+        }
+        file delete -force $victim
+    }
+}
 proc cleanup {args} {
-    foreach p ". $args" {
-	set x ""
-	catch {
-	    set x [glob -directory $p tf* td*]
-	}
-	if {$x != ""} {
-	    catch {file delete -force -- {*}$x}
-	}
+    foreach p [list [pwd] {*}$args] {
+        cleanupRecurse {*}[glob -nocomplain -directory $p tf* td*]
     }
 }
 
@@ -245,8 +250,9 @@ test winFCmd-1.23 {TclpRenameFile: move dir into self} -setup {
 test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup {
     cleanup
 } -constraints {win testfile} -body {
+    # Error code depends on Windows version
     testfile mv / c:/
-} -returnCodes error -result EINVAL
+} -returnCodes error -result {^(EINVAL|ENOENT)$} -match regexp
 test winFCmd-1.25 {TclpRenameFile: cross file systems} -setup {
     cleanup
 } -constraints {win cdrom testfile} -body {
@@ -379,12 +385,12 @@ test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
     cleanup
 } -constraints {win winNonZeroInodes knownMsvcBug notInCIenv} -body {
     file mkdir td1
-    foreach {a b} [MakeFiles td1] break
+    lassign [MakeFiles td1] a b
     file rename -force $a $b
     file exists $a
 } -cleanup {
     cleanup
-} -result {0}
+} -result 0
 
 
 test winFCmd-2.1 {TclpCopyFile: errno: EACCES} -setup {
@@ -450,11 +456,11 @@ test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} -setup {
     cleanup
 } -constraints {win testfile} -body {
     createfile tf1 tf1
-    testchmod 0 tf1
+    file attribute tf1 -readonly 1
     testfile cp tf1 tf2
     list [contents tf2] [file writable tf2]
 } -cleanup {
-    catch {testchmod 0o666 tf1}
+    testchmod 0o660 tf1
     cleanup
 } -result {tf1 0}
 test winFCmd-2.13 {TclpCopyFile: CopyFile fails} -setup {
@@ -496,11 +502,10 @@ test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup {
 } -constraints {win testfile testchmod} -body {
     createfile tf1 tf1
     createfile tf2 tf2
-    testchmod 0 tf2
+    file attribute tf2 -readonly 1
     testfile cp tf1 tf2
     list [file writable tf2] [contents tf2]
 } -cleanup {
-    catch {testchmod 0o666 tf2}
     cleanup
 } -result {1 tf1}
 
@@ -578,7 +583,6 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup {
     testfile rm tf1
 } -cleanup {
     close $fd
-    catch {testchmod 0o666 tf1}
     cleanup
 } -returnCodes error -result EACCES
 
@@ -617,15 +621,18 @@ test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} -setup {
 
 test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
     cleanup
-} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body {
-    file mkdir td1
-    testchmod 0 td1
-    testfile rmdir td1
-    file exists td1
+} -constraints {win testfile testchmod notInCIenv} -body {
+    # Parent's FILE_DELETE_CHILD setting permits deletion of subdir
+    # even when subdir DELETE mask is clear. So we need an intermediate
+    # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W.
+    file mkdir td0/td1
+    testchmod 0o777 td0
+    testchmod 0 td0/td1
+    testfile rmdir td0/td1
+    file exists td0/td1
 } -returnCodes error -cleanup {
-    catch {testchmod 0o666 td1}
     cleanup
-} -result {td1 EACCES}
+} -result {td0/td1 EACCES}
 # This next test has a very hokey way of matching...
 test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} -setup {
     cleanup
@@ -633,7 +640,7 @@ test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} -setup {
     file mkdir td1/td2
     list [catch {testfile rmdir td1} msg] [file tail $msg]
 } -result {1 {td1 EEXIST}}
-test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest} {
+test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest trashSystem} {
     # can't test this w/o removing everything on your hard disk first!
     # testfile rmdir /
 } {}
@@ -669,17 +676,7 @@ test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup {
     createfile tf1
     list [catch {testfile rmdir tf1} msg] [file tail $msg]
 } -result {1 {tf1 ENOTDIR}}
-test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
-    cleanup
-} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body {
-    file mkdir td1
-    testchmod 0 td1
-    testfile rmdir td1
-    file exists td1
-} -returnCodes error -cleanup {
-    catch {testchmod 0o666 td1}
-    cleanup
-} -result {td1 EACCES}
+# winFCmd-6.9 removed - was exact dup of winFCmd-6.1
 test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
     cleanup
 } -constraints {win testfile notInCIenv} -body {
@@ -689,15 +686,19 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
 } -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
 test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
     cleanup
-} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body {
-    file mkdir td1
-    testchmod 0 td1
-    testfile rmdir td1
-    file exists td1
+} -constraints {win testfile testchmod notInCIenv} -body {
+    # Parent's FILE_DELETE_CHILD setting permits deletion of subdir
+    # even when subdir DELETE mask is clear. So we need an intermediate
+    # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W.
+    file mkdir td0/td1
+    testchmod 0o770 td0
+    testchmod 0o444 td0/td1
+    testfile rmdir td0/td1
+    file exists td0/td1
 } -cleanup {
-    catch {testchmod 0o666 td1}
+    testchmod 0o770 td0/td1
     cleanup
-} -returnCodes error -result {td1 EACCES}
+} -returnCodes error -result {td0/td1 EACCES}
 # This next test has a very hokey way of matching...
 test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
     cleanup
@@ -791,11 +792,12 @@ test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup {
 } -constraints {win testfile testchmod} -body {
     file mkdir td1
     createfile td1/tf1 tf1
-    testchmod 0 td1
+    testchmod 0o770 td1/tf1; # Else tf2 will have no ACL after td1 testchmod
+    testchmod 0o400 td1
     testfile cpdir td1 td2
     list [file exists td2] [file writable td2]
 } -cleanup {
-    catch {testchmod 0o666 td1}
+    testchmod 0o660 td1
     cleanup
 } -result {1 1}
 test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} -setup {
@@ -862,11 +864,12 @@ test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} -setup {
 } -constraints {win testfile testchmod} -body {
     file mkdir td1
     createfile td1/tf1 tf1
-    testchmod 0 td1
+    testchmod 0o770 td1/tf1; # Else tf2 will have no ACL after td1 testchmod
+    testchmod 0o400 td1
     testfile cpdir td1 td2
     list [file exists td2] [file writable td2]
 } -cleanup {
-    catch {testchmod 0o666 td1}
+    testchmod 0o660 td1
     cleanup
 } -result {1 1}
 test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} -setup {
@@ -893,11 +896,12 @@ test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} -setup {
     cleanup
 } -constraints {win testfile testchmod} -body {
     file mkdir td1/td2
-    testchmod 0 td1
+    testchmod 0o770 td1/td2; # Else td2 will have no ACL after td1 testchmod
+    testchmod 0o400 td1
     testfile cpdir td1 td2
     list [file writable td1] [file writable td1/td2]
 } -cleanup {
-    catch {testchmod 0o666 td1}
+    testchmod 0o660 td1
     cleanup
 } -result {0 1}
 test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} -setup {
@@ -918,15 +922,19 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
 } -result {}
 test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
     cleanup
-} -constraints {win testfile testchmod knownMsvcBug notInCIenv} -body {
-    file mkdir td1/td2
-    testchmod 0 td1
-    testfile rmdir -force td1
+} -constraints {win testfile testchmod notInCIenv} -body {
+    # Parent's FILE_DELETE_CHILD setting permits deletion of subdir
+    # even when subdir DELETE mask is clear. So we need an intermediate
+    # parent td0 with FILE_DELETE_CHILD turned off while allowing R/W.
+    file mkdir td0/td1/td2
+    testchmod 0o770 td0
+    testchmod 0o400 td0/td1
+    testfile rmdir -force td0/td1
     file exists td1
 } -cleanup {
-    catch {testchmod 0o666 td1}
+    testchmod 0o770 td0/td1
     cleanup
-} -returnCodes error -result {td1 EACCES}
+} -returnCodes error -result {td0/td1 EACCES}
 test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} -setup {
     cleanup
 } -constraints {win testfile} -body {
@@ -1417,7 +1425,6 @@ test winFCmd-19.9 {Windows devices path names} -constraints win -body {
 #    }
 #}
 
-# cleanup
 cleanup
 ::tcltest::cleanupTests
 return
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 1b2718e..da057d8 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1071,9 +1071,9 @@ install-libraries: libraries
 	@echo "Installing package msgcat 1.7.1 as a Tcl Module"
 	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
 		"$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm"
-	@echo "Installing package tcltest 2.5.5 as a Tcl Module"
+	@echo "Installing package tcltest 2.5.6 as a Tcl Module"
 	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
-		"$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.5.tm"
+		"$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.6.tm"
 	@echo "Installing package platform 1.0.19 as a Tcl Module"
 	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
 		"$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm"
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 70dfc61..0be10ad 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -1033,10 +1033,10 @@ TcpGetOptionProc(
 
     if ((len == 0) || ((len > 1) && (optionName[1] == 'k') &&
 	    (strncmp(optionName, "-keepalive", len) == 0))) {
+	int opt = 0;
 #if defined(SO_KEEPALIVE)
-	socklen_t size;
+	socklen_t size = sizeof(opt);
 #endif
-	int opt = 0;
 
 	if (len == 0) {
 	    Tcl_DStringAppendElement(dsPtr, "-keepalive");
@@ -1053,10 +1053,10 @@ TcpGetOptionProc(
 
     if ((len == 0) || ((len > 1) && (optionName[1] == 'n') &&
 	    (strncmp(optionName, "-nodelay", len) == 0))) {
+	int opt = 0;
 #if defined(SOL_TCP) && defined(TCP_NODELAY)
-	socklen_t size;
+	socklen_t size = sizeof(opt);
 #endif
-	int opt = 0;
 
 	if (len == 0) {
 	    Tcl_DStringAppendElement(dsPtr, "-nodelay");
diff --git a/win/Makefile.in b/win/Makefile.in
index 6d7bb7d..202b860 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -889,8 +889,8 @@ install-libraries: libraries install-tzdata install-msgs
 	    done;
 	@echo "Installing package msgcat 1.7.1 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm";
-	@echo "Installing package tcltest 2.5.5 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.5.tm";
+	@echo "Installing package tcltest 2.5.6 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.6.tm";
 	@echo "Installing package platform 1.0.19 as a Tcl Module";
 	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm";
 	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 0e86611..7c3d8a4 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -379,7 +379,7 @@ TclWinDriveLetterForVolMountPoint(
 	    if (!alreadyStored) {
 		dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap));
 		dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target);
-		dlPtr2->driveLetter = (char) drive[0];
+		dlPtr2->driveLetter = (WCHAR) drive[0];
 		dlPtr2->nextPtr = driveLetterLookup;
 		driveLetterLookup = dlPtr2;
 	    }
@@ -405,7 +405,7 @@ TclWinDriveLetterForVolMountPoint(
 
     dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap));
     dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint);
-    dlPtr2->driveLetter = -1;
+    dlPtr2->driveLetter = (WCHAR)-1;
     dlPtr2->nextPtr = driveLetterLookup;
     driveLetterLookup = dlPtr2;
     Tcl_MutexUnlock(&mountPointMap);
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 166636c..f0ee718 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -700,7 +700,7 @@ FileInputProc(
 
     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
 	    (LPOVERLAPPED) NULL) != FALSE) {
-	return bytesRead;
+	return (int)bytesRead;
     }
 
     Tcl_WinConvertError(GetLastError());
@@ -757,7 +757,7 @@ FileOutputProc(
 	return -1;
     }
     infoPtr->dirty = 1;
-    return bytesWritten;
+    return (int)bytesWritten;
 }
 
 /*
@@ -1572,7 +1572,7 @@ NativeIsComPort(
     const WCHAR *nativePath)	/* Path of file to access, native encoding. */
 {
     const WCHAR *p = (const WCHAR *) nativePath;
-    int i, len = wcslen(p);
+    size_t i, len = wcslen(p);
 
     /*
      * 1. Look for com[1-9]:?
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index c7159b7..3e5cff5 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1485,7 +1485,6 @@ TclpGetUserHome(
 		HANDLE hToken;
 		if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) {
 		    if (GetUserProfileDirectoryW(hToken, buf, &nChars)) {
-			Tcl_DStringInit(bufferPtr);
 			result = Tcl_WCharToUtfDString(buf, nChars-1, (bufferPtr));
 			rc = 1;
 		    }
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
index 364673e..3131286 100644
--- a/win/tclWinPanic.c
+++ b/win/tclWinPanic.c
@@ -56,10 +56,10 @@ Tcl_ConsolePanic(
     if (IsDebuggerPresent()) {
 	OutputDebugStringW(msgString);
     } else if (_isatty(2)) {
-	WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
+	WriteConsoleW(handle, msgString, (DWORD)wcslen(msgString), &dummy, 0);
     } else {
 	buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */
-	WriteFile(handle, buf, strlen(buf), &dummy, 0);
+	WriteFile(handle, buf, (DWORD)strlen(buf), &dummy, 0);
 	WriteFile(handle, "\n", 1, &dummy, 0);
 	FlushFileBuffers(handle);
     }
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index c910bc5..0f65268 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -22,9 +22,8 @@
 /*
  * For TestplatformChmod on Windows
  */
-#ifdef _WIN32
 #include <aclapi.h>
-#endif
+#include <sddl.h>
 
 /*
  * MinGW 3.4.2 does not define this.
@@ -414,176 +413,189 @@ TestExceptionCmd(
     return TCL_OK;
 }
 
+/*
+ * This "chmod" works sufficiently for test script purposes. Do not expect
+ * it to be exact emulation of Unix chmod (not sure if that's even possible)
+ */
 static int
 TestplatformChmod(
     const char *nativePath,
     int pmode)
 {
-    static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
-	    | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
-    /* don't reset change permissions mask (WRITE_DAC, allow test-cases restore it to cleanup) */
-    static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
-	    | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
-	    | FILE_WRITE_DATA
-	    | DELETE;
-
     /*
-     * References to security functions (only available on NT and later).
+     * Note FILE_DELETE_CHILD missing from dirWriteMask because we do
+     * not want overriding of child's delete setting when testing
      */
-
-    const BOOL set_readOnly = !(pmode & 0222);
-    BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted;
-    SID_IDENTIFIER_AUTHORITY userSidAuthority = {
-	SECURITY_WORLD_SID_AUTHORITY
-    };
-    BYTE *secDesc = 0;
-    DWORD secDescLen, attr, newAclSize;
-    ACL_SIZE_INFORMATION ACLSize;
-    PACL curAcl, newAcl = 0;
-    WORD j;
-    SID *userSid = 0;
-    char *userDomain = 0;
+    static const DWORD dirWriteMask =
+	FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA |
+	FILE_ADD_FILE | FILE_ADD_SUBDIRECTORY | STANDARD_RIGHTS_WRITE | DELETE |
+	SYNCHRONIZE;
+    static const DWORD dirReadMask =
+	FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_LIST_DIRECTORY |
+	STANDARD_RIGHTS_READ | SYNCHRONIZE;
+    /* Note - default user privileges allow ignoring TRAVERSE setting */
+    static const DWORD dirExecuteMask =
+	FILE_TRAVERSE | STANDARD_RIGHTS_READ | SYNCHRONIZE;
+
+    static const DWORD fileWriteMask =
+	FILE_WRITE_ATTRIBUTES | FILE_WRITE_EA | FILE_WRITE_DATA |
+	FILE_APPEND_DATA | STANDARD_RIGHTS_WRITE | DELETE | SYNCHRONIZE;
+    static const DWORD fileReadMask =
+	FILE_READ_ATTRIBUTES | FILE_READ_EA | FILE_READ_DATA |
+	STANDARD_RIGHTS_READ | SYNCHRONIZE;
+    static const DWORD fileExecuteMask =
+	FILE_EXECUTE | STANDARD_RIGHTS_READ | SYNCHRONIZE;
+
+    DWORD attr, newAclSize;
+    PACL newAcl = NULL;
     int res = 0;
 
-    /*
-     * Process the chmod request.
-     */
+    HANDLE hToken = NULL;
+    int i;
+    int nSids = 0;
+    struct {
+	PSID pSid;
+	DWORD mask;
+	DWORD sidLen;
+    } aceEntry[3];
+    DWORD dw;
+    int isDir;
+    TOKEN_USER *pTokenUser = NULL;
 
-    attr = GetFileAttributesA(nativePath);
-
-    /*
-     * nativePath not found
-     */
+    res = -1; /* Assume failure */
 
+    attr = GetFileAttributesA(nativePath);
     if (attr == 0xFFFFFFFF) {
-	res = -1;
-	goto done;
+	goto done; /* Not found */
     }
 
-    /*
-     * If nativePath is not a directory, there is no special handling.
-     */
+    isDir = (attr & FILE_ATTRIBUTE_DIRECTORY) != 0;
 
-    if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
+    if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hToken)) {
 	goto done;
     }
 
-    /*
-     * Set the result to error, if the ACL change is successful it will be
-     * reset to 0.
-     */
-
-    res = -1;
-
-    /*
-     * Read the security descriptor for the directory. Note the first call
-     * obtains the size of the security descriptor.
-     */
-
-    if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
-	DWORD secDescLen2 = 0;
-
-	if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
-	    goto done;
-	}
-
-	secDesc = (BYTE *)ckalloc(secDescLen);
-	if (!GetFileSecurityA(nativePath, infoBits,
-		(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
-		|| (secDescLen < secDescLen2)) {
-	    goto done;
-	}
-    }
-
-    /*
-     * Get the World SID.
-     */
-
-    userSid = (SID *)ckalloc(GetSidLengthRequired((UCHAR) 1));
-    InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
-    *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;
-
-    /*
-     * If curAclPresent == false then curAcl and curAclDefaulted not valid.
-     */
-
-    if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc,
-	    &curAclPresent, &curAcl, &curAclDefaulted)) {
+    /* Get process SID */
+    if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) &&
+	GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
 	goto done;
     }
-    if (!curAclPresent || !curAcl) {
-	ACLSize.AclBytesInUse = 0;
-	ACLSize.AceCount = 0;
-    } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize),
-	    AclSizeInformation)) {
+    pTokenUser = (TOKEN_USER *)ckalloc(dw);
+    if (!GetTokenInformation(hToken, TokenUser, pTokenUser, dw, &dw)) {
 	goto done;
     }
-
-    /*
-     * Allocate memory for the new ACL.
-     */
-
-    newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
-	    + GetLengthSid(userSid) - sizeof(DWORD);
-    newAcl = (PACL) ckalloc(newAclSize);
-
-    /*
-     * Initialize the new ACL.
-     */
-
-    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
+    aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid);
+    aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen);
+    if (!CopySid(aceEntry[nSids].sidLen,
+		 aceEntry[nSids].pSid,
+		 pTokenUser->User.Sid)) {
+	ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
 	goto done;
     }
-
     /*
-     * Add denied to make readonly, this will be known as a "read-only tag".
+     * Always include DACL modify rights so we don't get locked out
      */
-
-    if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION,
-	    readOnlyMask, userSid)) {
-	goto done;
+    aceEntry[nSids].mask = READ_CONTROL | WRITE_DAC | WRITE_OWNER | SYNCHRONIZE |
+			   FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES;
+    if (pmode & 0700) {
+	/* Owner permissions. Assumes current process is owner */
+	if (pmode & 0400) {
+	    aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask;
+	}
+	if (pmode & 0200) {
+	    aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask;
+	}
+	if (pmode & 0100) {
+	    aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask;
+	}
     }
+    ++nSids;
 
-    acl_readOnly_found = FALSE;
-    for (j = 0; j < ACLSize.AceCount; j++) {
-	LPVOID pACE2;
-	ACE_HEADER *phACE2;
+    if (pmode & 0070) {
+	/* Group permissions. */
 
-	if (!GetAce(curAcl, j, &pACE2)) {
+	TOKEN_PRIMARY_GROUP *pTokenGroup;
+
+	/* Get primary group SID */
+	if (!GetTokenInformation(
+		hToken, TokenPrimaryGroup, NULL, 0, &dw) &&
+		GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
 	    goto done;
 	}
+	pTokenGroup = (TOKEN_PRIMARY_GROUP *)ckalloc(dw);
+	if (!GetTokenInformation(hToken, TokenPrimaryGroup, pTokenGroup, dw, &dw)) {
+	    ckfree(pTokenGroup);
+	    goto done;
+	}
+	aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup);
+	aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen);
+	if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenGroup->PrimaryGroup)) {
+	    ckfree(pTokenGroup);
+	    ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
+	    goto done;
+	}
+	ckfree(pTokenGroup);
 
-	phACE2 = (ACE_HEADER *) pACE2;
-
-	/*
-	 * Do NOT propagate inherited ACEs.
-	 */
+	/* Generate mask for group ACL */
 
-	if (phACE2->AceFlags & INHERITED_ACE) {
-	    continue;
+	aceEntry[nSids].mask = 0;
+	if (pmode & 0040) {
+	    aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask;
 	}
+	if (pmode & 0020) {
+	    aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask;
+	}
+	if (pmode & 0010) {
+	    aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask;
+	}
+	++nSids;
+    }
 
-	/*
-	 * Skip the "read-only tag" restriction (either added above, or it is
-	 * being removed).
-	 */
+    if (pmode & 0007) {
+	/* World permissions */
+	PSID pWorldSid;
+	if (!ConvertStringSidToSidA("S-1-1-0", &pWorldSid)) {
+	    goto done;
+	}
+	aceEntry[nSids].sidLen = GetLengthSid(pWorldSid);
+	aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen);
+	if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pWorldSid)) {
+	    LocalFree(pWorldSid);
+	    ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */
+	    goto done;
+	}
+	LocalFree(pWorldSid);
 
-	if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
-	    ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2;
+	/* Generate mask for world ACL */
 
-	    if (pACEd->Mask == readOnlyMask
-		    && EqualSid(userSid, (PSID) &pACEd->SidStart)) {
-		acl_readOnly_found = TRUE;
-		continue;
-	    }
+	aceEntry[nSids].mask = 0;
+	if (pmode & 0004) {
+	    aceEntry[nSids].mask |= isDir ? dirReadMask : fileReadMask;
+	}
+	if (pmode & 0002) {
+	    aceEntry[nSids].mask |= isDir ? dirWriteMask : fileWriteMask;
 	}
+	if (pmode & 0001) {
+	    aceEntry[nSids].mask |= isDir ? dirExecuteMask : fileExecuteMask;
+	}
+	++nSids;
+    }
 
-	/*
-	 * Copy the current ACE from the old to the new ACL.
-	 */
+    /* Allocate memory and initialize the new ACL. */
 
-	if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
-		((PACE_HEADER) pACE2)->AceSize)) {
+    newAclSize = sizeof(ACL);
+    /* Add in size required for each ACE entry in the ACL */
+    for (i = 0; i < nSids; ++i) {
+	newAclSize +=
+	    offsetof(ACCESS_ALLOWED_ACE, SidStart) + aceEntry[i].sidLen;
+    }
+    newAcl = (PACL)ckalloc(newAclSize);
+    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
+	goto done;
+    }
+
+    for (i = 0; i < nSids; ++i) {
+	if (!AddAccessAllowedAce(newAcl, ACL_REVISION, aceEntry[i].mask, aceEntry[i].pSid)) {
 	    goto done;
 	}
     }
@@ -593,36 +605,38 @@ TestplatformChmod(
      * to remove inherited ACL (we need to overwrite the default ACL's in this case)
      */
 
-    if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
-	    (LPSTR) nativePath, SE_FILE_OBJECT,
-	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
-	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
+    if (SetNamedSecurityInfoA((LPSTR)nativePath,
+			      SE_FILE_OBJECT,
+			      DACL_SECURITY_INFORMATION |
+				  PROTECTED_DACL_SECURITY_INFORMATION,
+			      NULL,
+			      NULL,
+			      newAcl,
+			      NULL) == ERROR_SUCCESS) {
 	res = 0;
     }
 
   done:
-    if (secDesc) {
-	ckfree(secDesc);
+    if (pTokenUser) {
+	ckfree(pTokenUser);
+    }
+    if (hToken) {
+	CloseHandle(hToken);
     }
     if (newAcl) {
 	ckfree(newAcl);
     }
-    if (userSid) {
-	ckfree(userSid);
-    }
-    if (userDomain) {
-	ckfree(userDomain);
+    for (i = 0; i < nSids; ++i) {
+	ckfree(aceEntry[i].pSid);
     }
 
     if (res != 0) {
 	return res;
     }
 
-    /*
-     * Run normal chmod command.
-     */
-
+    /* Run normal chmod command */
     return chmod(nativePath, pmode);
+
 }
 
 /*