summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclEnsemble.c6
-rw-r--r--generic/tclFileName.c76
-rw-r--r--generic/tclHash.c4
-rw-r--r--generic/tclIOSock.c12
-rw-r--r--generic/tclLoad.c32
-rw-r--r--generic/tclOO.c23
-rw-r--r--generic/tclOOInt.h15
-rw-r--r--generic/tclThreadAlloc.c8
-rw-r--r--generic/tclUtil.c11
-rw-r--r--generic/tclVar.c4
10 files changed, 45 insertions, 146 deletions
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 1283446..f33ad31 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1823,11 +1823,6 @@ NsEnsembleImplementationCmdNR(
* count both as inserted and removed arguments.
*/
-#if 0
- if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters, prefixObjc + ensemblePtr->numParameters, objv)) {
- TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
- }
-#else
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs =
@@ -1848,7 +1843,6 @@ NsEnsembleImplementationCmdNR(
iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
}
}
-#endif
/*
* Hand off to the target command.
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 90bf8d1..b6b89dd 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -2160,67 +2160,6 @@ DoGlob(
}
/*
- * This block of code is not exercised by the Tcl test suite as of Tcl
- * 8.5a0. Simplifications to the calling paths suggest it may not be
- * necessary any more, since path separators are handled elsewhere. It is
- * left in place in case new bugs are reported.
- */
-
-#if 0 /* PROBABLY_OBSOLETE */
- /*
- * Deal with path separators.
- */
-
- if (pathPtr == NULL) {
- /*
- * Length used to be the length of the prefix, and lastChar the
- * lastChar of the prefix. But, none of this is used any more.
- */
-
- int length = 0;
- char lastChar = 0;
-
- switch (tclPlatform) {
- case TCL_PLATFORM_WINDOWS:
- /*
- * If this is a drive relative path, add the colon and the
- * trailing slash if needed. Otherwise add the slash if this is
- * the first absolute element, or a later relative element. Add an
- * extra slash if this is a UNC path.
- */
-
- if (*name == ':') {
- Tcl_DStringAppend(&append, ":", 1);
- if (count > 1) {
- Tcl_DStringAppend(&append, "/", 1);
- }
- } else if ((*pattern != '\0') && (((length > 0)
- && (strchr(separators, lastChar) == NULL))
- || ((length == 0) && (count > 0)))) {
- Tcl_DStringAppend(&append, "/", 1);
- if ((length == 0) && (count > 1)) {
- Tcl_DStringAppend(&append, "/", 1);
- }
- }
-
- break;
- case TCL_PLATFORM_UNIX:
- /*
- * Add a separator if this is the first absolute element, or a
- * later relative element.
- */
-
- if ((*pattern != '\0') && (((length > 0)
- && (strchr(separators, lastChar) == NULL))
- || ((length == 0) && (count > 0)))) {
- Tcl_DStringAppend(&append, "/", 1);
- }
- break;
- }
- }
-#endif /* PROBABLY_OBSOLETE */
-
- /*
* Look for the first matching pair of braces or the first directory
* separator that is not inside a pair of braces.
*/
@@ -2278,8 +2217,8 @@ DoGlob(
if (openBrace != NULL) {
char *element;
-
Tcl_DString newName;
+
Tcl_DStringInit(&newName);
/*
@@ -2328,12 +2267,13 @@ DoGlob(
*/
if (*p != '\0') {
+ char savedChar = *p;
+
/*
* Note that we are modifying the string in place. This won't work if
* the string is a static.
*/
- char savedChar = *p;
*p = '\0';
firstSpecialChar = strpbrk(pattern, "*[]?\\");
*p = savedChar;
@@ -2398,6 +2338,7 @@ DoGlob(
const char *bytes;
int numBytes;
Tcl_Obj *fixme, *newObj;
+
Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
bytes = Tcl_GetStringFromObj(fixme, &numBytes);
newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
@@ -2418,6 +2359,9 @@ DoGlob(
*/
if (*p == '\0') {
+ int length;
+ Tcl_DString append;
+
/*
* This is the code path reached by a command like 'glob foo'.
*
@@ -2430,9 +2374,6 @@ DoGlob(
* approach).
*/
- int length;
- Tcl_DString append;
-
Tcl_DStringInit(&append);
Tcl_DStringAppend(&append, pattern, p-pattern);
@@ -2464,8 +2405,9 @@ DoGlob(
}
}
#if defined(__CYGWIN__) && !defined(__WIN32__)
- DLLIMPORT extern int cygwin_conv_to_posix_path(const char *, char *);
{
+ DLLIMPORT extern int cygwin_conv_to_posix_path(const char *,
+ char *);
char winbuf[MAXPATHLEN+1];
cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf);
diff --git a/generic/tclHash.c b/generic/tclHash.c
index c8dc939..90be511 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -46,7 +46,9 @@ static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
- * Prototypes for the one word hash key methods.
+ * Prototypes for the one word hash key methods. Not actually declared because
+ * this is a critical path that is implemented in the core hash table access
+ * function.
*/
#if 0
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 6921af4..7b7b647 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -177,6 +177,7 @@ TclCreateSocketAddress(
}
hints.ai_socktype = SOCK_STREAM;
+
#if 0
/*
* We found some problems when using AI_ADDRCONFIG, e.g. on systems that
@@ -184,15 +185,16 @@ TclCreateSocketAddress(
* localhost. See bugs 3385024, 3382419, 3382431. As the advantage of
* using AI_ADDRCONFIG in situations where it works, is probably low,
* we'll leave it out for now. After all, it is just an optimisation.
- */
-#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux)
- /*
+ *
* Missing on: OpenBSD, NetBSD.
* Causes failure when used on AIX 5.1 and HP-UX
*/
+
+#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux)
hints.ai_flags |= AI_ADDRCONFIG;
-#endif
-#endif
+#endif /* AI_ADDRCONFIG && !_AIX && !__hpux */
+#endif /* 0 */
+
if (willBind) {
hints.ai_flags |= AI_PASSIVE;
}
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 202e66a..008a99d 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -873,40 +873,10 @@ Tcl_UnloadObjCmd(
done:
Tcl_DStringFree(&pkgName);
Tcl_DStringFree(&tmp);
- if (!complain && code!=TCL_OK) {
+ if (!complain && (code != TCL_OK)) {
code = TCL_OK;
Tcl_ResetResult(interp);
}
- if (code == TCL_OK) {
-#if 0
- /*
- * Result of [unload] was not documented in TIP#100, so force to be
- * the empty string by commenting this out. DKF.
- */
-
- Tcl_Obj *resultObjPtr, *objPtr[2];
-
- /*
- * Our result is the two reference counts.
- */
-
- TclNewIntObj(objPtr[0], trustedRefCount);
- TclNewIntObj(objPtr[1], safeRefCount);
- if (objPtr[0] == NULL || objPtr[1] == NULL) {
- if (objPtr[0]) {
- Tcl_DecrRefCount(objPtr[0]);
- }
- if (objPtr[1]) {
- Tcl_DecrRefCount(objPtr[1]);
- }
- } else {
- TclNewListObj(resultObjPtr, 2, objPtr);
- if (resultObjPtr != NULL) {
- Tcl_SetObjResult(interp, resultObjPtr);
- }
- }
-#endif
- }
return code;
}
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 9dd8162..1d1276d 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1624,6 +1624,15 @@ Tcl_NewObjectInstance(
state = Tcl_SaveInterpState(interp, TCL_OK);
contextPtr->callPtr->flags |= CONSTRUCTOR;
contextPtr->skip = skip;
+
+ /*
+ * Adjust the ensmble tracking record if necessary. [Bug 3514761]
+ */
+
+ if (((Interp*) interp)->ensembleRewrite.sourceObjs) {
+ ((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1;
+ ((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1;
+ }
result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
objc, objv);
@@ -1742,6 +1751,15 @@ TclNRNewObjectInstance(
contextPtr->skip = skip;
/*
+ * Adjust the ensmble tracking record if necessary. [Bug 3514761]
+ */
+
+ if (((Interp *) interp)->ensembleRewrite.sourceObjs) {
+ ((Interp *) interp)->ensembleRewrite.numInsertedObjs += skip - 1;
+ ((Interp *) interp)->ensembleRewrite.numRemovedObjs += skip - 1;
+ }
+
+ /*
* Fire off the constructors non-recursively.
*/
@@ -2050,6 +2068,7 @@ Tcl_CopyObjectInstance(
}
}
+ TclResetRewriteEnsemble(interp, 1);
contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
if (contextPtr) {
args[0] = TclOOObjectName(interp, o2Ptr);
@@ -2064,6 +2083,10 @@ Tcl_CopyObjectInstance(
TclDecrRefCount(args[1]);
TclDecrRefCount(args[2]);
TclOODeleteContext(contextPtr);
+ if (result == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp,
+ "\n (while performing post-copy callback)");
+ }
if (result != TCL_OK) {
Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
return NULL;
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 2d6f324..7988452 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -381,21 +381,6 @@ typedef struct CallContext {
#define DESTRUCTOR 0x10 /* This is a destructor. */
/*
- * Assorted flags for call frames. Note that bits 1 and 2 are already taken by
- * Tcl itself.
- */
-
-#if 0
-#define FRAME_IS_METHOD 0x4 /* The frame is a method body, and the frame's
- * clientData field contains a CallContext
- * reference. */
-#define FRAME_IS_OO_DEFINE 0x8 /* The frame is part of the inside workings of
- * the [oo::define] command; the clientData
- * field contains an Object reference that has
- * been confirmed to refer to a class. */
-#endif
-
-/*
* Structure containing definition information about basic class methods.
*/
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index ad1d510..e4261d6 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -812,15 +812,7 @@ LockBucket(
Cache *cachePtr,
int bucket)
{
-#if 0
- if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) {
- Tcl_MutexLock(bucketInfo[bucket].lockPtr);
- cachePtr->buckets[bucket].numWaits++;
- sharedPtr->buckets[bucket].numWaits++;
- }
-#else
Tcl_MutexLock(bucketInfo[bucket].lockPtr);
-#endif
cachePtr->buckets[bucket].numLocks++;
sharedPtr->buckets[bucket].numLocks++;
}
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 6ce430b..a1c1996 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -4121,20 +4121,9 @@ TclReToGlob(
*exactPtr = (anchorLeft && anchorRight);
}
-#if 0
- fprintf(stderr, "INPUT RE '%.*s' OUTPUT GLOB '%s' anchor %d:%d \n",
- reStrLen, reStr,
- Tcl_DStringValue(dsPtr), anchorLeft, anchorRight);
- fflush(stderr);
-#endif
return TCL_OK;
invalidGlob:
-#if 0
- fprintf(stderr, "INPUT RE '%.*s' NO OUTPUT GLOB %s (%c)\n",
- reStrLen, reStr, msg, *p);
- fflush(stderr);
-#endif
if (interp != NULL) {
Tcl_AppendResult(interp, msg, NULL);
Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 4df5d43..1bf4abc 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -762,7 +762,7 @@ TclObjLookupVarEx(
}
donePart1:
-#if 0
+#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
if (varPtr == NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
part1 = TclGetString(part1Ptr);
@@ -1892,7 +1892,7 @@ TclPtrSetVar(
varPtr->value.objPtr = NULL;
}
if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
-#if 0
+#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
/*
* Can't happen now!
*/
generated by cgit v0.12 at 2024-11-19 16:00:00 (GMT)