From d3aa6839f45e33d533ae9525378612cb04ab0dd1 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Fri, 3 Mar 2023 12:15:11 +0000
Subject: Fix Valgrind "still reachable" report in TestcmdtokenCmd().

---
 generic/tclTest.c  | 44 ++++++++++++++++++++++++++++++--------------
 tests/basic.test   |  6 +++---
 tests/cmdInfo.test |  6 +++---
 3 files changed, 36 insertions(+), 20 deletions(-)

diff --git a/generic/tclTest.c b/generic/tclTest.c
index f4450ff..fbd4774 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1242,7 +1242,7 @@ TestcmdtokenCmd(
     int argc,			/* Number of arguments. */
     const char **argv)		/* Argument strings. */
 {
-    TestCommandTokenRef *refPtr;
+    TestCommandTokenRef *refPtr, *prevRefPtr;
     char buf[30];
     int id;
 
@@ -1261,9 +1261,7 @@ TestcmdtokenCmd(
 	firstCommandTokenRef = refPtr;
 	sprintf(buf, "%d", refPtr->id);
 	Tcl_AppendResult(interp, buf, NULL);
-    } else if (strcmp(argv[1], "name") == 0) {
-	Tcl_Obj *objPtr;
-
+    } else {
 	if (sscanf(argv[2], "%d", &id) != 1) {
 	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
 		    "\"", NULL);
@@ -1283,18 +1281,36 @@ TestcmdtokenCmd(
 	    return TCL_ERROR;
 	}
 
-	objPtr = Tcl_NewObj();
-	Tcl_GetCommandFullName(interp, refPtr->token, objPtr);
+	if (strcmp(argv[1], "name") == 0) {
+	    Tcl_Obj *objPtr;
 
-	Tcl_AppendElement(interp,
-		Tcl_GetCommandName(interp, refPtr->token));
-	Tcl_AppendElement(interp, Tcl_GetString(objPtr));
-	Tcl_DecrRefCount(objPtr);
-    } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create or name", NULL);
-	return TCL_ERROR;
+	    objPtr = Tcl_NewObj();
+	    Tcl_GetCommandFullName(interp, refPtr->token, objPtr);
+
+	    Tcl_AppendElement(interp,
+		    Tcl_GetCommandName(interp, refPtr->token));
+	    Tcl_AppendElement(interp, Tcl_GetString(objPtr));
+	    Tcl_DecrRefCount(objPtr);
+	} else if (strcmp(argv[1], "free") == 0) {
+	    prevRefPtr = NULL;
+	    for (refPtr = firstCommandTokenRef; refPtr != NULL;
+		    refPtr = refPtr->nextPtr) {
+		if (refPtr->id == id) {
+		    if (prevRefPtr != NULL) {
+			prevRefPtr->nextPtr = refPtr->nextPtr;
+		    }
+		    ckfree(refPtr);
+		    break;
+		}
+		prevRefPtr = refPtr;
+	    }
+	} else {
+	    Tcl_AppendResult(interp, "bad option \"", argv[1],
+		    "\": must be create, name, or free", NULL);
+	    return TCL_ERROR;
+	}
     }
+
     return TCL_OK;
 }
 
diff --git a/tests/basic.test b/tests/basic.test
index f4c57fe..de986c7 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -336,19 +336,19 @@ test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespace
     }]
     list [testcmdtoken name $x] \
          [rename ::p q] \
-         [testcmdtoken name $x]
+         [testcmdtoken name $x][testcmdtoken free $x]
 } {{p ::p} {} {q ::q}}
 test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {testcmdtoken} {
     catch {rename q ""}
     set x [testcmdtoken create test_ns_basic::test_ns_basic2::p]
     list [testcmdtoken name $x] \
          [rename test_ns_basic::test_ns_basic2::p q] \
-         [testcmdtoken name $x]
+         [testcmdtoken name $x][testcmdtoken free $x]
 } {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}}
 test basic-20.3 {Tcl_GetCommandInfo, #-quoting} testcmdtoken {
     catch {rename \# ""}
     set x [testcmdtoken create \#]
-    testcmdtoken name $x
+    return [testcmdtoken name $x][testcmdtoken free $x]
 } {{#} ::#}
 
 test basic-21.1 {Tcl_GetCommandName} {emptyTest} {
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index 37b8a0b..ad564d7 100644
--- a/tests/cmdInfo.test
+++ b/tests/cmdInfo.test
@@ -70,7 +70,7 @@ test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \
     rename x1 newName
     set y [testcmdtoken name $x]
     rename newName x1
-    lappend y {*}[testcmdtoken name $x]
+    lappend y {*}[testcmdtoken name $x][testcmdtoken free $x]
 } {newName ::newName x1 ::x1}
 
 catch {rename newTestCmd {}}
@@ -87,7 +87,7 @@ test cmdinfo-5.1 {Names for commands created when inside namespaces} \
     }]
     set y [testcmdtoken name $x]
     rename ::testCmd newTestCmd
-    lappend y {*}[testcmdtoken name $x]
+    lappend y {*}[testcmdtoken name $x][testcmdtoken free $x]
 } {testCmd ::testCmd newTestCmd ::newTestCmd}
 
 test cmdinfo-6.1 {Names for commands created when outside namespaces} \
@@ -95,7 +95,7 @@ test cmdinfo-6.1 {Names for commands created when outside namespaces} \
     set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
     set y [testcmdtoken name $x]
     rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
-    lappend y {*}[testcmdtoken name $x]
+    lappend y {*}[testcmdtoken name $x][testcmdtoken free $x]
 } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
 
 # cleanup
-- 
cgit v0.12


From 6285c1336732a6a7db1fc3627dad6fe6176fbee6 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sat, 4 Mar 2023 10:08:18 +0000
Subject: Fix [1b8df10110]: Tcl_GetTime returns wrong usec value on Windows

