merge 8.7

12 files changed, 102 insertions, 50 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 815b89b..23dc4af 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2591,7 +2591,15 @@ declare 679 {
 	    void *clientData, size_t objc, Tcl_Obj *const objv[])
 }
 
-# slot 680 and 681 are reserved for TIP #638
+# TIP #638.
+declare 680 {
+    int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+	    void **clientDataPtr, int *typePtr)
+}
+declare 681 {
+    int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, size_t numBytes,
+	    void **clientDataPtr, int *typePtr)
+}
 
 # TIP #220.
 declare 682 {
diff --git a/generic/tcl.h b/generic/tcl.h
index 1d2c5be..e63a4a9 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -814,6 +814,20 @@ typedef struct Tcl_DString {
 #define TCL_INTEGER_SPACE	(3*(int)sizeof(Tcl_WideInt))
 
 /*
+ *----------------------------------------------------------------------------
+ * Type values returned by Tcl_GetNumberFromObj
+ *	TCL_NUMBER_INT		Representation is a Tcl_WideInt
+ *	TCL_NUMBER_BIG		Representation is an mp_int
+ *	TCL_NUMBER_DOUBLE	Representation is a double
+ *	TCL_NUMBER_NAN		Value is NaN.
+ */
+
+#define TCL_NUMBER_INT          2
+#define TCL_NUMBER_BIG          3
+#define TCL_NUMBER_DOUBLE       4
+#define TCL_NUMBER_NAN          5
+
+/*
  * Flag values passed to Tcl_ConvertElement.
  * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to
  *	use backslash quoting instead.
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index d88c8ed..793c426 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -232,7 +232,7 @@ assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tc
     void *clientData;
     int tcl_number_type;
 
-    if (TclGetNumberFromObj(NULL, numberObj, &clientData, &tcl_number_type) != TCL_OK
+    if (Tcl_GetNumberFromObj(NULL, numberObj, &clientData, &tcl_number_type) != TCL_OK
 	    || tcl_number_type == TCL_NUMBER_BIG) {
 	return;
     }
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 21e5ade..5ab12d4 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -6507,7 +6507,7 @@ Tcl_ExprLongObj(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -6553,7 +6553,7 @@ Tcl_ExprDoubleObj(
 	return TCL_ERROR;
     }
 
-    result = TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type);
+    result = Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type);
     if (result == TCL_OK) {
 	switch (type) {
 	case TCL_NUMBER_NAN:
@@ -7120,7 +7120,7 @@ ExprIsqrtFunc(
      * Make sure that the arg is a number.
      */
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -7383,7 +7383,7 @@ ExprAbsFunc(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -7538,7 +7538,7 @@ ExprIntFunc(
 	MathFuncWrongNumArgs(interp, 2, objc, objv);
 	return TCL_ERROR;
     }
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -7619,7 +7619,7 @@ ExprMaxMinFunc(
     }
     res = objv[1];
     for (i = 1; i < objc; i++) {
-        if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
+        if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
             return TCL_ERROR;
         }
         if (type == TCL_NUMBER_NAN) {
@@ -7771,7 +7771,7 @@ ExprRoundFunc(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
 	return TCL_ERROR;
     }
 
@@ -8039,7 +8039,7 @@ ExprIsFiniteFunc(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
         return TCL_ERROR;
     }
     if (type != TCL_NUMBER_NAN) {
@@ -8070,7 +8070,7 @@ ExprIsInfinityFunc(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
         return TCL_ERROR;
     }
     if (type != TCL_NUMBER_NAN) {
@@ -8100,7 +8100,7 @@ ExprIsNaNFunc(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
         return TCL_ERROR;
     }
     if (type != TCL_NUMBER_NAN) {
@@ -8130,7 +8130,7 @@ ExprIsNormalFunc(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
         return TCL_ERROR;
     }
     if (type != TCL_NUMBER_NAN) {
@@ -8160,7 +8160,7 @@ ExprIsSubnormalFunc(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
         return TCL_ERROR;
     }
     if (type != TCL_NUMBER_NAN) {
@@ -8190,7 +8190,7 @@ ExprIsUnorderedFunc(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
         return TCL_ERROR;
     }
     if (type == TCL_NUMBER_NAN) {
@@ -8200,7 +8200,7 @@ ExprIsUnorderedFunc(
         result = (ClassifyDouble(d) == FP_NAN);
     }
 
-    if (TclGetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) {
         return TCL_ERROR;
     }
     if (type == TCL_NUMBER_NAN) {
@@ -8232,7 +8232,7 @@ FloatClassifyObjCmd(
 	return TCL_ERROR;
     }
 
-    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
+    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
         return TCL_ERROR;
     }
     if (type == TCL_NUMBER_NAN) {
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 9011469..3e297f6 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -4086,7 +4086,7 @@ SequenceIdentifyArgument(
     SequenceByMode bymode;
     void *clientData;
 
-    status = TclGetNumberFromObj(NULL, argPtr, &clientData, keywordIndexPtr);
+    status = Tcl_GetNumberFromObj(NULL, argPtr, &clientData, keywordIndexPtr);
     if (status == TCL_OK) {
 	if (numValuePtr) {
 	    *numValuePtr = argPtr;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 7567e80..d0343d3 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1831,8 +1831,14 @@ EXTERN Tcl_Command	Tcl_NRCreateCommand2(Tcl_Interp *interp,
 EXTERN int		Tcl_NRCallObjProc2(Tcl_Interp *interp,
 				Tcl_ObjCmdProc2 *objProc2, void *clientData,
 				size_t objc, Tcl_Obj *const objv[]);
-/* Slot 680 is reserved */
-/* Slot 681 is reserved */
+/* 680 */
+EXTERN int		Tcl_GetNumberFromObj(Tcl_Interp *interp,
+				Tcl_Obj *objPtr, void **clientDataPtr,
+				int *typePtr);
+/* 681 */
+EXTERN int		Tcl_GetNumber(Tcl_Interp *interp, const char *bytes,
+				size_t numBytes, void **clientDataPtr,
+				int *typePtr);
 /* 682 */
 EXTERN int		Tcl_RemoveChannelMode(Tcl_Interp *interp,
 				Tcl_Channel chan, int mode);
@@ -2527,8 +2533,8 @@ typedef struct TclStubs {
     Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
     Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
     int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
-    void (*reserved680)(void);
-    void (*reserved681)(void);
+    int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
+    int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */
     int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
 } TclStubs;
 
@@ -3842,8 +3848,10 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_NRCreateCommand2) /* 678 */
 #define Tcl_NRCallObjProc2 \
 	(tclStubsPtr->tcl_NRCallObjProc2) /* 679 */
-/* Slot 680 is reserved */
-/* Slot 681 is reserved */
+#define Tcl_GetNumberFromObj \
+	(tclStubsPtr->tcl_GetNumberFromObj) /* 680 */
+#define Tcl_GetNumber \
+	(tclStubsPtr->tcl_GetNumber) /* 681 */
 #define Tcl_RemoveChannelMode \
 	(tclStubsPtr->tcl_RemoveChannelMode) /* 682 */
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 4b9ed0d..444f9aa 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -445,7 +445,7 @@ VarHashCreateVar(
 
 /*
  * Macro used in this file to save a function call for common uses of
- * TclGetNumberFromObj(). The ANSI C "prototype" is:
+ * Tcl_GetNumberFromObj(). The ANSI C "prototype" is:
  *
  * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
  *			void **ptrPtr, int *tPtr);
@@ -464,7 +464,7 @@ VarHashCreateVar(
 		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
     (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
 	? TCL_ERROR :			\
-    TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
+    Tcl_GetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
 
 /*
  * Macro used to make the check for type overflow more mnemonic. This works by
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a876f37..ad21b66 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2845,17 +2845,6 @@ typedef struct ProcessGlobalValue {
 				/* Reject underscore digit separator */
 
 /*
- *----------------------------------------------------------------------
- * Type values TclGetNumberFromObj
- *----------------------------------------------------------------------
- */
-
-#define TCL_NUMBER_INT		2
-#define TCL_NUMBER_BIG		3
-#define TCL_NUMBER_DOUBLE	4
-#define TCL_NUMBER_NAN		5
-
-/*
  *----------------------------------------------------------------
  * Variables shared among Tcl modules but not used by the outside world.
  *----------------------------------------------------------------
@@ -3162,9 +3151,6 @@ MODULE_SCOPE int	TclGetCompletionCodeFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *value, int *code);
 MODULE_SCOPE Proc *	TclGetLambdaFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr);
-MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, void **clientDataPtr,
-			    int *typePtr);
 MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
 			    const char *modeString, int *seekFlagPtr,
 			    int *binaryPtr);
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 2649d12..8579f36 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -530,7 +530,7 @@ GetUWide(
     void *clientData;
     int type, intValue;
 
-    if (TclGetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
+    if (Tcl_GetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
 	if (type == TCL_NUMBER_INT) {
 	    *widePtr = *((const Tcl_WideInt *) clientData);
 	    return (*widePtr < 0);
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 5e55784..38e7d07 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -3451,7 +3451,7 @@ TclSetBignumInternalRep(
 /*
  *----------------------------------------------------------------------
  *
- * TclGetNumberFromObj --
+ * Tcl_GetNumberFromObj --
  *
  *      Extracts a number (of any possible numeric type) from an object.
  *
@@ -3469,7 +3469,7 @@ TclSetBignumInternalRep(
  */
 
 int
-TclGetNumberFromObj(
+Tcl_GetNumberFromObj(
     Tcl_Interp *interp,
     Tcl_Obj *objPtr,
     void **clientDataPtr,
@@ -3504,6 +3504,42 @@ TclGetNumberFromObj(
 	    TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0));
     return TCL_ERROR;
 }
+
+int
+Tcl_GetNumber(
+    Tcl_Interp *interp,
+    const char *bytes,
+    size_t numBytes,
+    ClientData *clientDataPtr,
+    int *typePtr)
+{
+    static Tcl_ThreadDataKey numberCacheKey;
+    Tcl_Obj *objPtr = (Tcl_Obj *)Tcl_GetThreadData(&numberCacheKey,
+	    sizeof(Tcl_Obj));
+
+    Tcl_FreeInternalRep(objPtr);
+
+    if (bytes == NULL) {
+	bytes = &tclEmptyString;
+	numBytes = 0;
+    }
+    if (numBytes == (size_t)TCL_INDEX_NONE) {
+	numBytes = strlen(bytes);
+    }
+    if (numBytes > INT_MAX) {
+	if (interp) {
+            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                    "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
+	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+	}
+	return TCL_ERROR;
+    }
+
+    objPtr->bytes = (char *) bytes;
+    objPtr->length = numBytes;
+
+    return Tcl_GetNumberFromObj(interp, objPtr, clientDataPtr, typePtr);
+}
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index ec83355..18ef6d4 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1476,8 +1476,8 @@ const TclStubs tclStubs = {
     Tcl_CreateObjTrace2, /* 677 */
     Tcl_NRCreateCommand2, /* 678 */
     Tcl_NRCallObjProc2, /* 679 */
-    0, /* 680 */
-    0, /* 681 */
+    Tcl_GetNumberFromObj, /* 680 */
+    Tcl_GetNumber, /* 681 */
     Tcl_RemoveChannelMode, /* 682 */
 };
 
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 5870781..1ac2b31 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -3336,7 +3336,7 @@ GetWideForIndex(
 {
     int numType;
     void *cd;
-    int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
+    int code = Tcl_GetNumberFromObj(NULL, objPtr, &cd, &numType);
 
     if (code == TCL_OK) {
 	if (numType == TCL_NUMBER_INT) {
@@ -3498,7 +3498,7 @@ GetEndOffsetFromObj(
 		    /* ... value continues with [-+] ... */
 
 		    /* Save first integer as wide if possible */
-		    TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
+		    Tcl_GetNumberFromObj(NULL, objPtr, &cd, &t1);
 		    if (t1 == TCL_NUMBER_INT) {
 			w1 = (*(Tcl_WideInt *)cd);
 		    }
@@ -3508,7 +3508,7 @@ GetEndOffsetFromObj(
 			/* ... value concludes with second valid integer */
 
 			/* Save second integer as wide if possible */
-			TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
+			Tcl_GetNumberFromObj(NULL, objPtr, &cd, &t2);
 			if (t2 == TCL_NUMBER_INT) {
 			    w2 = (*(Tcl_WideInt *)cd);
 			}
@@ -3561,7 +3561,7 @@ GetEndOffsetFromObj(
 			    Tcl_ExprObj(compute, objPtr, &sum);
 			    Tcl_DeleteInterp(compute);
 			}
-			TclGetNumberFromObj(NULL, sum, &cd, &numType);
+			Tcl_GetNumberFromObj(NULL, sum, &cd, &numType);
 
 			if (numType == TCL_NUMBER_INT) {
 			    /* sum holds an integer in the signed wide range */
@@ -3612,7 +3612,7 @@ GetEndOffsetFromObj(
 	    }
 
 	    /* Got an integer offset; pull it from where parser left it. */
-	    TclGetNumberFromObj(NULL, objPtr, &cd, &t);
+	    Tcl_GetNumberFromObj(NULL, objPtr, &cd, &t);
 
 	    if (t == TCL_NUMBER_BIG) {
 		/* Truncate to the signed wide range. */