Add support for TIP #494 to registry and dde. Only effective when compiled against Tcl 9.0 headers. This way we can keep the source-code for those extensions 100% equal in all branches.

Work-around for gcc warning in tclWinFile.c. Discovered by Travis CI.

3 files changed, 52 insertions, 6 deletions

diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 38f1d88..27ddfc8 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -117,6 +117,24 @@ static int		DdeObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 
+static unsigned char *
+getByteArrayFromObj(
+	Tcl_Obj *objPtr,
+	size_t *lengthPtr
+) {
+    int length;
+
+    unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
+#if TCL_MAJOR_VERSION > 8
+    if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
+	/* 64-bit and TIP #494 situation: */
+	 *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
+    } else
+#endif
+	/* 32-bit or without TIP #494 */
+    *lengthPtr = (size_t) (unsigned) length;
+    return result;
+}
 
 DLLEXPORT int		Dde_Init(Tcl_Interp *interp);
 DLLEXPORT int		Dde_SafeInit(Tcl_Interp *interp);
@@ -1279,7 +1297,7 @@ DdeObjCmd(
     };
 
     int index, i, argIndex;
-    int length;
+    size_t length;
     int flags = 0, result = TCL_OK, firstArg = 0;
     HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
     HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
@@ -1489,14 +1507,14 @@ DdeObjCmd(
 	break;
 
     case DDE_EXECUTE: {
-	int dataLength;
+	size_t dataLength;
 	const void *dataString;
 	Tcl_DString dsBuf;
 
 	Tcl_DStringInit(&dsBuf);
 	if (flags & DDE_FLAG_BINARY) {
 	    dataString =
-		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
+		    getByteArrayFromObj(objv[firstArg + 2], &dataLength);
 	} else {
 	    const char *src;
 
@@ -1633,7 +1651,7 @@ DdeObjCmd(
 	Tcl_DStringInit(&dsBuf);
 	if (flags & DDE_FLAG_BINARY) {
 	    dataString = (BYTE *)
-		    Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
+		    getByteArrayFromObj(objv[firstArg + 3], &length);
 	} else {
 	    const char *data =
 		    Tcl_GetString(objv[firstArg + 3]);
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index cbd8814..8ee4bce 100755
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -569,6 +569,11 @@ TclWinSymLinkDelete(
  *--------------------------------------------------------------------
  */
 
+#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Warray-bounds"
+#endif
+
 static Tcl_Obj *
 WinReadLinkDirectory(
     const TCHAR *linkDirPath)
@@ -684,6 +689,10 @@ WinReadLinkDirectory(
     Tcl_SetErrno(EINVAL);
     return NULL;
 }
+
+#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
+#pragma GCC diagnostic pop
+#endif
 
 /*
  *--------------------------------------------------------------------
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 0d2cd94..f93a553 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -124,6 +124,25 @@ static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
 			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
 			    Tcl_Obj *typeObj, REGSAM mode);
 
+static unsigned char *
+getByteArrayFromObj(
+	Tcl_Obj *objPtr,
+	size_t *lengthPtr
+) {
+    int length;
+
+    unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
+#if TCL_MAJOR_VERSION > 8
+    if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
+	/* 64-bit and TIP #494 situation: */
+	 *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
+    } else
+#endif
+	/* 32-bit or without TIP #494 */
+    *lengthPtr = (size_t) (unsigned) length;
+    return result;
+}
+
 DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
 DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);
 
@@ -1324,13 +1343,13 @@ SetValue(
 	Tcl_DStringFree(&buf);
     } else {
 	BYTE *data;
-	int bytelength;
+	size_t bytelength;
 
 	/*
 	 * Store binary data in the registry.
 	 */
 
-	data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
+	data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength);
 	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
 		(DWORD) type, data, (DWORD) bytelength);
     }