---
 generic/tclDecls.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 6723069..8fc926c 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4035,7 +4035,7 @@ extern const TclStubs *tclStubsPtr;
 /* Handle Win64 tk.dll being loaded in Cygwin64. */
 #	define Tcl_GetTime(t) \
 		do { \
-		    union { \
+		    struct { \
 			Tcl_Time now; \
 			__int64 reserved; \
 		    } _t; \
-- 
cgit v0.12


From e13edcba869deda8b613854d533c106c9855b61d Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sat, 4 Mar 2023 10:18:41 +0000
Subject: Test constraint notInCIenv no longer necessary (due to previous fix)

---
 tests/winTime.test | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/tests/winTime.test b/tests/winTime.test
index 68be966..ed8b625 100644
--- a/tests/winTime.test
+++ b/tests/winTime.test
@@ -19,9 +19,6 @@ if {"::tcltest" ni [namespace children]} {
 catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testwinclock [llength [info commands testwinclock]]
-# Some things fail under all Continuous Integration systems for subtle reasons
-# such as CI often running with elevated privileges in a container.
-testConstraint notInCIenv   [expr {![info exists ::env(CI)]}]
 
 # The next two tests will crash on Windows if the check for negative
 # clock values is not done properly.
@@ -43,7 +40,7 @@ test winTime-1.2 {TclpGetDate} {win} {
 # with the Windows clock.  30 sec really isn't enough,
 # but how much time does a tester have patience for?
 
-test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock notInCIenv} {
+test winTime-2.1 {Synchronization of Tcl and Windows clocks} testwinclock {
     # May fail due to OS/hardware discrepancies.  See:
     # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323
     set failed {}
-- 
cgit v0.12


From 0229ba1283c2457c63df5674f54831eeb4a120ca Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Sat, 4 Mar 2023 12:13:31 +0000
Subject: Bug [9c5a00c69d]. Tilde expansion on Windows

---
 win/tclWinFile.c | 73 +++++++++++++++++++++++++++-----------------------------
 1 file changed, 35 insertions(+), 38 deletions(-)

diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 9a6c5f1..639cd72 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1458,22 +1458,43 @@ TclpGetUserHome(
     if (domain == NULL) {
 	const char *ptr;
 
-	/*
-	 * No domain. Firstly check it's the current user
-	 */
-
+        /*
+         * Treat the current user as a special case because the general case
+         * below does not properly retrieve the path. The NetUserGetInfo
+         * call returns an empty path and the code defaults to the user's
+         * name in the profiles directory. On modern Windows systems, this
+         * is generally wrong as when the account is a Microsoft account,
+         * for example abcdefghi@outlook.com, the directory name is
+         * abcde and not abcdefghi.
+         *
+         * Note we could have just used env(USERPROFILE) here but
+         * the intent is to retrieve (as on Unix) the system's view
+         * of the home irrespective of environment settings of HOME
+         * and USERPROFILE.
+         *
+         * Fixing this for the general user needs more investigating but
+         * at least for the current user we can use a direct call.
+         */
 	ptr = TclpGetUserName(&ds);
 	if (ptr != NULL && strcasecmp(name, ptr) == 0) {
-	    /*
-	     * Try safest and fastest way to get current user home
-	     */
-
-	    ptr = TclGetEnv("HOME", &ds);
-	    if (ptr != NULL) {
-		Tcl_JoinPath(1, &ptr, bufferPtr);
-		rc = 1;
-		result = Tcl_DStringValue(bufferPtr);
-	    }
+            HANDLE hProcess;
+            WCHAR buf[MAX_PATH];
+            DWORD nChars = sizeof(buf) / sizeof(buf[0]);
+            /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */
+            hProcess = GetCurrentProcess(); /* Need not be closed */
+            if (hProcess) {
+                HANDLE hToken;
+                if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) {
+                    if (GetUserProfileDirectoryW(hToken, buf, &nChars)) {
+                        Tcl_WinTCharToUtf((TCHAR *)buf,
+                                          (nChars-1)*sizeof(WCHAR),
+                                          bufferPtr);
+                        result = Tcl_DStringValue(bufferPtr);
+                        rc = 1;
+                    }
+                    CloseHandle(hToken);
+                }
+            }
 	}
 	Tcl_DStringFree(&ds);
     } else {
@@ -1542,30 +1563,6 @@ TclpGetUserHome(
     if (wDomain != NULL) {
 	NetApiBufferFree((void *) wDomain);
     }
-    if (result == NULL) {
-	/*
-	 * Look in the "Password Lists" section of system.ini for the local
-	 * user. There are also entries in that section that begin with a "*"
-	 * character that are used by Windows for other purposes; ignore user
-	 * names beginning with a "*".
-	 */
-
-	char buf[MAX_PATH];
-
-	if (name[0] != '*') {
-	    if (GetPrivateProfileStringA("Password Lists", name, "", buf,
-		    MAX_PATH, "system.ini") > 0) {
-		/*
-		 * User exists, but there is no such thing as a home directory
-		 * in system.ini. Return "{Windows drive}:/".
-		 */
-
-		GetWindowsDirectoryA(buf, MAX_PATH);
-		Tcl_DStringAppend(bufferPtr, buf, 3);
-		result = Tcl_DStringValue(bufferPtr);
-	    }
-	}
-    }
 
     return result;
 }
-- 
cgit v0.12


From c862e5709590a9330c9b814109a0fbfd70f027cb Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Sat, 4 Mar 2023 15:11:01 +0000
Subject: Add test for [9c5a00c69d], tilde expansion of ~user

---
 tests/fileSystem.test | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index f363d86..2de778a 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -277,6 +277,16 @@ test filesystem-1.30.1 {normalisation of existing user} -body {
 test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body {
     file normalize ~nonexistentuser@nonexistentdomain
 } -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist}
+test filesystem-1.30.3 {file normalization should distinguish between ~ and ~user} -setup {
+    set oldhome $::env(HOME)
+    set olduserhome [file normalize ~$::tcl_platform(user)]
+    set ::env(HOME) [file join $oldhome temp]
+} -cleanup {
+    set env(HOME) $oldhome
+} -body {
+    list [string equal [file normalize ~] $::env(HOME)] \
+        [string equal $olduserhome [file normalize ~$::tcl_platform(user)]]
+} -result {1 1}
 test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
     testsetplatform unix
     file normalize /foo/../bar
-- 
cgit v0.12


From 7b3ef36925e938aa7a1aff22d3d3e521e32f243d Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Sat, 4 Mar 2023 16:26:00 +0000
Subject: Protect zlib errors with check for null interp

---
 generic/tclZlib.c | 29 +++++++++++++++++++----------
 1 file changed, 19 insertions(+), 10 deletions(-)

diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index ce8da3c..cd3b3c5 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -449,12 +449,16 @@ GenerateHeader(
 		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
 		NULL);
 	if (result != TCL_OK) {
-	    if (result == TCL_CONVERT_UNKNOWN) {
-		Tcl_AppendResult(interp, "Comment contains characters > 0xFF", NULL);
-	    } else {
-		Tcl_AppendResult(interp, "Comment too large for zip", NULL);
+	    if (interp) {
+		if (result == TCL_CONVERT_UNKNOWN) {
+		    Tcl_AppendResult(
+			interp, "Comment contains characters > 0xFF", NULL);
+		}
+		else {
+		    Tcl_AppendResult(interp, "Comment too large for zip", NULL);
+		}
 	    }
-	    result = TCL_ERROR;
+	    result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR*/
 	    goto error;
 	}
 	headerPtr->nativeCommentBuf[len] = '\0';
@@ -481,12 +485,17 @@ GenerateHeader(
 		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len,
 		NULL);
 	if (result != TCL_OK) {
-	    if (result == TCL_CONVERT_UNKNOWN) {
-		Tcl_AppendResult(interp, "Filename contains characters > 0xFF", NULL);
-	    } else {
-		Tcl_AppendResult(interp, "Filename too large for zip", NULL);
+	    if (interp) {
+		if (result == TCL_CONVERT_UNKNOWN) {
+		    Tcl_AppendResult(
+			interp, "Filename contains characters > 0xFF", NULL);
+		}
+		else {
+		    Tcl_AppendResult(
+			interp, "Filename too large for zip", NULL);
+		}
 	    }
-	    result = TCL_ERROR;
+	    result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR*/
 	    goto error;
 	}
 	headerPtr->nativeFilenameBuf[len] = '\0';
-- 
cgit v0.12


From 76edd58c3e121255d2dae1c5bc1b2fc86d1ab3fc Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sun, 5 Mar 2023 07:11:15 +0000
Subject: A better fix for Valgrind "still reachable" report in
 TestcmdtokenCmd().

---
 generic/tclTest.c  | 56 ++++++++++++++++++++++++++++++++++++++----------------
 tests/basic.test   |  6 +++---
 tests/cmdInfo.test |  6 +++---
 3 files changed, 46 insertions(+), 22 deletions(-)

diff --git a/generic/tclTest.c b/generic/tclTest.c
index fbd4774..5b57157 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -70,6 +70,7 @@ static Tcl_Interp *delInterp;
 typedef struct TestCommandTokenRef {
     int id;			/* Identifier for this reference. */
     Tcl_Command token;		/* Tcl's token for the command. */
+    const char *value;
     struct TestCommandTokenRef *nextPtr;
 				/* Next in list of references. */
 } TestCommandTokenRef;
@@ -1179,6 +1180,18 @@ TestcmdinfoCmd(
 }
 
 static int
+CmdProc0(
+    void *clientData,	/* String to return. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    TCL_UNUSED(int) /*argc*/,
+    TCL_UNUSED(const char **) /*argv*/)
+{
+    TestCommandTokenRef *refPtr = (TestCommandTokenRef *) clientData;
+    Tcl_AppendResult(interp, "CmdProc1 ", refPtr->value, NULL);
+    return TCL_OK;
+}
+
+static int
 CmdProc1(
     void *clientData,	/* String to return. */
     Tcl_Interp *interp,		/* Current interpreter. */
@@ -1189,6 +1202,7 @@ CmdProc1(
     return TCL_OK;
 }
 
+
 static int
 CmdProc2(
     void *clientData,	/* String to return. */
@@ -1201,6 +1215,28 @@ CmdProc2(
 }
 
 static void
+CmdDelProc0(
+    void *clientData)	/* String to save. */
+{
+    TestCommandTokenRef *thisRefPtr, *prevRefPtr = NULL;
+    TestCommandTokenRef *refPtr = (TestCommandTokenRef *) clientData;
+    int id = refPtr->id;
+    for (thisRefPtr = firstCommandTokenRef; refPtr != NULL;
+	thisRefPtr = thisRefPtr->nextPtr) {
+	if (thisRefPtr->id == id) {
+	    if (prevRefPtr != NULL) {
+		prevRefPtr->nextPtr = thisRefPtr->nextPtr;
+	    } else {
+		firstCommandTokenRef = thisRefPtr->nextPtr; 
+	    }
+	    break;
+	}
+	prevRefPtr = thisRefPtr;
+    }
+    ckfree(refPtr);
+}
+
+static void
 CmdDelProc1(
     void *clientData)	/* String to save. */
 {
@@ -1242,7 +1278,7 @@ TestcmdtokenCmd(
     int argc,			/* Number of arguments. */
     const char **argv)		/* Argument strings. */
 {
-    TestCommandTokenRef *refPtr, *prevRefPtr;
+    TestCommandTokenRef *refPtr;
     char buf[30];
     int id;
 
@@ -1253,9 +1289,10 @@ TestcmdtokenCmd(
     }
     if (strcmp(argv[1], "create") == 0) {
 	refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef));
-	refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
-		(void *) "original", NULL);
+	refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc0,
+		refPtr, CmdDelProc0);
 	refPtr->id = nextCommandTokenRefId;
+	refPtr->value = "original";
 	nextCommandTokenRefId++;
 	refPtr->nextPtr = firstCommandTokenRef;
 	firstCommandTokenRef = refPtr;
@@ -1291,19 +1328,6 @@ TestcmdtokenCmd(
 		    Tcl_GetCommandName(interp, refPtr->token));
 	    Tcl_AppendElement(interp, Tcl_GetString(objPtr));
 	    Tcl_DecrRefCount(objPtr);
-	} else if (strcmp(argv[1], "free") == 0) {
-	    prevRefPtr = NULL;
-	    for (refPtr = firstCommandTokenRef; refPtr != NULL;
-		    refPtr = refPtr->nextPtr) {
-		if (refPtr->id == id) {
-		    if (prevRefPtr != NULL) {
-			prevRefPtr->nextPtr = refPtr->nextPtr;
-		    }
-		    ckfree(refPtr);
-		    break;
-		}
-		prevRefPtr = refPtr;
-	    }
 	} else {
 	    Tcl_AppendResult(interp, "bad option \"", argv[1],
 		    "\": must be create, name, or free", NULL);
diff --git a/tests/basic.test b/tests/basic.test
index de986c7..c90d80e 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -336,19 +336,19 @@ test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespace
     }]
     list [testcmdtoken name $x] \
          [rename ::p q] \
-         [testcmdtoken name $x][testcmdtoken free $x]
+         [testcmdtoken name $x]
 } {{p ::p} {} {q ::q}}
 test basic-20.2 {Tcl_GetCommandInfo, names for commands created outside namespaces} {testcmdtoken} {
     catch {rename q ""}
     set x [testcmdtoken create test_ns_basic::test_ns_basic2::p]
     list [testcmdtoken name $x] \
          [rename test_ns_basic::test_ns_basic2::p q] \
-         [testcmdtoken name $x][testcmdtoken free $x]
+         [testcmdtoken name $x]
 } {{p ::test_ns_basic::test_ns_basic2::p} {} {q ::q}}
 test basic-20.3 {Tcl_GetCommandInfo, #-quoting} testcmdtoken {
     catch {rename \# ""}
     set x [testcmdtoken create \#]
-    return [testcmdtoken name $x][testcmdtoken free $x]
+    return [testcmdtoken name $x]
 } {{#} ::#}
 
 test basic-21.1 {Tcl_GetCommandName} {emptyTest} {
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index ad564d7..37b8a0b 100644
--- a/tests/cmdInfo.test
+++ b/tests/cmdInfo.test
@@ -70,7 +70,7 @@ test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \
     rename x1 newName
     set y [testcmdtoken name $x]
     rename newName x1
-    lappend y {*}[testcmdtoken name $x][testcmdtoken free $x]
+    lappend y {*}[testcmdtoken name $x]
 } {newName ::newName x1 ::x1}
 
 catch {rename newTestCmd {}}
@@ -87,7 +87,7 @@ test cmdinfo-5.1 {Names for commands created when inside namespaces} \
     }]
     set y [testcmdtoken name $x]
     rename ::testCmd newTestCmd
-    lappend y {*}[testcmdtoken name $x][testcmdtoken free $x]
+    lappend y {*}[testcmdtoken name $x]
 } {testCmd ::testCmd newTestCmd ::newTestCmd}
 
 test cmdinfo-6.1 {Names for commands created when outside namespaces} \
@@ -95,7 +95,7 @@ test cmdinfo-6.1 {Names for commands created when outside namespaces} \
     set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
     set y [testcmdtoken name $x]
     rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
-    lappend y {*}[testcmdtoken name $x][testcmdtoken free $x]
+    lappend y {*}[testcmdtoken name $x]
 } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
 
 # cleanup
-- 
cgit v0.12


From 9d2cc36a0e82c13737990341fdb1bb9cb8fa68ca Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Sun, 5 Mar 2023 21:09:46 +0000
Subject: Fix [57bfcf43dd]: Remove unreachable code in Tcl_SetWideIntObj()

---
 generic/tclObj.c | 14 ++++----------
 1 file changed, 4 insertions(+), 10 deletions(-)

diff --git a/generic/tclObj.c b/generic/tclObj.c
index 531a256..a6e7698 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -3040,19 +3040,13 @@ Tcl_SetWideIntObj(
 	Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
     }
 
-    if ((wideValue >= (Tcl_WideInt) LONG_MIN)
-	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
-	TclSetLongObj(objPtr, (long) wideValue);
-    } else {
 #ifndef TCL_WIDE_INT_IS_LONG
+    if ((wideValue < (Tcl_WideInt) LONG_MIN)
+	    || (wideValue > (Tcl_WideInt) LONG_MAX)) {
 	TclSetWideIntObj(objPtr, wideValue);
-#else
-	mp_int big;
-
-	TclBNInitBignumFromWideInt(&big, wideValue);
-	Tcl_SetBignumObj(objPtr, &big);
+    } else
 #endif
-    }
+    TclSetLongObj(objPtr, (long) wideValue);
 }
 
 /*
-- 
cgit v0.12


From 40e214cd76ab0f9fe274bb7a27b56a40194254f7 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 6 Mar 2023 06:58:13 +0000
Subject: Add new valgrind suppression items.

---
 tools/valgrind_suppress | 137 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 137 insertions(+)

diff --git a/tools/valgrind_suppress b/tools/valgrind_suppress
index fb7f173..11ca880 100644
--- a/tools/valgrind_suppress
+++ b/tools/valgrind_suppress
@@ -1,3 +1,17 @@
+#{
+#    Tcl_GetChannelOption/TcpGetOptionProc/TcphostPortList/getnameinfo/gethostbyaddr_r
+#    Memcheck:Leak
+#    match-leak-kinds: reachable
+#    fun:malloc
+#    fun:strdup
+#    ...
+#    fun:module_load
+#    ...
+#    fun:getnameinfo
+#    ...
+#    fun:Tcl_GetChannelOption
+#}
+
 {
    TclCreatesocketAddress/getaddrinfo/calloc
    Memcheck:Leak
@@ -11,6 +25,16 @@
 {
    TclCreatesocketAddress/getaddrinfo/malloc
    Memcheck:Leak
+   match-leak-kinds: definite
+   fun:malloc
+   ...
+   fun:getaddrinfo
+   fun:TclCreateSocketAddress
+}
+
+{
+   TclCreatesocketAddress/getaddrinfo/malloc
+   Memcheck:Leak
    match-leak-kinds: reachable
    fun:malloc
    ...
@@ -19,6 +43,18 @@
 }
 
 {
+   TclpDlopen/decompose_rpath
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:malloc
+   fun:decompose_rpath
+   ...
+   fun:dlopen_doit
+   ...
+   fun:TclpDlopen
+}
+
+{
    TclpDlopen/load
    Memcheck:Leak
    match-leak-kinds: reachable
@@ -72,6 +108,46 @@
 }
 
 {
+    TclpGeHostByName/gethostbyname_r/strdup/malloc
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:malloc
+    fun:strdup
+    ...
+    fun:dl_open_worker
+    ...
+    fun:do_dlopen
+    ...
+    fun:TclpGetHostByName
+}
+
+{
+    TclpGeHostByName/gethostbyname_r/calloc
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:calloc
+    ...
+    fun:dl_open_worker
+    ...
+    fun:do_dlopen
+    ...
+    fun:TclpGetHostByName
+}
+
+{
+    TclpGeHostByName/gethostbyname_r/malloc
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:malloc
+    ...
+    fun:dl_open_worker
+    ...
+    fun:do_dlopen
+    ...
+    fun:TclpGetHostByName
+}
+
+{
    TclpGetPwNam/getpwname_r/__nss_next2/calloc
    Memcheck:Leak
    match-leak-kinds: reachable
@@ -105,6 +181,57 @@
 }
 
 {
+    TclpGetGrGid/getgrgid_r/module_load
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:calloc
+    ...
+    fun:module_load
+    ...
+    fun:TclpGetGrGid
+}
+
+{
+    TclpGetGrGid/getgrgid_r/module_load
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:malloc
+    ...
+    fun:module_load
+    ...
+    fun:TclpGetGrGid
+}
+
+{
+    TcphostPortList/getnameinfo/module_load/calloc
+    Memcheck:Leak
+    match-leak-kinds: definite,reachable
+    fun:calloc
+    ...
+    fun:dl_open_worker_begin
+    ...
+    fun:module_load
+    ...
+    fun:getnameinfo
+    fun:TcpHostPortList
+}
+
+{
+    # see sourceware glibc Bug 14984 - getnameinfo() might be leaking memory
+    TcphostPortList/getnameinfo/module_load/mallco
+    Memcheck:Leak
+    match-leak-kinds: definite,reachable
+    fun:malloc
+    ...
+    fun:dl_open_worker_begin
+    ...
+    fun:module_load
+    ...
+    fun:getnameinfo
+    fun:TcpHostPortList
+}
+
+{
 	TclpThreadExit/pthread_exit/calloc
     Memcheck:Leak
     match-leak-kinds: reachable
@@ -124,3 +251,13 @@
 	fun:TclpThreadExit
 }
 
+{
+	TclpThreadExit/pthread_exit/malloc
+    Memcheck:Leak
+    match-leak-kinds: definite
+	fun:malloc
+	...
+	fun:pthread_exit
+	fun:TclpThreadExit
+}
+
-- 
cgit v0.12


From fa795b478ac557afbf6511559553e279a046862a Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 6 Mar 2023 06:59:52 +0000
Subject: Add new valgrind suppression items.

---
 tools/valgrind_suppress | 137 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 137 insertions(+)

diff --git a/tools/valgrind_suppress b/tools/valgrind_suppress
index fb7f173..11ca880 100644
--- a/tools/valgrind_suppress
+++ b/tools/valgrind_suppress
@@ -1,3 +1,17 @@
+#{
+#    Tcl_GetChannelOption/TcpGetOptionProc/TcphostPortList/getnameinfo/gethostbyaddr_r
+#    Memcheck:Leak
+#    match-leak-kinds: reachable
+#    fun:malloc
+#    fun:strdup
+#    ...
+#    fun:module_load
+#    ...
+#    fun:getnameinfo
+#    ...
+#    fun:Tcl_GetChannelOption
+#}
+
 {
    TclCreatesocketAddress/getaddrinfo/calloc
    Memcheck:Leak
@@ -11,6 +25,16 @@
 {
    TclCreatesocketAddress/getaddrinfo/malloc
    Memcheck:Leak
+   match-leak-kinds: definite
+   fun:malloc
+   ...
+   fun:getaddrinfo
+   fun:TclCreateSocketAddress
+}
+
+{
+   TclCreatesocketAddress/getaddrinfo/malloc
+   Memcheck:Leak
    match-leak-kinds: reachable
    fun:malloc
    ...
@@ -19,6 +43,18 @@
 }
 
 {
+   TclpDlopen/decompose_rpath
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:malloc
+   fun:decompose_rpath
+   ...
+   fun:dlopen_doit
+   ...
+   fun:TclpDlopen
+}
+
+{
    TclpDlopen/load
    Memcheck:Leak
    match-leak-kinds: reachable
@@ -72,6 +108,46 @@
 }
 
 {
+    TclpGeHostByName/gethostbyname_r/strdup/malloc
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:malloc
+    fun:strdup
+    ...
+    fun:dl_open_worker
+    ...
+    fun:do_dlopen
+    ...
+    fun:TclpGetHostByName
+}
+
+{
+    TclpGeHostByName/gethostbyname_r/calloc
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:calloc
+    ...
+    fun:dl_open_worker
+    ...
+    fun:do_dlopen
+    ...
+    fun:TclpGetHostByName
+}
+
+{
+    TclpGeHostByName/gethostbyname_r/malloc
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:malloc
+    ...
+    fun:dl_open_worker
+    ...
+    fun:do_dlopen
+    ...
+    fun:TclpGetHostByName
+}
+
+{
    TclpGetPwNam/getpwname_r/__nss_next2/calloc
    Memcheck:Leak
    match-leak-kinds: reachable
@@ -105,6 +181,57 @@
 }
 
 {
+    TclpGetGrGid/getgrgid_r/module_load
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:calloc
+    ...
+    fun:module_load
+    ...
+    fun:TclpGetGrGid
+}
+
+{
+    TclpGetGrGid/getgrgid_r/module_load
+    Memcheck:Leak
+    match-leak-kinds: reachable
+    fun:malloc
+    ...
+    fun:module_load
+    ...
+    fun:TclpGetGrGid
+}
+
+{
+    TcphostPortList/getnameinfo/module_load/calloc
+    Memcheck:Leak
+    match-leak-kinds: definite,reachable
+    fun:calloc
+    ...
+    fun:dl_open_worker_begin
+    ...
+    fun:module_load
+    ...
+    fun:getnameinfo
+    fun:TcpHostPortList
+}
+
+{
+    # see sourceware glibc Bug 14984 - getnameinfo() might be leaking memory
+    TcphostPortList/getnameinfo/module_load/mallco
+    Memcheck:Leak
+    match-leak-kinds: definite,reachable
+    fun:malloc
+    ...
+    fun:dl_open_worker_begin
+    ...
+    fun:module_load
+    ...
+    fun:getnameinfo
+    fun:TcpHostPortList
+}
+
+{
 	TclpThreadExit/pthread_exit/calloc
     Memcheck:Leak
     match-leak-kinds: reachable
@@ -124,3 +251,13 @@
 	fun:TclpThreadExit
 }
 
+{
+	TclpThreadExit/pthread_exit/malloc
+    Memcheck:Leak
+    match-leak-kinds: definite
+	fun:malloc
+	...
+	fun:pthread_exit
+	fun:TclpThreadExit
+}
+
-- 
cgit v0.12


From cfa443421bcf235f75def81bc137774aa0f20387 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 6 Mar 2023 10:24:15 +0000
Subject: Tcl_WinTCharToUtf() is deprecated, so use Tcl_WCharToUtfDString() in
 stead.

---
 win/tclWinFile.c | 34 ++++++++++++++++------------------
 1 file changed, 16 insertions(+), 18 deletions(-)

diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index a54077d..c7159b7 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -1476,24 +1476,22 @@ TclpGetUserHome(
          */
 	ptr = TclpGetUserName(&ds);
 	if (ptr != NULL && strcasecmp(name, ptr) == 0) {
-            HANDLE hProcess;
-            WCHAR buf[MAX_PATH];
-            DWORD nChars = sizeof(buf) / sizeof(buf[0]);
-            /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */
-            hProcess = GetCurrentProcess(); /* Need not be closed */
-            if (hProcess) {
-                HANDLE hToken;
-                if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) {
-                    if (GetUserProfileDirectoryW(hToken, buf, &nChars)) {
-                        Tcl_WinTCharToUtf((TCHAR *)buf,
-                                          (nChars-1)*sizeof(WCHAR),
-                                          bufferPtr);
-                        result = Tcl_DStringValue(bufferPtr);
-                        rc = 1;
-                    }
-                    CloseHandle(hToken);
-                }
-            }
+	    HANDLE hProcess;
+	    WCHAR buf[MAX_PATH];
+	    DWORD nChars = sizeof(buf) / sizeof(buf[0]);
+	    /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */
+	    hProcess = GetCurrentProcess(); /* Need not be closed */
+	    if (hProcess) {
+		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;
+		    }
+		    CloseHandle(hToken);
+		}
+	    }
 	}
 	Tcl_DStringFree(&ds);
     } else {
-- 
cgit v0.12


From 5e095a3a4d445694e0a618ed20fe92d8fd34b637 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 6 Mar 2023 18:17:19 +0000
Subject: [b4af93cd9f] Proposed fix from apnadkarni.  It works!

---
 unix/tclUnixSock.c | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

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");
-- 
cgit v0.12


From f4450abcf989ed7ce06a977c8c12483762f00512 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 6 Mar 2023 19:58:53 +0000
Subject: Proposed fix for [f3cb2a32d6]: uninitialized value in format-2.18

---
 generic/tclStringObj.c | 1 +
 1 file changed, 1 insertion(+)

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);
     }
