Merge 8.7

1 files changed, 85 insertions, 86 deletions

diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 547792a..79a164c 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -18,9 +18,21 @@
 #   define USE_TCL_STUBS
 #endif
 #include "tclInt.h"
-#include "tommath.h"
+#ifdef TCL_WITH_EXTERNAL_TOMMATH
+#   include "tommath.h"
+#else
+#   include "tclTomMath.h"
+#endif
 #include "tclStringRep.h"
 
+#ifdef __GNUC__
+/*
+ * The rest of this file shouldn't warn about deprecated functions; they're
+ * there because we intend them to be so and know that this file is OK to
+ * touch those fields.
+ */
+#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
+#endif
 
 /*
  * Forward declarations for functions defined later in this file:
@@ -30,30 +42,21 @@ static int		CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
 static int		GetVariableIndex(Tcl_Interp *interp,
 			    const char *string, int *indexPtr);
 static void		SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr);
-static int		TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		TestbooleanobjCmd(ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		TestindexobjCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		TestintobjCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int 		TestlistobjCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		TestobjCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
+static Tcl_ObjCmdProc	TestbignumobjCmd;
+static Tcl_ObjCmdProc	TestbooleanobjCmd;
+static Tcl_ObjCmdProc	TestdoubleobjCmd;
+static Tcl_ObjCmdProc	TestindexobjCmd;
+static Tcl_ObjCmdProc	TestintobjCmd;
+static Tcl_ObjCmdProc	TestlistobjCmd;
+static Tcl_ObjCmdProc	TestobjCmd;
+static Tcl_ObjCmdProc	TeststringobjCmd;
 
 #define VARPTR_KEY "TCLOBJTEST_VARPTR"
 #define NUMBER_OF_OBJECT_VARS 20
 
-static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp)
+static void VarPtrDeleteProc(void *clientData, Tcl_Interp *interp)
 {
-    register int i;
+    int i;
     Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
     for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
 	if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
@@ -91,7 +94,7 @@ int
 TclObjTest_Init(
     Tcl_Interp *interp)
 {
-    register int i;
+    int i;
     /*
      * An array of Tcl_Obj pointers used in the commands that operate on or get
      * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
@@ -131,7 +134,7 @@ TclObjTest_Init(
  *
  * TestbignumobjCmd --
  *
- *	This function implmenets the "testbignumobj" command.  It is used
+ *	This function implements the "testbignumobj" command.  It is used
  *	to exercise the bignum Tcl object type implementation.
  *
  * Results:
@@ -146,7 +149,7 @@ TclObjTest_Init(
 
 static int
 TestbignumobjCmd(
-    ClientData clientData,	/* unused */
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Argument count */
     Tcl_Obj *const objv[])	/* Argument vector */
@@ -160,7 +163,7 @@ TestbignumobjCmd(
     };
     int index, varIndex;
     const char *string;
-    mp_int bignumValue, newValue;
+    mp_int bignumValue;
     Tcl_Obj **varPtr;
 
     if (objc < 3) {
@@ -233,19 +236,16 @@ TestbignumobjCmd(
 		&bignumValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (mp_init(&newValue) != MP_OKAY
-		|| (mp_mul_d(&bignumValue, 10, &newValue) != MP_OKAY)) {
+	if (mp_mul_d(&bignumValue, 10, &bignumValue) != MP_OKAY) {
 	    mp_clear(&bignumValue);
-	    mp_clear(&newValue);
 	    Tcl_SetObjResult(interp,
 		    Tcl_NewStringObj("error in mp_mul_d", -1));
 	    return TCL_ERROR;
 	}
-	mp_clear(&bignumValue);
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
+	    Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
 	}
 	break;
 
@@ -261,19 +261,16 @@ TestbignumobjCmd(
 		&bignumValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (mp_init(&newValue) != MP_OKAY
-		|| (mp_div_d(&bignumValue, 10, &newValue, NULL) != MP_OKAY)) {
+	if (mp_div_d(&bignumValue, 10, &bignumValue, NULL) != MP_OKAY) {
 	    mp_clear(&bignumValue);
-	    mp_clear(&newValue);
 	    Tcl_SetObjResult(interp,
 		    Tcl_NewStringObj("error in mp_div_d", -1));
 	    return TCL_ERROR;
 	}
-	mp_clear(&bignumValue);
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
+	    Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
 	}
 	break;
 
@@ -289,10 +286,16 @@ TestbignumobjCmd(
 		&bignumValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
+	if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) {
+	    mp_clear(&bignumValue);
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("error in mp_mod_2d", -1));
+	    return TCL_ERROR;
+	}
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetIntObj(varPtr[varIndex], mp_iseven(&bignumValue));
+	    Tcl_SetIntObj(varPtr[varIndex], mp_iszero(&bignumValue));
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iseven(&bignumValue)));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iszero(&bignumValue)));
 	}
 	mp_clear(&bignumValue);
 	break;
