summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authormig <mig>2013-01-15 19:35:52 (GMT)
committermig <mig>2013-01-15 19:35:52 (GMT)
commita516222ac12d462aa9216fe294ad8c8b0cf4dc33 (patch)
treef4390779f1403b02307fc0d15bde962352632e81
parent71ccd57a94c21d7e36abe8550f656e6f082a2907 (diff)
parent1874c5c7750d3f4dc032c9498cf7270de788e5f2 (diff)
downloadtcl-ISC_peephole.zip
tcl-ISC_peephole.tar.gz
tcl-ISC_peephole.tar.bz2
merge trunkISC_peephole
-rw-r--r--ChangeLog22
-rw-r--r--doc/fileevent.n17
-rw-r--r--generic/tclInt.decls20
-rw-r--r--generic/tclIntDecls.h87
-rw-r--r--generic/tclStubInit.c7
-rw-r--r--generic/tclVar.c120
6 files changed, 171 insertions, 102 deletions
diff --git a/ChangeLog b/ChangeLog
index 1655e15..d9b7df4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2013-01-14 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: Put back Tcl_[GS]etStartupScript in
+ internal stub table, so extensions using this, compiled
+ against 8.5 headers still run in Tcl 8.6.
+
+2013-01-13 Alexandre Ferrieux <ferrieux@users.sourceforge.net>
+ * doc/fileevent.n: Clarify readable fileevent "false positives" in
+ the case of multibyte encodings/transforms [Bug 3436609].
+
+2013-01-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIntDecls.h: If TCL_NO_DEPRECATED is defined, make
+ sure that TIP #139 functions all are taken from the public stub
+ table, even if the inclusion is through tclInt.h.
+
+2013-01-12 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclInt.decls: Put back TclBackgroundException in
+ internal stub table, so extensions using this, compiled
+ against 8.5 headers still run in Tcl 8.6.
+
2013-01-09 Jan Nijtmans <nijtmans@users.sf.net>
* library/http/http.tcl: [Bug 3599395]: http assumes status line
diff --git a/doc/fileevent.n b/doc/fileevent.n
index df48d2a..e453748 100644
--- a/doc/fileevent.n
+++ b/doc/fileevent.n
@@ -80,13 +80,16 @@ A channel is considered to be writable if at least one byte of data
can be written to the underlying file or device without blocking,
or if an error condition is present on the underlying file or device.
.PP
-Event-driven I/O works best for channels that have been
-placed into nonblocking mode with the \fBfconfigure\fR command.
-In blocking mode, a \fBputs\fR command may block if you give it
-more data than the underlying file or device can accept, and a
-\fBgets\fR or \fBread\fR command will block if you attempt to read
-more data than is ready; no events will be processed while the
-commands block.
+Event-driven I/O works best for channels that have been placed into
+nonblocking mode with the \fBfconfigure\fR command. In blocking mode,
+a \fBputs\fR command may block if you give it more data than the
+underlying file or device can accept, and a \fBgets\fR or \fBread\fR
+command will block if you attempt to read more data than is ready; a
+readable underlying file or device may not even guarantee that a
+blocking [read 1] will succeed (counter-examples being multi-byte
+encodings, compression or encryption transforms ). In all such cases,
+no events will be processed while the commands block.
+.PP
In nonblocking mode \fBputs\fR, \fBread\fR, and \fBgets\fR never block.
See the documentation for the individual commands for information
on how they handle blocking and nonblocking channels.
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index f215d32..58dab42 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -731,13 +731,13 @@ declare 177 {
void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
const char *operation, const char *reason)
}
-# TIP 338 made these public - now declared in tcl.h
-#declare 178 {
-# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
-#}
-#declare 179 {
-# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
-#}
+# TIP 338 made these public - now declared in tcl.h too
+declare 178 {
+ void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
+}
+declare 179 {
+ Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
+}
# REMOVED
# Allocate lists without copying arrays
@@ -941,9 +941,9 @@ declare 235 {
# TIP 337 made this one public
-#declare 236 {
-# void TclBackgroundException(Tcl_Interp *interp, int code)
-#}
+declare 236 {
+ void TclBackgroundException(Tcl_Interp *interp, int code)
+}
# TIP #285: Script cancellation support.
declare 237 {
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index df5ac97..092225e 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -29,19 +29,20 @@
#endif
/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
-#undef Tcl_AppendExportList
#undef Tcl_CreateNamespace
#undef Tcl_DeleteNamespace
+#undef Tcl_AppendExportList
#undef Tcl_Export
-#undef Tcl_FindCommand
-#undef Tcl_FindNamespace
-#undef Tcl_FindNamespaceVar
+#undef Tcl_Import
#undef Tcl_ForgetImport
-#undef Tcl_GetCommandFromObj
-#undef Tcl_GetCommandFullName
#undef Tcl_GetCurrentNamespace
#undef Tcl_GetGlobalNamespace
-#undef Tcl_Import
+#undef Tcl_FindNamespace
+#undef Tcl_FindCommand
+#undef Tcl_GetCommandFromObj
+#undef Tcl_GetCommandFullName
+#undef Tcl_SetStartupScript
+#undef Tcl_GetStartupScript
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
@@ -447,8 +448,11 @@ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr);
EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1,
const char *part2, const char *operation,
const char *reason);
-/* Slot 178 is reserved */
-/* Slot 179 is reserved */
+/* 178 */
+EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr,
+ const char *encodingName);
+/* 179 */
+EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr);
/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* 182 */
@@ -557,7 +561,8 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
/* 235 */
EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
Namespace *nsPtr);
-/* Slot 236 is reserved */
+/* 236 */
+EXTERN void TclBackgroundException(Tcl_Interp *interp, int code);
/* 237 */
EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
@@ -784,8 +789,8 @@ typedef struct TclIntStubs {
int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
- void (*reserved178)(void);
- void (*reserved179)(void);
+ void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
+ Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */
void (*reserved180)(void);
void (*reserved181)(void);
struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
@@ -842,7 +847,7 @@ typedef struct TclIntStubs {
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
- void (*reserved236)(void);
+ void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
@@ -1164,8 +1169,10 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclCleanupVar) /* 176 */
#define TclVarErrMsg \
(tclIntStubsPtr->tclVarErrMsg) /* 177 */
-/* Slot 178 is reserved */
-/* Slot 179 is reserved */
+#define Tcl_SetStartupScript \
+ (tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
+#define Tcl_GetStartupScript \
+ (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
#define TclpLocaltime \
@@ -1252,7 +1259,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#define TclInitVarHashTable \
(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
-/* Slot 236 is reserved */
+#define TclBackgroundException \
+ (tclIntStubsPtr->tclBackgroundException) /* 236 */
#define TclResetCancellation \
(tclIntStubsPtr->tclResetCancellation) /* 237 */
#define TclNRInterpProc \
@@ -1289,4 +1297,51 @@ extern const TclIntStubs *tclIntStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+#undef TclBackgroundException
+
+#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
+# undef Tcl_SetStartupScript
+# define Tcl_SetStartupScript \
+ (tclStubsPtr->tcl_SetStartupScript) /* 622 */
+# undef Tcl_GetStartupScript
+# define Tcl_GetStartupScript \
+ (tclStubsPtr->tcl_GetStartupScript) /* 623 */
+# undef Tcl_CreateNamespace
+# define Tcl_CreateNamespace \
+ (tclStubsPtr->tcl_CreateNamespace) /* 506 */
+# undef Tcl_DeleteNamespace
+# define Tcl_DeleteNamespace \
+ (tclStubsPtr->tcl_DeleteNamespace) /* 507 */
+# undef Tcl_AppendExportList
+# define Tcl_AppendExportList \
+ (tclStubsPtr->tcl_AppendExportList) /* 508 */
+# undef Tcl_Export
+# define Tcl_Export \
+ (tclStubsPtr->tcl_Export) /* 509 */
+# undef Tcl_Import
+# define Tcl_Import \
+ (tclStubsPtr->tcl_Import) /* 510 */
+# undef Tcl_ForgetImport
+# define Tcl_ForgetImport \
+ (tclStubsPtr->tcl_ForgetImport) /* 511 */
+# undef Tcl_GetCurrentNamespace
+# define Tcl_GetCurrentNamespace \
+ (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
+# undef Tcl_GetGlobalNamespace
+# define Tcl_GetGlobalNamespace \
+ (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
+# undef Tcl_FindNamespace
+# define Tcl_FindNamespace \
+ (tclStubsPtr->tcl_FindNamespace) /* 514 */
+# undef Tcl_FindCommand
+# define Tcl_FindCommand \
+ (tclStubsPtr->tcl_FindCommand) /* 515 */
+# undef Tcl_GetCommandFromObj
+# define Tcl_GetCommandFromObj \
+ (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
+# undef Tcl_GetCommandFullName
+# define Tcl_GetCommandFullName \
+ (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
+#endif
+
#endif /* _TCLINTDECLS */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 88ada19..1d1fe15 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -41,6 +41,7 @@
#undef Tcl_FindExecutable
#undef TclpGetPid
#undef TclSockMinimumBuffers
+#define TclBackgroundException Tcl_BackgroundException
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#ifdef _WIN64
@@ -367,8 +368,8 @@ static const TclIntStubs tclIntStubs = {
TclCallVarTraces, /* 175 */
TclCleanupVar, /* 176 */
TclVarErrMsg, /* 177 */
- 0, /* 178 */
- 0, /* 179 */
+ Tcl_SetStartupScript, /* 178 */
+ Tcl_GetStartupScript, /* 179 */
0, /* 180 */
0, /* 181 */
TclpLocaltime, /* 182 */
@@ -425,7 +426,7 @@ static const TclIntStubs tclIntStubs = {
TclGetSrcInfoForPc, /* 233 */
TclVarHashCreateVar, /* 234 */
TclInitVarHashTable, /* 235 */
- 0, /* 236 */
+ TclBackgroundException, /* 236 */
TclResetCancellation, /* 237 */
TclNRInterpProc, /* 238 */
TclNRInterpProcCore, /* 239 */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 6b67029..9b8527c 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -47,6 +47,13 @@ static inline void CleanupVar(Var *varPtr, Var *arrayPtr);
#define VarHashGetValue(hPtr) \
((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
+/*
+ * NOTE: VarHashCreateVar increments the recount of its key argument.
+ * All callers that will call Tcl_DecrRefCount on that argument must
+ * call Tcl_IncrRefCount on it before passing it in. This requirement
+ * can bubble up to callers of callers .... etc.
+ */
+
static inline Var *
VarHashCreateVar(
TclVarHashTable *tablePtr,
@@ -383,11 +390,12 @@ TclLookupVar(
* address of array variable. Otherwise this
* is set to NULL. */
{
- Tcl_Obj *part1Ptr;
Var *varPtr;
+ Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
+ if (createPart1) {
+ Tcl_IncrRefCount(part1Ptr);
+ }
varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
createPart1, createPart2, arrayPtrPtr);
@@ -432,6 +440,8 @@ TclLookupVar(
* are 1. The object part1Ptr is converted to one of localVarNameType,
* tclNsVarNameType or tclParsedVarNameType and caches as much of the
* lookup as it can.
+ * When createPart1 is 1, callers must IncrRefCount part1Ptr if they
+ * plan to DecrRefCount it.
*
*----------------------------------------------------------------------
*/
@@ -460,14 +470,11 @@ TclObjLookupVar(
* address of array variable. Otherwise this
* is set to NULL. */
{
- Tcl_Obj *part2Ptr;
+ Tcl_Obj *part2Ptr = NULL;
Var *resPtr;
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
}
resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
@@ -847,6 +854,7 @@ TclObjLookupVarEx(
*
* Side effects:
* A new hashtable entry may be created if create is 1.
+ * Callers must Incr varNamePtr if they plan to Decr it if create is 1.
*
*----------------------------------------------------------------------
*/
@@ -1314,15 +1322,10 @@ Tcl_GetVar2Ex(
int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, and
* TCL_LEAVE_ERR_MSG bits. */
{
- Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
+ Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
}
resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
@@ -1618,27 +1621,9 @@ Tcl_SetVar2(
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
* TCL_LEAVE_ERR_MSG. */
{
- Tcl_Obj *valuePtr, *part1Ptr, *part2Ptr;
- Tcl_Obj *varValuePtr;
-
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
- if (part2 != NULL) {
- part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
- }
- valuePtr = Tcl_NewStringObj(newValue, -1);
- Tcl_IncrRefCount(valuePtr);
+ Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, part1, part2,
+ Tcl_NewStringObj(newValue, -1), flags);
- varValuePtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr, flags);
-
- Tcl_DecrRefCount(part1Ptr);
- if (part2Ptr != NULL) {
- Tcl_DecrRefCount(part2Ptr);
- }
- Tcl_DecrRefCount(valuePtr);
if (varValuePtr == NULL) {
return NULL;
}
@@ -1697,15 +1682,12 @@ Tcl_SetVar2Ex(
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT or
* TCL_LEAVE_ERR_MSG. */
{
- Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
+ Tcl_Obj *resPtr, *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
Tcl_IncrRefCount(part2Ptr);
- } else {
- part2Ptr = NULL;
}
resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
@@ -1738,6 +1720,7 @@ Tcl_SetVar2Ex(
* Side effects:
* The value of the given variable is set. If either the array or the
* entry didn't exist then a new variable is created.
+ * Callers must Incr part1Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -2027,6 +2010,7 @@ TclPtrSetVar(
* variable is created. The ref count for the returned object is _not_
* incremented to reflect the returned reference; if you want to keep a
* reference to the object you must increment its ref count yourself.
+ * Callers must Incr part1Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -2109,8 +2093,7 @@ TclPtrIncrObjVar(
* variable, or -1. Only used when part1Ptr is
* NULL. */
{
- register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
- int duplicated, code;
+ register Tcl_Obj *varValuePtr;
if (TclIsVarInHash(varPtr)) {
VarHashRefCount(varPtr)++;
@@ -2124,19 +2107,33 @@ TclPtrIncrObjVar(
varValuePtr = Tcl_NewIntObj(0);
}
if (Tcl_IsShared(varValuePtr)) {
- duplicated = 1;
+ /* Copy on write */
varValuePtr = Tcl_DuplicateObj(varValuePtr);
+
+ if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ varValuePtr, flags, index);
+ } else {
+ Tcl_DecrRefCount(varValuePtr);
+ return NULL;
+ }
} else {
- duplicated = 0;
- }
- code = TclIncrObj(interp, varValuePtr, incrPtr);
- if (code == TCL_OK) {
- newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
- part2Ptr, varValuePtr, flags, index);
- } else if (duplicated) {
- Tcl_DecrRefCount(varValuePtr);
+ /* Unshared - can Incr in place */
+ if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
+
+ /*
+ * This seems dumb to write the incremeted value into the var
+ * after we just adjusted the value in place, but the spec for
+ * [incr] requires that write traces fire, and making this call
+ * is the way to make that happen.
+ */
+
+ return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
+ varValuePtr, flags, index);
+ } else {
+ return NULL;
+ }
}
- return newValuePtr;
}
/*
@@ -2219,13 +2216,10 @@ Tcl_UnsetVar2(
* TCL_LEAVE_ERR_MSG. */
{
int result;
- Tcl_Obj *part1Ptr, *part2Ptr = NULL;
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
}
/*
@@ -2841,6 +2835,7 @@ Tcl_LappendObjCmd(
*
* Side effects:
* A variable will be created if one does not already exist.
+ * Callers must Incr arrayNameObj if they pland to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -4255,6 +4250,8 @@ TclInitArrayCmd(
* The variable given by myName is linked to the variable in framePtr
* given by otherP1 and otherP2, so that references to myName are
* redirected to the other variable like a symbolic link.
+ * Callers must Incr myNamePtr if they plan to Decr it.
+ * Callers must Incr otherP1Ptr if they plan to Decr it.
*
*----------------------------------------------------------------------
*/
@@ -4363,14 +4360,12 @@ TclPtrMakeUpvar(
int index) /* If the variable to be linked is an indexed
* scalar, this is its index. Otherwise, -1 */
{
- Tcl_Obj *myNamePtr;
+ Tcl_Obj *myNamePtr = NULL;
int result;
if (myName) {
myNamePtr = Tcl_NewStringObj(myName, -1);
Tcl_IncrRefCount(myNamePtr);
- } else {
- myNamePtr = NULL;
}
result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
if (myNamePtr) {
@@ -4379,6 +4374,8 @@ TclPtrMakeUpvar(
return result;
}
+/* Callers must Incr myNamePtr if they plan to Decr it. */
+
int
TclPtrObjMakeUpvar(
Tcl_Interp *interp, /* Interpreter containing variables. Used for
@@ -5242,8 +5239,6 @@ TclDeleteNamespaceVars(
for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
varPtr = VarHashFirstVar(tablePtr, &search)) {
Tcl_Obj *objPtr = Tcl_NewObj();
-
- Tcl_IncrRefCount(objPtr);
VarHashRefCount(varPtr)++; /* Make sure we get to remove from
* hash. */
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
@@ -5507,15 +5502,10 @@ TclVarErrMsg(
* e.g. "read", "set", or "unset". */
const char *reason) /* String describing why operation failed. */
{
- Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL;
+ Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);
- part1Ptr = Tcl_NewStringObj(part1, -1);
- Tcl_IncrRefCount(part1Ptr);
if (part2) {
part2Ptr = Tcl_NewStringObj(part2, -1);
- Tcl_IncrRefCount(part2Ptr);
- } else {
- part2 = NULL;
}
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
@@ -5788,7 +5778,6 @@ Tcl_FindNamespaceVar(
Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
Tcl_Var var;
- Tcl_IncrRefCount(namePtr);
var = ObjFindNamespaceVar(interp, namePtr, contextNsPtr, flags);
Tcl_DecrRefCount(namePtr);
return var;
@@ -5883,7 +5872,6 @@ ObjFindNamespaceVar(
varPtr = NULL;
if (simpleName != name) {
simpleNamePtr = Tcl_NewStringObj(simpleName, -1);
- Tcl_IncrRefCount(simpleNamePtr);
} else {
simpleNamePtr = namePtr;
}