-- 
cgit v0.12


From f5ba8a8478a966af91228ad54eb264c04c21b11d Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 6 Mar 2023 21:01:45 +0000
Subject: Proposed fix for [95e287b956]: uninit value use in stringObj-4.2

---
 tests/stringObj.test | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/stringObj.test b/tests/stringObj.test
index dce932b..da379ba 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -66,8 +66,8 @@ test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} testobj {
     testobj freeallvars
     teststringobj set 1 abcdef
     teststringobj setlength 1 10
-    list [teststringobj length 1] [teststringobj length2 1]
-} {10 10}
+    list [teststringobj length 1]
+} 10
 test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj {
     testobj freeallvars
     teststringobj set 1 abcdef
-- 
cgit v0.12

-- 
cgit v0.12


From 1f6cec5ff3943450001a29bea3371dea9f23db7f Mon Sep 17 00:00:00 2001
From: apnadkarni <apnmbx-wits@yahoo.com>
Date: Tue, 7 Mar 2023 02:52:26 +0000
Subject: Fix testchmod and associated tests that always failed on Windows

---
 tests/fCmd.test    |  18 ++-
 tests/tcltest.test |   2 +-
 tests/winFCmd.test | 112 ++++++++++---------
 win/tclWinTest.c   | 316 ++++++++++++++++++++++++++++-------------------------
 4 files changed, 239 insertions(+), 209 deletions(-)

diff --git a/tests/fCmd.test b/tests/fCmd.test
index dad1af9..ecb1d04 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -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
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 8a0174d..9da14de 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -552,7 +552,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 500b114..b146253 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -47,15 +47,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*]
     }
 }
 