@@ -345,7 +348,7 @@ TestbignumobjCmd(
 
 static int
 TestbooleanobjCmd(
-    ClientData clientData,	/* Not used. */
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
@@ -385,9 +388,9 @@ TestbooleanobjCmd(
 	 */
 
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
+	    Tcl_SetWideIntObj(varPtr[varIndex], boolValue != 0);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue != 0));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "get") == 0) {
@@ -410,9 +413,9 @@ TestbooleanobjCmd(
 	    return TCL_ERROR;
 	}
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
+	    Tcl_SetWideIntObj(varPtr[varIndex], boolValue == 0);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue == 0));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
@@ -445,7 +448,7 @@ TestbooleanobjCmd(
 
 static int
 TestdoubleobjCmd(
-    ClientData clientData,	/* Not used. */
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
@@ -563,7 +566,7 @@ TestdoubleobjCmd(
 
 static int
 TestindexobjCmd(
-    ClientData clientData,	/* Not used. */
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
@@ -571,6 +574,7 @@ TestindexobjCmd(
     int allowAbbrev, index, index2, setError, i, result;
     const char **argv;
     static const char *const tablePtr[] = {"a", "b", "check", NULL};
+
     /*
      * Keep this structure declaration in sync with tclIndexObj.c
      */
@@ -594,7 +598,7 @@ TestindexobjCmd(
 	}
 
 	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
-	indexRep = objv[1]->internalRep.twoPtrValue.ptr1;
+	indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1;
 	indexRep->index = index2;
 	result = Tcl_GetIndexFromObj(NULL, objv[1],
 		tablePtr, "token", 0, &index);
@@ -616,14 +620,14 @@ TestindexobjCmd(
 	return TCL_ERROR;
     }
 
-    argv = ckalloc((objc-3) * sizeof(char *));
+    argv = (const char **)ckalloc((objc-3) * sizeof(char *));
     for (i = 4; i < objc; i++) {
 	argv[i-4] = Tcl_GetString(objv[i]);
     }
     argv[objc-4] = NULL;
 
     result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
-	    argv, "token", INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
+	    argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
 	    &index);
     ckfree(argv);
     if (result == TCL_OK) {
@@ -652,13 +656,13 @@ TestindexobjCmd(
 
 static int
 TestintobjCmd(
-    ClientData clientData,	/* Not used. */
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     int intValue, varIndex, i;
-    long longValue;
+    Tcl_WideInt wideValue;
     const char *index, *subCmd, *string;
     Tcl_Obj **varPtr;
 
@@ -713,7 +717,7 @@ TestintobjCmd(
 	} else {
 	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
 	}
-    } else if (strcmp(subCmd, "setlong") == 0) {
+    } else if (strcmp(subCmd, "setint") == 0) {
 	if (objc != 4) {
 	    goto wrongNumArgs;
 	}
@@ -723,33 +727,33 @@ TestintobjCmd(
 	}
 	intValue = i;
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetLongObj(varPtr[varIndex], intValue);
+	    Tcl_SetWideIntObj(varPtr[varIndex], intValue);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
-    } else if (strcmp(subCmd, "setmaxlong") == 0) {
-	long maxLong = LONG_MAX;
+    } else if (strcmp(subCmd, "setmax") == 0) {
+	Tcl_WideInt maxWide = WIDE_MAX;
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetLongObj(varPtr[varIndex], maxLong);
+	    Tcl_SetWideIntObj(varPtr[varIndex], maxWide);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(maxLong));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxWide));
 	}
-    } else if (strcmp(subCmd, "ismaxlong") == 0) {
+    } else if (strcmp(subCmd, "ismax") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
 	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
 	    return TCL_ERROR;
 	}
-	if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
+	if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex], &wideValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		((longValue == LONG_MAX)? "1" : "0"), -1);
+		((wideValue == WIDE_MAX)? "1" : "0"), -1);
     } else if (strcmp(subCmd, "get") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
@@ -782,9 +786,9 @@ TestintobjCmd(
 	Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
 #else
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
+	    Tcl_SetWideIntObj(varPtr[varIndex], LONG_MAX);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(LONG_MAX));
+	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(LONG_MAX));
 	}
 	if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
 	    Tcl_ResetResult(interp);
