summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c4
-rw-r--r--generic/tclCmdAH.c3
-rw-r--r--generic/tclDecls.h16
-rw-r--r--generic/tclDictObj.c2
-rw-r--r--generic/tclExecute.c26
-rw-r--r--generic/tclIO.c41
-rw-r--r--generic/tclInt.h11
-rw-r--r--generic/tclLink.c93
-rw-r--r--generic/tclListObj.c16
-rw-r--r--generic/tclObj.c30
-rw-r--r--generic/tclPathObj.c2
-rw-r--r--generic/tclPkg.c2
-rw-r--r--generic/tclProc.c10
-rw-r--r--generic/tclResult.c59
-rw-r--r--generic/tclStringObj.c12
-rw-r--r--generic/tclStubInit.c41
-rw-r--r--generic/tclTest.c20
-rw-r--r--generic/tclUtil.c23
18 files changed, 218 insertions, 193 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 37dd699..63c5590 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -203,7 +203,7 @@ static const CmdInfo builtInCmds[] = {
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE},
-#ifndef EXCLUDE_OBSOLETE_COMMANDS
+#ifndef TCL_NO_DEPRECATED
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
@@ -6055,7 +6055,7 @@ TclNREvalObjEx(
TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
objPtr, NULL);
- ListObjGetElements(listPtr, objc, objv);
+ TclListObjGetElements(NULL, listPtr, &objc, &objv);
return TclNREvalObjv(interp, objc, objv, flags, NULL);
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 4c299f8..9c6f6a1 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -149,7 +149,7 @@ Tcl_BreakObjCmd(
*
*----------------------------------------------------------------------
*/
-
+#ifndef TCL_NO_DEPRECATED
/* ARGSUSED */
int
Tcl_CaseObjCmd(
@@ -267,6 +267,7 @@ Tcl_CaseObjCmd(
return TCL_OK;
}
+#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 504af18..0dbf345 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -3869,6 +3869,22 @@ extern const TclStubs *tclStubsPtr;
#undef Tcl_AddObjErrorInfo
#define Tcl_AddObjErrorInfo(interp, message, length) \
Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
+#ifdef TCL_NO_DEPRECATED
+#undef Tcl_SetResult
+#define Tcl_SetResult(interp, result, freeProc) \
+ do { \
+ char *__result = result; \
+ Tcl_FreeProc *__freeProc = freeProc; \
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
+ if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
+ if (__freeProc == TCL_DYNAMIC) { \
+ ckfree(__result); \
+ } else { \
+ (*__freeProc)(__result); \
+ } \
+ } \
+ } while(0)
+#endif /* TCL_NO_DEPRECATED */
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 1115999..970978f 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -506,7 +506,7 @@ UpdateStringOfDict(
/* Handle empty list case first, simplifies what follows */
if (numElems == 0) {
- dictPtr->bytes = tclEmptyStringRep;
+ dictPtr->bytes = &tclEmptyString;
dictPtr->length = 0;
return;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 9103da0..c244b08 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -512,7 +512,7 @@ VarHashCreateVar(
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
- ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
+ ? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
#else /* !TCL_WIDE_INT_IS_LONG */
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
@@ -532,7 +532,7 @@ VarHashCreateVar(
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
- ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
+ ? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
#endif /* TCL_WIDE_INT_IS_LONG */
@@ -5950,16 +5950,17 @@ TEBCresume(
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
- if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
+ if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
+ || GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
/*
* At least one non-numeric argument - compare as strings.
*/
goto stringCompare;
}
- if (type1 == TCL_NUMBER_NAN) {
+ if (type1 == TCL_NUMBER_NAN || type2 == TCL_NUMBER_NAN) {
/*
- * NaN first arg: NaN != to everything, other compares are false.
+ * NaN arg: NaN != to everything, other compares are false.
*/
iResult = (*pc == INST_NEQ);
@@ -5969,21 +5970,6 @@ TEBCresume(
compare = MP_EQ;
goto convertComparison;
}
- if (GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
- /*
- * At least one non-numeric argument - compare as strings.
- */
-
- goto stringCompare;
- }
- if (type2 == TCL_NUMBER_NAN) {
- /*
- * NaN 2nd arg: NaN != to everything, other compares are false.
- */
-
- iResult = (*pc == INST_NEQ);
- goto foundResult;
- }
if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
l1 = *((const long *)ptr1);
l2 = *((const long *)ptr2);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 5c39e19..506e6d5 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -7127,47 +7127,6 @@ Tcl_Tell(
/*
*---------------------------------------------------------------------------
*
- * Tcl_SeekOld, Tcl_TellOld --
- *
- * Backward-compatibility versions of the seek/tell interface that do not
- * support 64-bit offsets. This interface is not documented or expected
- * to be supported indefinitely.
- *
- * Results:
- * As for Tcl_Seek and Tcl_Tell respectively, except truncated to
- * whatever value will fit in an 'int'.
- *
- * Side effects:
- * As for Tcl_Seek and Tcl_Tell respectively.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-Tcl_SeekOld(
- Tcl_Channel chan, /* The channel on which to seek. */
- int offset, /* Offset to seek to. */
- int mode) /* Relative to which location to seek? */
-{
- Tcl_WideInt wOffset, wResult;
-
- wOffset = Tcl_LongAsWide((long) offset);
- wResult = Tcl_Seek(chan, wOffset, mode);
- return (int) Tcl_WideAsLong(wResult);
-}
-
-int
-Tcl_TellOld(
- Tcl_Channel chan) /* The channel to return pos for. */
-{
- Tcl_WideInt wResult = Tcl_Tell(chan);
-
- return (int) Tcl_WideAsLong(wResult);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* Tcl_TruncateChannel --
*
* Truncate a channel to the given length.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8516385..4b87962 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2745,7 +2745,6 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
* shared by all new objects allocated by Tcl_NewObj.
*/
-MODULE_SCOPE char * tclEmptyStringRep;
MODULE_SCOPE char tclEmptyString;
/*
@@ -3219,9 +3218,11 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+#ifndef TCL_NO_DEPRECATED
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+#endif
MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -4064,7 +4065,7 @@ typedef const char *TclDTraceStr;
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
- (objPtr)->bytes = tclEmptyStringRep; \
+ (objPtr)->bytes = &tclEmptyString; \
(objPtr)->length = 0; \
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr)
@@ -4081,7 +4082,7 @@ typedef const char *TclDTraceStr;
if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
TCL_DTRACE_OBJ_FREE(objPtr); \
if ((objPtr)->bytes \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
+ && ((objPtr)->bytes != &tclEmptyString)) { \
ckfree((objPtr)->bytes); \
} \
(objPtr)->length = -1; \
@@ -4242,7 +4243,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
#define TclInitStringRep(objPtr, bytePtr, len) \
if ((len) == 0) { \
- (objPtr)->bytes = tclEmptyStringRep; \
+ (objPtr)->bytes = &tclEmptyString; \
(objPtr)->length = 0; \
} else { \
(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
@@ -4300,7 +4301,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
#define TclInvalidateStringRep(objPtr) \
if ((objPtr)->bytes != NULL) { \
- if ((objPtr)->bytes != tclEmptyStringRep) { \
+ if ((objPtr)->bytes != &tclEmptyString) { \
ckfree((objPtr)->bytes); \
} \
(objPtr)->bytes = NULL; \
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 2ead6df..88c98df 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -67,10 +67,8 @@ typedef struct Link {
static char * LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
const char *name1, const char *name2, int flags);
static Tcl_Obj * ObjValue(Link *linkPtr);
-static int GetInvalidIntFromObj(Tcl_Obj *objPtr,
- int *intPtr);
-static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
- double *doublePtr);
+static int GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);
+static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr);
/*
* Convenience macro for accessing the value of the C variable pointed to by a
@@ -263,7 +261,8 @@ LinkTraceProc(
int flags) /* Miscellaneous additional information. */
{
Link *linkPtr = clientData;
- int changed, valueLength;
+ int changed;
+ size_t valueLength;
const char *value;
char **pp;
Tcl_Obj *valueObj;
@@ -384,8 +383,7 @@ LinkTraceProc(
case TCL_LINK_INT:
if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
!= TCL_OK) {
- if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have integer value";
@@ -397,8 +395,7 @@ LinkTraceProc(
case TCL_LINK_WIDE_INT:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
!= TCL_OK) {
- if (GetInvalidIntFromObj(valueObj, &valueInt)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have integer value";
@@ -441,8 +438,7 @@ LinkTraceProc(
case TCL_LINK_CHAR:
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have char value";
@@ -455,8 +451,7 @@ LinkTraceProc(
case TCL_LINK_UCHAR:
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|| valueInt < 0 || valueInt > UCHAR_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have unsigned char value";
@@ -469,8 +464,7 @@ LinkTraceProc(
case TCL_LINK_SHORT:
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have short value";
@@ -483,8 +477,7 @@ LinkTraceProc(
case TCL_LINK_USHORT:
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|| valueInt < 0 || valueInt > USHRT_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have unsigned short value";
@@ -497,8 +490,7 @@ LinkTraceProc(
case TCL_LINK_UINT:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|| valueWide < 0 || valueWide > UINT_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have unsigned int value";
@@ -513,8 +505,7 @@ LinkTraceProc(
case TCL_LINK_LONG:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have long value";
@@ -529,8 +520,7 @@ LinkTraceProc(
case TCL_LINK_ULONG:
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have unsigned long value";
@@ -547,8 +537,7 @@ LinkTraceProc(
* FIXME: represent as a bignum.
*/
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK) {
- if (GetInvalidIntFromObj(valueObj, &valueInt)
- != TCL_OK) {
+ if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have unsigned wide int value";
@@ -575,12 +564,12 @@ LinkTraceProc(
break;
case TCL_LINK_STRING:
- value = TclGetStringFromObj(valueObj, &valueLength);
- valueLength++;
+ value = TclGetString(valueObj);
+ valueLength = valueObj->length + 1;
pp = (char **) linkPtr->addr;
*pp = ckrealloc(*pp, valueLength);
- memcpy(*pp, value, (unsigned) valueLength);
+ memcpy(*pp, value, valueLength);
break;
default:
@@ -688,17 +677,16 @@ static Tcl_ObjType invalidRealType = {
static int
SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
- int length;
const char *str;
const char *endPtr;
- str = TclGetStringFromObj(objPtr, &length);
- if ((length == 1) && (str[0] == '.')){
+ str = TclGetString(objPtr);
+ if ((objPtr->length == 1) && (str[0] == '.')){
objPtr->typePtr = &invalidRealType;
objPtr->internalRep.doubleValue = 0.0;
return TCL_OK;
}
- if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr,
+ if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr,
TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
/* If number is followed by [eE][+-]?, then it is an invalid
* double, but it could be the start of a valid double. */
@@ -708,7 +696,7 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
if (*endPtr == 0) {
double doubleValue = 0.0;
Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
- if (objPtr->typePtr->freeIntRepProc) objPtr->typePtr->freeIntRepProc(objPtr);
+ TclFreeIntRep(objPtr);
objPtr->typePtr = &invalidRealType;
objPtr->internalRep.doubleValue = doubleValue;
return TCL_OK;
@@ -722,23 +710,21 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
/*
* This function checks for integer representations, which are valid
* when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are "", "+", "-", "0x", "0b" and "0o"
+ * contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o"
* (upperand lowercase). See bug [39f6304c2e].
*/
int
-GetInvalidIntFromObj(Tcl_Obj *objPtr,
- int *intPtr)
+GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
{
- int length;
- const char *str = TclGetStringFromObj(objPtr, &length);
+ const char *str = TclGetString(objPtr);
- if ((length == 1) && strchr("+-", str[0])) {
- *intPtr = (str[0] == '+');
- return TCL_OK;
- } else if ((length == 0) ||
- ((length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
+ if ((objPtr->length == 0) ||
+ ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
*intPtr = 0;
return TCL_OK;
+ } else if ((objPtr->length == 1) && strchr("+-", str[0])) {
+ *intPtr = (str[0] == '+');
+ return TCL_OK;
}
return TCL_ERROR;
}
@@ -746,25 +732,28 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr,
/*
* This function checks for double representations, which are valid
* when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are ".", "+", "-", "0x", "0b" and "0o"
+ * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o"
* (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
*/
int
GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
double *doublePtr)
{
- int intValue, result;
+ int intValue;
- if ((objPtr->typePtr == &invalidRealType) ||
- (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK)) {
- *doublePtr = objPtr->internalRep.doubleValue;
- return TCL_OK;
+ if (objPtr->typePtr == &invalidRealType) {
+ goto gotdouble;
}
- result = GetInvalidIntFromObj(objPtr, &intValue);
- if (result == TCL_OK) {
+ if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
*doublePtr = (double) intValue;
+ return TCL_OK;
}
- return result;
+ if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
+ gotdouble:
+ *doublePtr = objPtr->internalRep.doubleValue;
+ return TCL_OK;
+ }
+ return TCL_ERROR;
}
/*
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index c9fd333..11374cc 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -374,7 +374,7 @@ Tcl_SetListObj(
listRepPtr = NewListIntRep(objc, objv, 1);
ListSetIntRep(objPtr, listRepPtr);
} else {
- objPtr->bytes = tclEmptyStringRep;
+ objPtr->bytes = &tclEmptyString;
objPtr->length = 0;
}
}
@@ -465,7 +465,7 @@ Tcl_ListObjGetElements(
if (listPtr->typePtr != &tclListType) {
int result;
- if (listPtr->bytes == tclEmptyStringRep) {
+ if (listPtr->bytes == &tclEmptyString) {
*objcPtr = 0;
*objvPtr = NULL;
return TCL_OK;
@@ -575,7 +575,7 @@ Tcl_ListObjAppendElement(
if (listPtr->typePtr != &tclListType) {
int result;
- if (listPtr->bytes == tclEmptyStringRep) {
+ if (listPtr->bytes == &tclEmptyString) {
Tcl_SetListObj(listPtr, 1, &objPtr);
return TCL_OK;
}
@@ -739,7 +739,7 @@ Tcl_ListObjIndex(
if (listPtr->typePtr != &tclListType) {
int result;
- if (listPtr->bytes == tclEmptyStringRep) {
+ if (listPtr->bytes == &tclEmptyString) {
*objPtrPtr = NULL;
return TCL_OK;
}
@@ -792,7 +792,7 @@ Tcl_ListObjLength(
if (listPtr->typePtr != &tclListType) {
int result;
- if (listPtr->bytes == tclEmptyStringRep) {
+ if (listPtr->bytes == &tclEmptyString) {
*intPtr = 0;
return TCL_OK;
}
@@ -863,7 +863,7 @@ Tcl_ListObjReplace(
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
if (listPtr->typePtr != &tclListType) {
- if (listPtr->bytes == tclEmptyStringRep) {
+ if (listPtr->bytes == &tclEmptyString) {
if (!objc) {
return TCL_OK;
}
@@ -1650,7 +1650,7 @@ TclListObjSetElement(
if (listPtr->typePtr != &tclListType) {
int result;
- if (listPtr->bytes == tclEmptyStringRep) {
+ if (listPtr->bytes == &tclEmptyString) {
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
@@ -1979,7 +1979,7 @@ UpdateStringOfList(
*/
if (numElems == 0) {
- listPtr->bytes = tclEmptyStringRep;
+ listPtr->bytes = &tclEmptyString;
listPtr->length = 0;
return;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index df900ce..1abbb31 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -49,7 +49,6 @@ Tcl_Mutex tclObjMutex;
*/
char tclEmptyString = '\0';
-char *tclEmptyStringRep = &tclEmptyString;
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
/*
@@ -1060,7 +1059,7 @@ TclDbInitNewObj(
* debugging. */
{
objPtr->refCount = 0;
- objPtr->bytes = tclEmptyStringRep;
+ objPtr->bytes = &tclEmptyString;
objPtr->length = 0;
objPtr->typePtr = NULL;
@@ -2004,9 +2003,10 @@ static int
ParseBoolean(
register Tcl_Obj *objPtr) /* The object to parse/convert. */
{
- int i, length, newBool;
+ int newBool;
char lowerCase[6];
- const char *str = TclGetStringFromObj(objPtr, &length);
+ const char *str = TclGetString(objPtr);
+ size_t i, length = objPtr->length;
if ((length == 0) || (length > 5)) {
/*
@@ -2058,25 +2058,25 @@ ParseBoolean(
/*
* Checking the 'y' is redundant, but makes the code clearer.
*/
- if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "yes", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'n':
- if (strncmp(lowerCase, "no", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "no", length) == 0) {
newBool = 0;
goto goodBoolean;
}
return TCL_ERROR;
case 't':
- if (strncmp(lowerCase, "true", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "true", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'f':
- if (strncmp(lowerCase, "false", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "false", length) == 0) {
newBool = 0;
goto goodBoolean;
}
@@ -2085,10 +2085,10 @@ ParseBoolean(
if (length < 2) {
return TCL_ERROR;
}
- if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "on", length) == 0) {
newBool = 1;
goto goodBoolean;
- } else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+ } else if (strncmp(lowerCase, "off", length) == 0) {
newBool = 0;
goto goodBoolean;
}
@@ -2784,7 +2784,7 @@ Tcl_GetLongFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
- Tcl_GetString(objPtr)));
+ TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3085,7 +3085,7 @@ Tcl_GetWideIntFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
- Tcl_GetString(objPtr)));
+ TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3394,7 +3394,7 @@ GetBignumFromObj(
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = NULL;
if (objPtr->bytes == NULL) {
- TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+ TclInitStringRep(objPtr, &tclEmptyString, 0);
}
}
return TCL_OK;
@@ -3414,7 +3414,7 @@ GetBignumFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
- Tcl_GetString(objPtr)));
+ TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3964,7 +3964,7 @@ TclCompareObjKeys(
Tcl_Obj *objPtr1 = keyPtr;
Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
register const char *p1, *p2;
- register int l1, l2;
+ register size_t l1, l2;
/*
* If the object pointers are the same then they match.
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 68ec2c4..0053041 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -2608,7 +2608,7 @@ UpdateStringOfFsPath(
pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen);
pathPtr->length = cwdLen;
- copy->bytes = tclEmptyStringRep;
+ copy->bytes = &tclEmptyString;
copy->length = 0;
TclDecrRefCount(copy);
}
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 42dd08d..2925c34 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -17,6 +17,8 @@
#include "tclInt.h"
+MODULE_SCOPE char *tclEmptyStringRep = &tclEmptyString;
+
/*
* Each invocation of the "package ifneeded" command creates a structure of
* the following type, which is used to load the package into the interpreter
diff --git a/generic/tclProc.c b/generic/tclProc.c
index bed520a..373192c 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -500,7 +500,8 @@ TclCreateProc(
}
for (i = 0; i < numArgs; i++) {
- int fieldCount, nameLength, valueLength;
+ int fieldCount, nameLength;
+ size_t valueLength;
const char **fieldValues;
/*
@@ -602,12 +603,11 @@ TclCreateProc(
*/
if (localPtr->defValuePtr != NULL) {
- int tmpLength;
- const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr,
- &tmpLength);
+ const char *tmpPtr = TclGetString(localPtr->defValuePtr);
+ size_t tmpLength = localPtr->defValuePtr->length;
if ((valueLength != tmpLength) ||
- strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
+ strncmp(fieldValues[1], tmpPtr, tmpLength)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"procedure \"%s\": formal parameter \"%s\" has "
"default value inconsistent with precompiled body",
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 9d0714c..ddf764b 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -27,7 +27,9 @@ enum returnKeys {
static Tcl_Obj ** GetKeys(void);
static void ReleaseKeys(ClientData clientData);
static void ResetObjResult(Interp *iPtr);
+#ifndef TCL_NO_DEPRECATED
static void SetupAppendBuffer(Interp *iPtr, int newSpace);
+#endif /* !TCL_NO_DEPRECATED */
/*
* This structure is used to take a snapshot of the interpreter state in
@@ -35,7 +37,7 @@ static void SetupAppendBuffer(Interp *iPtr, int newSpace);
* then back up to the result or the error that was previously in progress.
*/
-typedef struct InterpState {
+typedef struct {
int status; /* return code status */
int flags; /* Each remaining field saves the */
int returnLevel; /* corresponding field of the Interp */
@@ -407,6 +409,7 @@ Tcl_DiscardResult(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
void
Tcl_SetResult(
Tcl_Interp *interp, /* Interpreter with which to associate the
@@ -461,6 +464,7 @@ Tcl_SetResult(
ResetObjResult(iPtr);
}
+#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -483,18 +487,21 @@ const char *
Tcl_GetStringResult(
register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
+ Interp *iPtr = (Interp *) interp;
+#ifdef TCL_NO_DEPRECATED
+ return Tcl_GetString(iPtr->objResultPtr);
+#else
/*
* If the string result is empty, move the object result to the string
* result, then reset the object result.
*/
- Interp *iPtr = (Interp *) interp;
-
if (*(iPtr->result) == 0) {
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
return iPtr->result;
+#endif
}
/*
@@ -536,6 +543,7 @@ Tcl_SetObjResult(
TclDecrRefCount(oldObjResult);
+#ifndef TCL_NO_DEPRECATED
/*
* Reset the string result since we just set the result object.
*/
@@ -550,6 +558,7 @@ Tcl_SetObjResult(
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
+#endif
}
/*
@@ -578,6 +587,7 @@ Tcl_GetObjResult(
Tcl_Interp *interp) /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
+#ifndef TCL_NO_DEPRECATED
Tcl_Obj *objResultPtr;
int length;
@@ -604,6 +614,7 @@ Tcl_GetObjResult(
iPtr->result = iPtr->resultSpace;
iPtr->result[0] = 0;
}
+#endif /* !TCL_NO_DEPRECATED */
return iPtr->objResultPtr;
}
@@ -722,6 +733,21 @@ Tcl_AppendElement(
* to result. */
{
Interp *iPtr = (Interp *) interp;
+#ifdef TCL_NO_DEPRECATED
+ Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
+ Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
+ const char *bytes;
+
+ if (Tcl_IsShared(iPtr->objResultPtr)) {
+ Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
+ }
+ bytes = TclGetString(iPtr->objResultPtr);
+ if (TclNeedSpace(bytes, bytes+iPtr->objResultPtr->length)) {
+ Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
+ }
+ Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
+ Tcl_DecrRefCount(listPtr);
+#else
char *dst;
int size;
int flags;
@@ -765,6 +791,7 @@ Tcl_AppendElement(
flags |= TCL_DONT_QUOTE_HASH;
}
iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
+#endif /* !TCL_NO_DEPRECATED */
}
/*
@@ -786,6 +813,7 @@ Tcl_AppendElement(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
static void
SetupAppendBuffer(
Interp *iPtr, /* Interpreter whose result is being set up. */
@@ -846,6 +874,7 @@ SetupAppendBuffer(
Tcl_FreeResult((Tcl_Interp *) iPtr);
iPtr->result = iPtr->appendResult;
}
+#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -875,6 +904,7 @@ Tcl_FreeResult(
{
register Interp *iPtr = (Interp *) interp;
+#ifndef TCL_NO_DEPRECATED
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
@@ -884,6 +914,7 @@ Tcl_FreeResult(
iPtr->freeProc = 0;
}
+#endif /* !TCL_NO_DEPRECATED */
ResetObjResult(iPtr);
}
@@ -913,6 +944,7 @@ Tcl_ResetResult(
register Interp *iPtr = (Interp *) interp;
ResetObjResult(iPtr);
+#ifndef TCL_NO_DEPRECATED
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
@@ -923,6 +955,7 @@ Tcl_ResetResult(
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
+#endif /* !TCL_NO_DEPRECATED */
if (iPtr->errorCode) {
/* Legacy support */
if (iPtr->flags & ERR_LEGACY_COPY) {
@@ -982,11 +1015,11 @@ ResetObjResult(
Tcl_IncrRefCount(objResultPtr);
iPtr->objResultPtr = objResultPtr;
} else {
- if (objResultPtr->bytes != tclEmptyStringRep) {
+ if (objResultPtr->bytes != &tclEmptyString) {
if (objResultPtr->bytes) {
ckfree(objResultPtr->bytes);
}
- objResultPtr->bytes = tclEmptyStringRep;
+ objResultPtr->bytes = &tclEmptyString;
objResultPtr->length = 0;
}
TclFreeIntRep(objResultPtr);
@@ -1276,10 +1309,8 @@ TclProcessReturn(
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
&valuePtr);
if (valuePtr != NULL) {
- int infoLen;
-
- (void) TclGetStringFromObj(valuePtr, &infoLen);
- if (infoLen) {
+ (void) TclGetString(valuePtr);
+ if (valuePtr->length) {
iPtr->errorInfo = valuePtr;
Tcl_IncrRefCount(iPtr->errorInfo);
iPtr->flags |= ERR_ALREADY_LOGGED;
@@ -1382,13 +1413,11 @@ TclMergeReturnOptions(
Tcl_Obj **keys = GetKeys();
for (; objc > 1; objv += 2, objc -= 2) {
- int optLen;
- const char *opt = TclGetStringFromObj(objv[0], &optLen);
- int compareLen;
- const char *compare =
- TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen);
+ const char *opt = TclGetString(objv[0]);
+ const char *compare = TclGetString(keys[KEY_OPTIONS]);
- if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) {
+ if ((objv[0]->length == keys[KEY_OPTIONS]->length)
+ && (memcmp(opt, compare, objv[0]->length) == 0)) {
Tcl_DictSearch search;
int done = 0;
Tcl_Obj *keyPtr;
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index db233b3..c45baa1 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -136,7 +136,7 @@ GrowStringBuffer(
char *ptr = NULL;
int attempt;
- if (objPtr->bytes == tclEmptyStringRep) {
+ if (objPtr->bytes == &tclEmptyString) {
objPtr->bytes = NULL;
}
if (flag == 0 || stringPtr->allocated > 0) {
@@ -767,7 +767,7 @@ Tcl_SetObjLength(
/*
* Need to enlarge the buffer.
*/
- if (objPtr->bytes == tclEmptyStringRep) {
+ if (objPtr->bytes == &tclEmptyString) {
objPtr->bytes = ckalloc(length + 1);
} else {
objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
@@ -873,7 +873,7 @@ Tcl_AttemptSetObjLength(
char *newBytes;
- if (objPtr->bytes == tclEmptyStringRep) {
+ if (objPtr->bytes == &tclEmptyString) {
newBytes = attemptckalloc(length + 1);
} else {
newBytes = attemptckrealloc(objPtr->bytes, length + 1);
@@ -1202,7 +1202,7 @@ Tcl_AppendObjToObj(
* that appending nothing to anything leaves that starting anything...
*/
- if (appendObjPtr->bytes == tclEmptyStringRep) {
+ if (appendObjPtr->bytes == &tclEmptyString) {
return;
}
@@ -1213,7 +1213,7 @@ Tcl_AppendObjToObj(
* information; this is a special-case optimization only.
*/
- if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
+ if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
&& TclIsPureByteArray(appendObjPtr)) {
/*
@@ -3603,7 +3603,7 @@ UpdateStringOfString(
stringPtr->allocated = 0;
if (stringPtr->numChars == 0) {
- TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+ TclInitStringRep(objPtr, &tclEmptyString, 0);
} else {
(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
stringPtr->numChars);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 23da6dc..561b9dd 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -290,10 +290,47 @@ static int formatInt(char *buffer, int n){
#endif
#else /* UNIX and MAC */
-# define TclpLocaltime_unix TclpLocaltime
-# define TclpGmtime_unix TclpGmtime
+# ifdef TCL_NO_DEPRECATED
+# define TclpLocaltime_unix 0
+# define TclpGmtime_unix 0
+# else
+# define TclpLocaltime_unix TclpLocaltime
+# define TclpGmtime_unix TclpGmtime
+# endif
#endif
+#ifdef TCL_NO_DEPRECATED
+# define Tcl_SeekOld 0
+# define Tcl_TellOld 0
+# undef Tcl_SetResult
+# define Tcl_SetResult 0
+#else /* TCL_NO_DEPRECATED */
+# define Tcl_SeekOld seekOld
+# define Tcl_TellOld tellOld
+
+static int
+seekOld(
+ Tcl_Channel chan, /* The channel on which to seek. */
+ int offset, /* Offset to seek to. */
+ int mode) /* Relative to which location to seek? */
+{
+ Tcl_WideInt wOffset, wResult;
+
+ wOffset = Tcl_LongAsWide((long) offset);
+ wResult = Tcl_Seek(chan, wOffset, mode);
+ return (int) Tcl_WideAsLong(wResult);
+}
+
+static int
+tellOld(
+ Tcl_Channel chan) /* The channel to return pos for. */
+{
+ Tcl_WideInt wResult = Tcl_Tell(chan);
+
+ return (int) Tcl_WideAsLong(wResult);
+}
+#endif /* !TCL_NO_DEPRECATED */
+
/*
* WARNING: The contents of this file is automatically generated by the
* tools/genStubs.tcl script. Any modifications to the function declarations
diff --git a/generic/tclTest.c b/generic/tclTest.c
index faecbc6..a9dc1ca 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -290,12 +290,14 @@ static int TestlinkCmd(ClientData dummy,
static int TestlocaleCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+#ifndef TCL_NO_DEPRECATED
static int TestMathFunc(ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr);
static int TestMathFunc2(ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr);
+#endif /* TCL_NO_DEPRECATED */
static int TestmainthreadCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestsetmainloopCmd(ClientData dummy,
@@ -329,12 +331,10 @@ static int TestreturnObjCmd(ClientData dummy,
Tcl_Obj *const objv[]);
static void TestregexpXflags(const char *string,
int length, int *cflagsPtr, int *eflagsPtr);
-#ifndef TCL_NO_DEPRECATED
static int TestsaveresultCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static void TestsaveresultFree(char *blockPtr);
-#endif /* TCL_NO_DEPRECATED */
static int TestsetassocdataCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestsetCmd(ClientData dummy,
@@ -555,7 +555,7 @@ Tcltest_Init(
}
/* TIP #268: Full patchlevel instead of just major.minor */
- if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
+ if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -658,10 +658,8 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
NULL, NULL);
-#ifndef TCL_NO_DEPRECATED
Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
NULL, NULL);
-#endif /* TCL_NO_DEPRECATED */
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
@@ -3341,6 +3339,7 @@ TestlocaleCmd(
*/
/* ARGSUSED */
+#ifndef TCL_NO_DEPRECATED
static int
TestMathFunc(
ClientData clientData, /* Integer value to return. */
@@ -3460,6 +3459,7 @@ TestMathFunc2(
}
return result;
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -5144,7 +5144,6 @@ Testset2Cmd(
}
}
-#ifndef TCL_NO_DEPRECATED
/*
*----------------------------------------------------------------------
*
@@ -5197,6 +5196,7 @@ TestsaveresultCmd(
return TCL_ERROR;
}
+ freeCount = 0;
objPtr = NULL; /* Lint. */
switch ((enum options) index) {
case RESULT_SMALL:
@@ -5221,7 +5221,6 @@ TestsaveresultCmd(
break;
}
- freeCount = 0;
Tcl_SaveResult(interp, &state);
if (((enum options) index) == RESULT_OBJECT) {
@@ -5239,11 +5238,9 @@ TestsaveresultCmd(
switch ((enum options) index) {
case RESULT_DYNAMIC: {
- int present = iPtr->freeProc == TestsaveresultFree;
- int called = freeCount;
+ int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount;
- Tcl_AppendElement(interp, called ? "called" : "notCalled");
- Tcl_AppendElement(interp, present ? "present" : "missing");
+ Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak");
break;
}
case RESULT_OBJECT:
@@ -5278,7 +5275,6 @@ TestsaveresultFree(
{
freeCount++;
}
-#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 531f386..a4d523a 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1384,7 +1384,7 @@ TclConvertElement(
*/
if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) {
- src = tclEmptyStringRep;
+ src = &tclEmptyString;
length = 0;
conversion = CONVERT_BRACE;
}
@@ -2894,7 +2894,6 @@ Tcl_DStringResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
- Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));
}
@@ -2924,6 +2923,14 @@ Tcl_DStringGetResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the result
* of interp. */
{
+#ifdef TCL_NO_DEPRECATED
+ Tcl_Obj *obj = Tcl_GetObjResult(interp);
+ const char *bytes = TclGetString(obj);
+
+ Tcl_DStringFree(dsPtr);
+ Tcl_DStringAppend(dsPtr, bytes, obj->length);
+ Tcl_ResetResult(interp);
+#else
Interp *iPtr = (Interp *) interp;
if (dsPtr->string != dsPtr->staticSpace) {
@@ -2932,7 +2939,7 @@ Tcl_DStringGetResult(
/*
* Do more efficient transfer when we know the result is a Tcl_Obj. When
- * there's no st`ring result, we only have to deal with two cases:
+ * there's no string result, we only have to deal with two cases:
*
* 1. When the string rep is the empty string, when we don't copy but
* instead use the staticSpace in the DString to hold an empty string.
@@ -2947,7 +2954,7 @@ Tcl_DStringGetResult(
if (!iPtr->result[0] && iPtr->objResultPtr
&& !Tcl_IsShared(iPtr->objResultPtr)) {
- if (iPtr->objResultPtr->bytes == tclEmptyStringRep) {
+ if (iPtr->objResultPtr->bytes == &tclEmptyString) {
dsPtr->string = dsPtr->staticSpace;
dsPtr->string[0] = 0;
dsPtr->length = 0;
@@ -2957,7 +2964,7 @@ Tcl_DStringGetResult(
dsPtr->length = iPtr->objResultPtr->length;
dsPtr->spaceAvl = dsPtr->length + 1;
TclFreeIntRep(iPtr->objResultPtr);
- iPtr->objResultPtr->bytes = tclEmptyStringRep;
+ iPtr->objResultPtr->bytes = &tclEmptyString;
iPtr->objResultPtr->length = 0;
}
return;
@@ -2995,6 +3002,7 @@ Tcl_DStringGetResult(
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
+#endif /* !TCL_NO_DEPRECATED */
}
/*
@@ -3576,7 +3584,7 @@ TclGetIntForIndex(
int *indexPtr) /* Location filled in with an integer
* representing an index. */
{
- int length;
+ size_t length;
char *opPtr;
const char *bytes;
@@ -3594,7 +3602,8 @@ TclGetIntForIndex(
return TCL_OK;
}
- bytes = TclGetStringFromObj(objPtr, &length);
+ bytes = TclGetString(objPtr);
+ length = objPtr->length;
/*
* Leading whitespace is acceptable in an index.
generated by cgit v0.12 at 2024-07-15 13:07:10 (GMT)