@@ -415,12 +420,12 @@ test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
     cleanup
 } -constraints {win winNonZeroInodes 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 {
@@ -496,11 +501,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 {
@@ -542,11 +547,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}
 
@@ -624,7 +628,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
 
@@ -664,14 +667,17 @@ test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} -setup {
 test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
     cleanup
 } -constraints {winVista testfile testchmod notInCIenv} -body {
-    file mkdir td1
-    testchmod 0 td1
-    testfile rmdir td1
-    file exists td1
+    # 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
@@ -679,7 +685,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 /
 } {}
@@ -715,17 +721,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 {winVista testfile testchmod 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 nt testfile} -body {
@@ -736,14 +732,18 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
 test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
     cleanup
 } -constraints {winVista testfile testchmod notInCIenv} -body {
-    file mkdir td1
-    testchmod 0 td1
-    testfile rmdir td1
-    file exists td1
-} -cleanup {
-    catch {testchmod 0o666 td1}
-    cleanup
-} -returnCodes error -result {td1 EACCES}
+    # 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 {
+    testchmod 0o770 td0/td1
+    cleanup
+} -returnCodes error -result {td0/td1 EACCES}
 # This next test has a very hokey way of matching...
 test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
     cleanup
@@ -837,11 +837,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 {
@@ -908,11 +909,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 {
@@ -939,11 +941,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 {
@@ -965,14 +968,18 @@ test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
 test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
     cleanup
 } -constraints {winVista testfile testchmod notInCIenv} -body {
-    file mkdir td1/td2
-    testchmod 0 td1
-    testfile rmdir -force td1
+    # 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 {
@@ -1471,7 +1478,6 @@ test winFCmd-19.9 {Windows devices path names} -constraints {win nt} -body {
 #    }
 #}
 
-# cleanup
 cleanup
 ::tcltest::cleanupTests
 return
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 357bbc5..0b4c8f6 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -17,9 +17,8 @@
 /*
  * For TestplatformChmod on Windows
  */
-#ifdef _WIN32
 #include <aclapi.h>
-#endif
+#include <sddl.h>
 
 /*
  * MinGW 3.4.2 does not define this.
@@ -416,176 +415,190 @@ 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.
-     */
+    SID_IDENTIFIER_AUTHORITY worldAuthority = SECURITY_WORLD_SID_AUTHORITY;
+
+    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;
+
+    res = -1; /* Assume failure */
 
     attr = GetFileAttributesA(nativePath);
-
-    /*
-     * nativePath not found
-     */
-
     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 = ckalloc(secDescLen);
-	if (!GetFileSecurityA(nativePath, infoBits,
-		(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
-		|| (secDescLen < secDescLen2)) {
-	    goto done;
-	}
-    }
-
-    /*
-     * Get the World SID.
-     */
-
-    userSid = 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 = 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 = 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;
+
+    if (pmode & 0070) {
+	/* Group permissions. */
 
-    acl_readOnly_found = FALSE;
-    for (j = 0; j < ACLSize.AceCount; j++) {
-	LPVOID pACE2;
-	ACE_HEADER *phACE2;
+	TOKEN_PRIMARY_GROUP *pTokenGroup;
 
-	if (!GetAce(curAcl, j, &pACE2)) {
+	/* Get primary group SID */
+	if (!GetTokenInformation(
+		hToken, TokenPrimaryGroup, NULL, 0, &dw) &&
+		GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
 	    goto done;
 	}
+	pTokenGroup = 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;
+	/* Generate mask for group ACL */
 
-	/*
-	 * Do NOT propagate inherited ACEs.
-	 */
-
-	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 = 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;
 	}
     }
@@ -595,35 +608,36 @@ 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);
 }
 
-- 
cgit v0.12


From 5cf1eed9106acd1a6e751b414506b0e38f6a79a7 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 7 Mar 2023 17:56:45 +0000
Subject: Fix a few -Wconversion warnings

---
 generic/tclDecls.h  |  2 +-
 win/tclWin32Dll.c   |  8 +++---
 win/tclWinChan.c    | 47 +++++++++++++++++++---------------
 win/tclWinConsole.c | 20 ++++++++++-----
 win/tclWinFile.c    | 74 ++++++++++++++++++++++++++---------------------------
 5 files changed, 81 insertions(+), 70 deletions(-)

diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 8fc926c..6c109de 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4042,7 +4042,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/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 9e83b46..d418b56 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -433,7 +433,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;
 	    }
@@ -459,7 +459,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);
@@ -600,7 +600,7 @@ Tcl_WinTCharToUtf(
 	return NULL;
     }
     if (len < 0) {
-	len = wcslen((WCHAR *)string);
+	len = (int)wcslen((WCHAR *)string);
     } else {
 	len /= 2;
     }
@@ -663,7 +663,7 @@ TclWinCPUID(
 
 #if defined(HAVE_INTRIN_H) && defined(_WIN64) && defined(HAVE_CPUID)
 
-    __cpuid((int *)regsPtr, index);
+    __cpuid((int *)regsPtr, (int)index);
     status = TCL_OK;
 
 #elif defined(__GNUC__) && defined(HAVE_CPUID)
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 573ac7d..3a3eba4 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -174,6 +174,8 @@ static void
 FileChannelExitHandler(
     ClientData clientData)	/* Old window proc */
 {
+    (void)clientData;
+
     Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
 }
 
@@ -202,6 +204,7 @@ FileSetupProc(
     FileInfo *infoPtr;
     Tcl_Time blockTime = { 0, 0 };
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    (void)data;
 
     if (!(flags & TCL_FILE_EVENTS)) {
 	return;
@@ -245,6 +248,7 @@ FileCheckProc(
     FileEvent *evPtr;
     FileInfo *infoPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    (void)data;
 
     if (!(flags & TCL_FILE_EVENTS)) {
 	return;
@@ -259,7 +263,7 @@ FileCheckProc(
 	    infoPtr = infoPtr->nextPtr) {
 	if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
 	    infoPtr->flags |= FILE_PENDING;
-	    evPtr = ckalloc(sizeof(FileEvent));
+	    evPtr = (FileEvent *)ckalloc(sizeof(FileEvent));
 	    evPtr->header.proc = FileEventProc;
 	    evPtr->infoPtr = infoPtr;
 	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
@@ -342,7 +346,7 @@ FileBlockProc(
     int mode)			/* TCL_MODE_BLOCKING or
 				 * TCL_MODE_NONBLOCKING. */
 {
-    FileInfo *infoPtr = instanceData;
+    FileInfo *infoPtr = (FileInfo *)instanceData;
 
     /*
      * Files on Windows can not be switched between blocking and nonblocking,
@@ -380,10 +384,11 @@ FileCloseProc(
     ClientData instanceData,	/* Pointer to FileInfo structure. */
     Tcl_Interp *interp)		/* Not used. */
 {
-    FileInfo *fileInfoPtr = instanceData;
+    FileInfo *fileInfoPtr = (FileInfo *)instanceData;
     FileInfo *infoPtr;
     ThreadSpecificData *tsdPtr;
     int errorCode = 0;
+    (void)interp;
 
     /*
      * Remove the file from the watch list.
@@ -467,7 +472,7 @@ FileSeekProc(
     int mode,			/* Relative to where should we seek? */
     int *errorCodePtr)		/* To store error code. */
 {
-    FileInfo *infoPtr = instanceData;
+    FileInfo *infoPtr = (FileInfo *)instanceData;
     LONG newPos, newPosHigh, oldPos, oldPosHigh;
     DWORD moveMethod;
 
@@ -485,7 +490,7 @@ FileSeekProc(
      */
 
     oldPosHigh = 0;
-    oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
+    oldPos = (int)SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
     if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
 
@@ -497,7 +502,7 @@ FileSeekProc(
     }
 
     newPosHigh = (offset < 0 ? -1 : 0);
-    newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
+    newPos = (int)SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
     if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
 
@@ -545,7 +550,7 @@ FileWideSeekProc(
     int mode,			/* Relative to where should we seek? */
     int *errorCodePtr)		/* To store error code. */
 {
-    FileInfo *infoPtr = instanceData;
+    FileInfo *infoPtr = (FileInfo *)instanceData;
     DWORD moveMethod;
     LONG newPos, newPosHigh;
 
@@ -559,7 +564,7 @@ FileWideSeekProc(
     }
 
     newPosHigh = Tcl_WideAsLong(offset >> 32);
-    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
+    newPos = (int)SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
 	    &newPosHigh, moveMethod);
     if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
@@ -594,7 +599,7 @@ FileTruncateProc(
     ClientData instanceData,	/* File state. */
     Tcl_WideInt length)		/* Length to truncate at. */
 {
-    FileInfo *infoPtr = instanceData;
+    FileInfo *infoPtr = (FileInfo *)instanceData;
     LONG newPos, newPosHigh, oldPos, oldPosHigh;
 
     /*
@@ -602,7 +607,7 @@ FileTruncateProc(
      */
 
     oldPosHigh = 0;
-    oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
+    oldPos = (int)SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
     if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
 	if (winError != NO_ERROR) {
@@ -616,7 +621,7 @@ FileTruncateProc(
      */
 
     newPosHigh = Tcl_WideAsLong(length >> 32);
-    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
+    newPos = (int)SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
 	    &newPosHigh, FILE_BEGIN);
     if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
@@ -670,7 +675,7 @@ FileInputProc(
     int bufSize,		/* Num bytes available in buffer. */
     int *errorCode)		/* Where to store error code. */
 {
-    FileInfo *infoPtr = instanceData;
+    FileInfo *infoPtr = (FileInfo *)instanceData;
     DWORD bytesRead;
 
     *errorCode = 0;
@@ -689,7 +694,7 @@ FileInputProc(
 
     if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
 	    (LPOVERLAPPED) NULL) != FALSE) {
-	return bytesRead;
+	return (int)bytesRead;
     }
 
     TclWinConvertError(GetLastError());
@@ -725,7 +730,7 @@ FileOutputProc(
     int toWrite,		/* How many bytes to write? */
     int *errorCode)		/* Where to store error code. */
 {
-    FileInfo *infoPtr = instanceData;
+    FileInfo *infoPtr = (FileInfo *)instanceData;
     DWORD bytesWritten;
 
     *errorCode = 0;
@@ -746,7 +751,7 @@ FileOutputProc(
 	return -1;
     }
     infoPtr->dirty = 1;
-    return bytesWritten;
+    return (int)bytesWritten;
 }
 
 /*
@@ -772,7 +777,7 @@ FileWatchProc(
 				 * of TCL_READABLE, TCL_WRITABLE and
 				 * TCL_EXCEPTION. */
 {
-    FileInfo *infoPtr = instanceData;
+    FileInfo *infoPtr = (FileInfo *)instanceData;
     Tcl_Time blockTime = { 0, 0 };
 
     /*
@@ -810,7 +815,7 @@ FileGetHandleProc(
     int direction,		/* TCL_READABLE or TCL_WRITABLE */
     ClientData *handlePtr)	/* Where to store the handle.  */
 {
-    FileInfo *infoPtr = instanceData;
+    FileInfo *infoPtr = (FileInfo *)instanceData;
 
     if (direction & infoPtr->validMask) {
 	*handlePtr = (ClientData) infoPtr->handle;
@@ -855,7 +860,7 @@ TclpOpenFileChannel(
     char channelName[16 + TCL_INTEGER_SPACE];
     TclFile readFile = NULL, writeFile = NULL;
 
-    nativeName = Tcl_FSGetNativePath(pathPtr);
+    nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
     if (nativeName == NULL) {
 	if (interp != (Tcl_Interp *) NULL) {
 	    Tcl_AppendResult(interp, "couldn't open \"",
@@ -1363,7 +1368,7 @@ TclWinOpenFileChannel(
 	}
     }
 
-    infoPtr = ckalloc(sizeof(FileInfo));
+    infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo));
 
     /*
      * TIP #218. Removed the code inserting the new structure into the global
@@ -1454,7 +1459,7 @@ FileThreadActionProc(
     int action)
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    FileInfo *infoPtr = instanceData;
+    FileInfo *infoPtr = ( FileInfo *)instanceData;
 
     if (action == TCL_CHANNEL_THREAD_INSERT) {
 	infoPtr->nextPtr = tsdPtr->firstFilePtr;
@@ -1557,7 +1562,7 @@ NativeIsComPort(
     const WCHAR *nativePath)	/* Path of file to access, native encoding. */
 {
     const WCHAR *p = (const WCHAR *) nativePath;
-    int i, len = wcslen(p);
+    int i, len = (int)wcslen(p);
 
     /*
      * 1. Look for com[1-9]:?
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index bb5166b..41a05ad 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -312,6 +312,8 @@ static void
 ConsoleExitHandler(
     ClientData clientData)	/* Old window proc. */
 {
+    (void)clientData;
+
     Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
 }
 
@@ -336,6 +338,8 @@ static void
 ProcExitHandler(
     ClientData clientData)	/* Old window proc. */
 {
+    (void)clientData;
+
     Tcl_MutexLock(&consoleMutex);
     initialized = 0;
     Tcl_MutexUnlock(&consoleMutex);
@@ -367,6 +371,7 @@ ConsoleSetupProc(
     Tcl_Time blockTime = { 0, 0 };
     int block = 1;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    (void)data;
 
     if (!(flags & TCL_FILE_EVENTS)) {
 	return;
@@ -737,7 +742,7 @@ ConsoleOutputProc(
     int toWrite,		/* How many bytes to write? */
     int *errorCode)		/* Where to store error code. */
 {
-    ConsoleInfo *infoPtr = instanceData;
+    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
     ConsoleThreadInfo *threadInfo = &infoPtr->writer;
     DWORD bytesWritten, timeout;
 
@@ -781,7 +786,7 @@ ConsoleOutputProc(
 		ckfree(infoPtr->writeBuf);
 	    }
 	    infoPtr->writeBufLen = toWrite;
-	    infoPtr->writeBuf = ckalloc(toWrite);
+	    infoPtr->writeBuf = (char *)ckalloc(toWrite);
 	}
 	memcpy(infoPtr->writeBuf, buf, toWrite);
 	infoPtr->toWrite = toWrite;
@@ -922,7 +927,7 @@ ConsoleWatchProc(
 				 * TCL_EXCEPTION. */
 {
     ConsoleInfo **nextPtrPtr, *ptr;
-    ConsoleInfo *infoPtr = instanceData;
+    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
     int oldMask = infoPtr->watchMask;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
@@ -980,7 +985,8 @@ ConsoleGetHandleProc(
     int direction,		/* TCL_READABLE or TCL_WRITABLE. */
     ClientData *handlePtr)	/* Where to store the handle. */
 {
-    ConsoleInfo *infoPtr = instanceData;
+    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
+    (void)direction;
 
     *handlePtr = infoPtr->handle;
     return TCL_OK;
@@ -1014,7 +1020,7 @@ WaitForRead(
 				 * or not. */
 {
     DWORD timeout, count;
-    HANDLE *handle = infoPtr->handle;
+    HANDLE *handle = (HANDLE *)infoPtr->handle;
     ConsoleThreadInfo *threadInfo = &infoPtr->reader;
     INPUT_RECORD input;
 
@@ -1315,7 +1321,7 @@ TclWinOpenConsoleChannel(
      * See if a channel with this handle already exists.
      */
 
-    infoPtr = ckalloc(sizeof(ConsoleInfo));
+    infoPtr = (ConsoleInfo *)ckalloc(sizeof(ConsoleInfo));
     memset(infoPtr, 0, sizeof(ConsoleInfo));
 
     infoPtr->validMask = permissions;
@@ -1397,7 +1403,7 @@ ConsoleThreadActionProc(
     ClientData instanceData,
     int action)
 {
-    ConsoleInfo *infoPtr = instanceData;
+    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
 
     /*
      * We do not access firstConsolePtr in the thread structures. This is not
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 639cd72..a6f27c9 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -987,7 +987,7 @@ TclpMatchInDirectory(
 	 * Verify that the specified path exists and is actually a directory.
 	 */
 
-	native = Tcl_FSGetNativePath(pathPtr);
+	native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
 	if (native == NULL) {
 	    return TCL_OK;
 	}
@@ -1477,24 +1477,23 @@ TclpGetUserHome(
          */
 	ptr = TclpGetUserName(&ds);
 	if (ptr != NULL && strcasecmp(name, ptr) == 0) {
-            HANDLE hProcess;
-            WCHAR buf[MAX_PATH];
-            DWORD nChars = sizeof(buf) / sizeof(buf[0]);
-            /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */
-            hProcess = GetCurrentProcess(); /* Need not be closed */
-            if (hProcess) {
-                HANDLE hToken;
-                if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) {
-                    if (GetUserProfileDirectoryW(hToken, buf, &nChars)) {
-                        Tcl_WinTCharToUtf((TCHAR *)buf,
-                                          (nChars-1)*sizeof(WCHAR),
-                                          bufferPtr);
-                        result = Tcl_DStringValue(bufferPtr);
-                        rc = 1;
-                    }
-                    CloseHandle(hToken);
-                }
-            }
+	    HANDLE hProcess;
+	    WCHAR buf[MAX_PATH];
+	    DWORD nChars = sizeof(buf) / sizeof(buf[0]);
+	    /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */
+	    hProcess = GetCurrentProcess(); /* Need not be closed */
+	    if (hProcess) {
+		HANDLE hToken;
+		if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) {
+		    if (GetUserProfileDirectoryW(hToken, buf, &nChars)) {
+			Tcl_WinTCharToUtf((TCHAR *)buf,
+				(nChars-1)*sizeof(WCHAR), bufferPtr);
+			result = Tcl_DStringValue(bufferPtr);
+			rc = 1;
+		    }
+		    CloseHandle(hToken);
+		}
+	    }
 	}
 	Tcl_DStringFree(&ds);
     } else {
@@ -1524,7 +1523,7 @@ TclpGetUserHome(
 	    if (rc != 0) {
 		break;
 	    }
-	    domain = INT2PTR(-1); /* repeat once */
+	    domain = (const char *)INT2PTR(-1); /* repeat once */
 	}
 	if (rc == 0) {
 	    DWORD i, size = MAX_PATH;
@@ -1919,7 +1918,7 @@ TclpObjChdir(
     int result;
     const WCHAR *nativePath;
 
-    nativePath = Tcl_FSGetNativePath(pathPtr);
+    nativePath = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
 
     if (!nativePath) {
 	return -1;
@@ -2011,7 +2010,7 @@ TclpObjStat(
 
     TclWinFlushDirtyChannels();
 
-    return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0);
+    return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 0);
 }
 
 /*
@@ -2204,7 +2203,7 @@ NativeDev(
 	p = strchr(p + 1, '\\');
 	if (p == NULL) {
 	    /*
-	     * Add terminating backslash to fullpath or GetVolumeInformation()
+	     * Add terminating backslash to fullpath or GetVolumeInformationW()
 	     * won't work.
 	     */
 
@@ -2380,7 +2379,7 @@ TclpObjAccess(
     Tcl_Obj *pathPtr,
     int mode)
 {
-    return NativeAccess(Tcl_FSGetNativePath(pathPtr), mode);
+    return NativeAccess((const WCHAR *)Tcl_FSGetNativePath(pathPtr), mode);
 }
 
 int
@@ -2396,7 +2395,7 @@ TclpObjLstat(
 
     TclWinFlushDirtyChannels();
 
-    return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1);
+    return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 1);
 }
 
 #ifdef S_IFLNK
@@ -2409,14 +2408,14 @@ TclpObjLink(
     if (toPtr != NULL) {
 	int res;
 	const WCHAR *LinkTarget;
-	const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
+	const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
 	Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr);
 
 	if (normalizedToPtr == NULL) {
 	    return NULL;
 	}
 
-	LinkTarget = Tcl_FSGetNativePath(normalizedToPtr);
+	LinkTarget = (const WCHAR *)Tcl_FSGetNativePath(normalizedToPtr);
 
 	if (LinkSource == NULL || LinkTarget == NULL) {
 	    return NULL;
@@ -2428,7 +2427,7 @@ TclpObjLink(
 	    return NULL;
 	}
     } else {
-	const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
+	const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
 
 	if (LinkSource == NULL) {
 	    return NULL;
@@ -2477,13 +2476,13 @@ TclpFilesystemPathType(
 
     firstSeparator = strchr(path, '/');
     if (firstSeparator == NULL) {
-	found = GetVolumeInformationW(Tcl_FSGetNativePath(pathPtr),
+	found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr),
 		NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
     } else {
 	Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);
 
 	Tcl_IncrRefCount(driveName);
-	found = GetVolumeInformationW(Tcl_FSGetNativePath(driveName),
+	found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(driveName),
 		NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
 	Tcl_DecrRefCount(driveName);
     }
@@ -2536,7 +2535,7 @@ TclpFilesystemPathType(
 
 int
 TclpObjNormalizePath(
-    Tcl_Interp *interp,
+    Tcl_Interp *interp, /* not used */
     Tcl_Obj *pathPtr,	        /* An unshared object containing the path to
 				 * normalize */
     int nextCheckpoint)	        /* offset to start at in pathPtr */
@@ -2547,6 +2546,7 @@ TclpObjNormalizePath(
     Tcl_Obj *temp = NULL;
     int isDrive = 1;
     Tcl_DString ds;		/* Some workspace. */
+    (void)interp;
 
     Tcl_DStringInit(&dsNorm);
     path = Tcl_GetString(pathPtr);
@@ -2584,7 +2584,7 @@ TclpObjNormalizePath(
 			int i;
 
 			for (i=0 ; i<len ; i++) {
-			    WCHAR wc = ((WCHAR *) nativePath)[i];
+			    WCHAR wc = ((WCHAR *)nativePath)[i];
 
 			    if (wc >= 'a') {
 				wc -= ('a' - 'A');
@@ -3101,7 +3101,7 @@ TclNativeCreateNativeRep(
      * Overallocate 6 chars, making some room for extended paths
      */
 
-    wp = nativePathPtr = ckalloc((len + 6) * sizeof(WCHAR));
+    wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR));
     if (nativePathPtr==0) {
       goto done;
     }
@@ -3200,7 +3200,7 @@ TclNativeDupInternalRep(
 
     len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);
 
-    copy = ckalloc(len);
+    copy = (char *)ckalloc(len);
     memcpy(copy, clientData, len);
     return copy;
 }
@@ -3237,7 +3237,7 @@ TclpUtime(
     FromCTime(tval->actime, &lastAccessTime);
     FromCTime(tval->modtime, &lastModTime);
 
-    native = Tcl_FSGetNativePath(pathPtr);
+    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
 
     attr = GetFileAttributesW(native);
 
@@ -3288,7 +3288,7 @@ TclWinFileOwned(
     DWORD bufsz;
     int owned = 0;
 
-    native = Tcl_FSGetNativePath(pathPtr);
+    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
 
     if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT,
 	    OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL,
@@ -3316,7 +3316,7 @@ TclWinFileOwned(
         bufsz = 0;
         GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
         if (bufsz) {
-            buf = ckalloc(bufsz);
+            buf = (LPBYTE)ckalloc(bufsz);
             if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
                 owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
             }
-- 
cgit v0.12