@@ -856,7 +860,7 @@ TestintobjCmd(
 
 static int
 TestlistobjCmd(
-    ClientData clientData,	/* Not used */
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Tcl interpreter */
     int objc,			/* Number of arguments */
     Tcl_Obj *const objv[])	/* Argument objects */
@@ -953,7 +957,7 @@ TestlistobjCmd(
 
 static int
 TestobjCmd(
-    ClientData clientData,	/* Not used. */
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
@@ -1165,21 +1169,22 @@ TestobjCmd(
 
 static int
 TeststringobjCmd(
-    ClientData clientData,	/* Not used. */
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_UniChar *unicode;
     int varIndex, option, i, length;
+    size_t size;
 #define MAX_STRINGS 11
     const char *index, *string, *strings[MAX_STRINGS+1];
     String *strPtr;
     Tcl_Obj **varPtr;
     static const char *const options[] = {
 	"append", "appendstrings", "get", "get2", "length", "length2",
-	"set", "set2", "setlength", "maxchars", "getunicode",
-	"appendself", "appendself2", NULL
+	"set", "set2", "setlength", "maxchars", "appendself",
+	"appendself2", NULL
     };
 
     if (objc < 3) {
@@ -1283,7 +1288,7 @@ TeststringobjCmd(
 	    if (varPtr[varIndex] != NULL) {
 		Tcl_ConvertToType(NULL, varPtr[varIndex],
 			Tcl_GetObjType("string"));
-		strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
 		length = (int) strPtr->allocated;
 	    } else {
 		length = -1;
@@ -1304,12 +1309,12 @@ TeststringobjCmd(
 	     * is "copy on write".
 	     */
 
-	    string = Tcl_GetStringFromObj(objv[3], &length);
+	    string = Tcl_GetStringFromObj(objv[3], &size);
 	    if ((varPtr[varIndex] != NULL)
 		    && !Tcl_IsShared(varPtr[varIndex])) {
-		Tcl_SetStringObj(varPtr[varIndex], string, length);
+		Tcl_SetStringObj(varPtr[varIndex], string, size);
 	    } else {
-		SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length));
+		SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, size));
 	    }
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
 	    break;
@@ -1337,20 +1342,14 @@ TeststringobjCmd(
 	    if (varPtr[varIndex] != NULL) {
 		Tcl_ConvertToType(NULL, varPtr[varIndex],
 			Tcl_GetObjType("string"));
-		strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
 		length = strPtr->maxChars;
 	    } else {
 		length = -1;
 	    }
 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
 	    break;
-	case 10:			/* getunicode */
-	    if (objc != 3) {
-		goto wrongNumArgs;
-	    }
-	    Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL);
-	    break;
-	case 11:			/* appendself */
+	case 10:			/* appendself */
 	    if (objc != 4) {
 		goto wrongNumArgs;
 	    }
@@ -1367,21 +1366,21 @@ TeststringobjCmd(
 		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 
-	    string = Tcl_GetStringFromObj(varPtr[varIndex], &length);
+	    string = Tcl_GetStringFromObj(varPtr[varIndex], &size);
 
 	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if ((i < 0) || (i > length)) {
+	    if ((i < 0) || ((size_t)i > size)) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"index value out of range", -1));
 		return TCL_ERROR;
 	    }
 
-	    Tcl_AppendToObj(varPtr[varIndex], string + i, length - i);
+	    Tcl_AppendToObj(varPtr[varIndex], string + i, size - i);
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
 	    break;
-	case 12:			/* appendself2 */
+	case 11:			/* appendself2 */
 	    if (objc != 4) {
 		goto wrongNumArgs;
 	    }
@@ -1398,18 +1397,18 @@ TeststringobjCmd(
 		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 
-	    unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length);
+	    unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size);
 
 	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if ((i < 0) || (i > length)) {
+	    if ((i < 0) || ((size_t)i > size)) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"index value out of range", -1));
 		return TCL_ERROR;
 	    }
 
-	    Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i);
+	    Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, size - i);
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
 	    break;
     }