summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2019-05-03 20:24:30 (GMT)
committerdgp <dgp@users.sourceforge.net>2019-05-03 20:24:30 (GMT)
commit50146fa5d80ed376146b7f9b2ad6012b04d9a760 (patch)
treeaf95e2db46d2e2a3d2263c773954e618f60ad451 /generic
parent065f14aeb7e6293763124f655ee7e8a5aa7fb925 (diff)
parenta35dd1803660e9f68391c597e20b3c0f72e320ad (diff)
downloadtcl-50146fa5d80ed376146b7f9b2ad6012b04d9a760.zip
tcl-50146fa5d80ed376146b7f9b2ad6012b04d9a760.tar.gz
tcl-50146fa5d80ed376146b7f9b2ad6012b04d9a760.tar.bz2
merge 8.7
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c174
-rw-r--r--generic/tclBinary.c5
-rw-r--r--generic/tclOO.c89
-rw-r--r--generic/tclOOCall.c17
-rw-r--r--generic/tclOODefineCmds.c76
-rw-r--r--generic/tclTest.c6
-rw-r--r--generic/tclTimer.c26
7 files changed, 257 insertions, 136 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index fac4d3c..ac32293 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -157,6 +157,7 @@ static Tcl_NRPostProc Dispatch;
static Tcl_ObjCmdProc NRCoroInjectObjCmd;
static Tcl_NRPostProc NRPostInvoke;
+static Tcl_ObjCmdProc CoroTypeObjCmd;
MODULE_SCOPE const TclStubs tclStubs;
@@ -937,8 +938,11 @@ Tcl_CreateInterp(void)
TclNRAssembleObjCmd, NULL, NULL);
cmdPtr->compileProc = &TclCompileAssembleCmd;
+ /* Coroutine monkeybusiness */
Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
NRCoroInjectObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype",
+ CoroTypeObjCmd, NULL, NULL);
/* Export unsupported commands */
nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0);
@@ -2329,14 +2333,16 @@ Tcl_CreateCommand(
break;
}
- /* An existing command conflicts. Try to delete it.. */
+ /*
+ * An existing command conflicts. Try to delete it...
+ */
+
cmdPtr = Tcl_GetHashValue(hPtr);
/*
- * Be careful to preserve
- * any existing import links so we can restore them down below. That
- * way, you can redefine a command and its import status will remain
- * intact.
+ * Be careful to preserve any existing import links so we can restore
+ * them down below. That way, you can redefine a command and its
+ * import status will remain intact.
*/
cmdPtr->refCount++;
@@ -2356,16 +2362,15 @@ Tcl_CreateCommand(
if (!isNew) {
/*
- * If the deletion callback recreated the command, just throw away
- * the new command (if we try to delete it again, we could get
- * stuck in an infinite loop).
+ * If the deletion callback recreated the command, just throw away the
+ * new command (if we try to delete it again, we could get stuck in an
+ * infinite loop).
*/
Tcl_Free(Tcl_GetHashValue(hPtr));
}
if (!deleted) {
-
/*
* Command resolvers (per-interp, per-namespace) might have resolved
* to a command for the given namespace scope with this command not
@@ -2547,7 +2552,7 @@ TclCreateObjCommandInNs(
}
/*
- * An existing command conflicts. Try to delete it.
+ * An existing command conflicts. Try to delete it...
*/
cmdPtr = Tcl_GetHashValue(hPtr);
@@ -4172,15 +4177,22 @@ EvalObjvCore(
reresolve:
assert(cmdPtr == NULL);
if (preCmdPtr) {
- /* Caller gave it to us */
+ /*
+ * Caller gave it to us.
+ */
+
if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
- /* So long as it exists, use it. */
+ /*
+ * So long as it exists, use it.
+ */
+
cmdPtr = preCmdPtr;
} else if (flags & TCL_EVAL_NORESOLVE) {
/*
- * When it's been deleted, and we're told not to attempt
- * resolving it ourselves, all we can do is raise an error.
+ * When it's been deleted, and we're told not to attempt resolving
+ * it ourselves, all we can do is raise an error.
*/
+
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"attempt to invoke a deleted command"));
Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
@@ -4196,14 +4208,12 @@ EvalObjvCore(
if (enterTracesDone || iPtr->tracePtr
|| (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
-
Tcl_Obj *commandPtr = TclGetSourceFromFrame(
flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL,
objc, objv);
- Tcl_IncrRefCount(commandPtr);
+ Tcl_IncrRefCount(commandPtr);
if (!enterTracesDone) {
-
int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
objc, objv);
@@ -4211,10 +4221,10 @@ EvalObjvCore(
* Send any exception from enter traces back as an exception
* raised by the traced command.
* TODO: Is this a bug? Letting an execution trace BREAK or
- * CONTINUE or RETURN in the place of the traced command?
- * Would either converting all exceptions to TCL_ERROR, or
- * just swallowing them be better? (Swallowing them has the
- * problem of permanently hiding program errors.)
+ * CONTINUE or RETURN in the place of the traced command? Would
+ * either converting all exceptions to TCL_ERROR, or just
+ * swallowing them be better? (Swallowing them has the problem of
+ * permanently hiding program errors.)
*/
if (code != TCL_OK) {
@@ -4223,9 +4233,8 @@ EvalObjvCore(
}
/*
- * If the enter traces made the resolved cmdPtr unusable, go
- * back and resolve again, but next time don't run enter
- * traces again.
+ * If the enter traces made the resolved cmdPtr unusable, go back
+ * and resolve again, but next time don't run enter traces again.
*/
if (cmdPtr == NULL) {
@@ -4236,9 +4245,9 @@ EvalObjvCore(
}
/*
- * Schedule leave traces. Raise the refCount on the resolved
- * cmdPtr, so that when it passes to the leave traces we know
- * it's still valid.
+ * Schedule leave traces. Raise the refCount on the resolved cmdPtr,
+ * so that when it passes to the leave traces we know it's still
+ * valid.
*/
cmdPtr->refCount++;
@@ -4305,12 +4314,10 @@ TclNRRunCallbacks(
/* All callbacks down to rootPtr not inclusive
* are to be run. */
{
- NRE_callback *callbackPtr;
- Tcl_NRPostProc *procPtr;
-
while (TOP_CB(interp) != rootPtr) {
- callbackPtr = TOP_CB(interp);
- procPtr = callbackPtr->procPtr;
+ NRE_callback *callbackPtr = TOP_CB(interp);
+ Tcl_NRPostProc *procPtr = callbackPtr->procPtr;
+
TOP_CB(interp) = callbackPtr->nextPtr;
result = procPtr(callbackPtr->data, interp, result);
TCLNR_FREE(interp, callbackPtr);
@@ -6378,14 +6385,17 @@ TclNRInvoke(
}
cmdPtr = Tcl_GetHashValue(hPtr);
- /* Avoid the exception-handling brain damage when numLevels == 0 . */
+ /*
+ * Avoid the exception-handling brain damage when numLevels == 0
+ */
+
iPtr->numLevels++;
Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);
/*
* Normal command resolution of objv[0] isn't going to find cmdPtr.
- * That's the whole point of **hidden** commands. So tell the
- * Eval core machinery not to even try (and risk finding something wrong).
+ * That's the whole point of **hidden** commands. So tell the Eval core
+ * machinery not to even try (and risk finding something wrong).
*/
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
@@ -7626,13 +7636,21 @@ TclDTraceInfo(
Tcl_DictObjGet(NULL, info, *k++, &val);
args[i] = val ? TclGetString(val) : NULL;
}
- /* no "proc" -> use "lambda" */
+
+ /*
+ * no "proc" -> use "lambda"
+ */
+
if (!args[2]) {
Tcl_DictObjGet(NULL, info, *k, &val);
args[2] = val ? TclGetString(val) : NULL;
}
k++;
- /* no "class" -> use "object" */
+
+ /*
+ * no "class" -> use "object"
+ */
+
if (!args[5]) {
Tcl_DictObjGet(NULL, info, *k, &val);
args[5] = val ? TclGetString(val) : NULL;
@@ -7986,8 +8004,10 @@ TclNRTailcallObjCmd(
Tcl_Obj *listPtr, *nsObjPtr;
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
- /* The tailcall data is in a Tcl list: the first element is the
- * namespace, the rest the command to be tailcalled. */
+ /*
+ * The tailcall data is in a Tcl list: the first element is the
+ * namespace, the rest the command to be tailcalled.
+ */
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
listPtr = Tcl_NewListObj(objc, objv);
@@ -8438,6 +8458,75 @@ TclNREvalList(
/*
*----------------------------------------------------------------------
*
+ * CoroTypeObjCmd --
+ *
+ * Implementation of [::tcl::unsupported::corotype] command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CoroTypeObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Command *cmdPtr;
+ CoroutineData *corPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "coroName");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the coroutine.
+ */
+
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
+ if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can only get coroutine type of a coroutine", -1));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
+ TclGetString(objv[1]), NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * An active coroutine is "active". Can't tell what it might do in the
+ * future.
+ */
+
+ corPtr = cmdPtr->objClientData;
+ if (!COR_IS_SUSPENDED(corPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1));
+ return TCL_OK;
+ }
+
+ /*
+ * Inactive coroutines are classified by the (effective) command used to
+ * suspend them, which matters when you're injecting a probe.
+ */
+
+ switch (corPtr->nargs) {
+ case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1));
+ return TCL_OK;
+ case COROUTINE_ARGUMENTS_ARBITRARY:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1));
+ return TCL_OK;
+ default:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unknown coroutine type", -1));
+ Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* NRCoroInjectObjCmd --
*
* Implementation of [::tcl::unsupported::inject] command.
@@ -8668,9 +8757,12 @@ TclNRCoroutineObjCmd(
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
- /* ensure that the command is looked up in the correct namespace */
+ /*
+ * Ensure that the command is looked up in the correct namespace.
+ */
+
iPtr->lookupNsPtr = lookupNsPtr;
- Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
+ Tcl_NREvalObj(interp, Tcl_NewListObj(objc - 2, objv + 2), 0);
iPtr->numLevels--;
SAVE_CONTEXT(corPtr->running);
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 99827c8..91313e2 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -758,7 +758,10 @@ TclAppendBytesToByteArray(
"TclAppendBytesToByteArray");
}
if (len == 0) {
- /* Append zero bytes is a no-op. */
+ /*
+ * Append zero bytes is a no-op.
+ */
+
return;
}
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 360c7dd..a6a7060 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -346,14 +346,14 @@ InitFoundation(
*/
Tcl_DStringInit(&buffer);
- for (i=0 ; defineCmds[i].name ; i++) {
+ for (i = 0 ; defineCmds[i].name ; i++) {
TclDStringAppendLiteral(&buffer, "::oo::define::");
Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
Tcl_DStringFree(&buffer);
}
- for (i=0 ; objdefCmds[i].name ; i++) {
+ for (i = 0 ; objdefCmds[i].name ; i++) {
TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
@@ -373,10 +373,10 @@ InitFoundation(
* Basic method declarations for the core classes.
*/
- for (i=0 ; objMethods[i].name ; i++) {
+ for (i = 0 ; objMethods[i].name ; i++) {
TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
}
- for (i=0 ; clsMethods[i].name ; i++) {
+ for (i = 0 ; clsMethods[i].name ; i++) {
TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
}
@@ -388,7 +388,7 @@ InitFoundation(
TclNewLiteralStringObj(namePtr, "new");
Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
- namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
+ namePtr /* keeps ref */, 0 /* private */, NULL, NULL);
fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
(Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);
@@ -667,10 +667,8 @@ AllocObject(
Tcl_ResetResult(interp);
}
-
configNamespace:
-
- ((Namespace *)oPtr->namespacePtr)->refCount++;
+ ((Namespace *) oPtr->namespacePtr)->refCount++;
/*
* Make the namespace know about the helper commands. This grants access
@@ -874,10 +872,14 @@ TclOODeleteDescendants(
if (clsPtr->mixinSubs.num > 0) {
while (clsPtr->mixinSubs.num > 0) {
- mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1];
- /* This condition also covers the case where mixinSubclassPtr ==
+ mixinSubclassPtr =
+ clsPtr->mixinSubs.list[clsPtr->mixinSubs.num - 1];
+
+ /*
+ * This condition also covers the case where mixinSubclassPtr ==
* clsPtr
*/
+
if (!Deleted(mixinSubclassPtr->thisPtr)
&& !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp,
@@ -897,7 +899,7 @@ TclOODeleteDescendants(
if (clsPtr->subclasses.num > 0) {
while (clsPtr->subclasses.num > 0) {
- subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
+ subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1];
if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
&& !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp,
@@ -918,7 +920,8 @@ TclOODeleteDescendants(
if (clsPtr->instances.num > 0) {
while (clsPtr->instances.num > 0) {
- instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
+ instancePtr = clsPtr->instances.list[clsPtr->instances.num - 1];
+
/*
* This condition also covers the case where instancePtr == oPtr
*/
@@ -1119,8 +1122,8 @@ ObjectNamespaceDeleted(
if (Deleted(oPtr)) {
/*
- * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, this
- * guard could be removed.
+ * TODO: Can ObjectNamespaceDeleted ever be called twice? If not,
+ * this guard could be removed.
*/
return;
@@ -1134,7 +1137,10 @@ ObjectNamespaceDeleted(
oPtr->flags |= OBJECT_DELETED;
- /* Let the dominoes fall */
+ /*
+ * Let the dominoes fall!
+ */
+
if (oPtr->classPtr) {
TclOODeleteDescendants(interp, oPtr);
}
@@ -1150,8 +1156,8 @@ ObjectNamespaceDeleted(
CallContext *contextPtr =
TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
int result;
-
Tcl_InterpState state;
+
oPtr->flags |= DESTRUCTOR_CALLED;
if (contextPtr != NULL) {
@@ -1170,12 +1176,12 @@ ObjectNamespaceDeleted(
/*
* Instruct everyone to no longer use any allocated fields of the object.
- * Also delete the command that refers to the object at this point (if
- * it still exists) because otherwise its pointer to the object
- * points into freed memory.
+ * Also delete the command that refers to the object at this point (if it
+ * still exists) because otherwise its pointer to the object points into
+ * freed memory.
*/
- if (((Command *)oPtr->command)->flags && CMD_IS_DELETED) {
+ if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) {
/*
* Something has already started the command deletion process. We can
* go ahead and clean up the the namespace,
@@ -1201,10 +1207,7 @@ ObjectNamespaceDeleted(
* methods on the object.
*/
- /*
- * TODO: Should this be protected with a * !IsRoot() condition?
- */
-
+ /* TODO: Should this be protected with a !IsRoot() condition? */
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
if (oPtr->mixins.num > 0) {
@@ -1765,7 +1768,6 @@ TclNRNewObjectInstance(
TclPushTailcallPoint(interp);
return TclOOInvokeContext(contextPtr, interp, objc, objv);
}
-
Object *
TclNewObjectInstanceCommon(
@@ -1780,7 +1782,6 @@ TclNewObjectInstanceCommon(
const char *simpleName = NULL;
Namespace *nsPtr = NULL, *dummy;
Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
- int isNew;
if (nameStr) {
TclGetNamespaceForQualName(interp, nameStr, inNsPtr,
@@ -1790,21 +1791,14 @@ TclNewObjectInstanceCommon(
* Disallow creation of an object over an existing command.
*/
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, simpleName, &isNew);
- if (!isNew) {
+ hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simpleName);
+ if (hPtr) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create object \"%s\": command already exists with"
" that name", nameStr));
Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
return NULL;
}
-
- /*
- * We could make a hash entry! Don't actually want to do that here so
- * nuke it immediately because we'll create it properly soon.
- */
-
- Tcl_DeleteHashEntry(hPtr);
}
/*
@@ -1837,8 +1831,6 @@ TclNewObjectInstanceCommon(
return oPtr;
}
-
-
static int
FinalizeAlloc(
ClientData data[],
@@ -1974,7 +1966,11 @@ Tcl_CopyObjectInstance(
if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
TclOOAddToInstances(o2Ptr, mixinPtr);
}
- /* For the reference just created in DUPLICATE */
+
+ /*
+ * For the reference just created in DUPLICATE.
+ */
+
AddRef(mixinPtr->thisPtr);
}
@@ -2012,6 +2008,7 @@ Tcl_CopyObjectInstance(
o2Ptr->flags = oPtr->flags & ~(
OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
+
/*
* Copy the object's metadata.
*/
@@ -2075,9 +2072,11 @@ Tcl_CopyObjectInstance(
FOREACH(superPtr, cls2Ptr->superclasses) {
TclOOAddToSubclasses(cls2Ptr, superPtr);
- /* For the new item in cls2Ptr->superclasses that memcpy just
- * created
+ /*
+ * For the new item in cls2Ptr->superclasses that memcpy just
+ * created.
*/
+
AddRef(superPtr->thisPtr);
}
@@ -2121,7 +2120,11 @@ Tcl_CopyObjectInstance(
DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
FOREACH(mixinPtr, cls2Ptr->mixins) {
TclOOAddToMixinSubs(cls2Ptr, mixinPtr);
- /* For the copy just created in DUPLICATE */
+
+ /*
+ * For the copy just created in DUPLICATE.
+ */
+
AddRef(mixinPtr->thisPtr);
}
@@ -2783,7 +2786,7 @@ Tcl_ObjectContextInvokeNext(
int savedSkip = contextPtr->skip;
int result;
- if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
+ if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
/*
* We're at the end of the chain; generate an error message unless the
* interpreter is being torn down, in which case we might be getting
@@ -2852,7 +2855,7 @@ TclNRObjectContextInvokeNext(
{
register CallContext *contextPtr = (CallContext *) context;
- if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
+ if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
/*
* We're at the end of the chain; generate an error message unless the
* interpreter is being torn down, in which case we might be getting
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 11c6e19..df0f435 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -328,7 +328,7 @@ TclOOInvokeContext(
if (contextPtr->index == 0) {
int i;
- for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
+ for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
AddRef(contextPtr->callPtr->chain[i].mPtr);
}
@@ -406,7 +406,7 @@ FinalizeMethodRefs(
CallContext *contextPtr = data[0];
int i;
- for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
+ for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
}
return result;
@@ -641,7 +641,10 @@ SortMethodNames(
return i;
}
-/* Comparator for SortMethodNames */
+/*
+ * Comparator for SortMethodNames
+ */
+
static int
CmpStr(
const void *ptr1,
@@ -1004,7 +1007,7 @@ AddMethodToCallChain(
* any leading filters.
*/
- for (i=cbPtr->filterLength ; i<callPtr->numChain ; i++) {
+ for (i = cbPtr->filterLength ; i < callPtr->numChain ; i++) {
if (callPtr->chain[i].mPtr == mPtr &&
callPtr->chain[i].isFilter == (doneFilters != NULL)) {
/*
@@ -1016,8 +1019,8 @@ AddMethodToCallChain(
Class *declCls = callPtr->chain[i].filterDeclarer;
- for (; i+1<callPtr->numChain ; i++) {
- callPtr->chain[i] = callPtr->chain[i+1];
+ for (; i + 1 < callPtr->numChain ; i++) {
+ callPtr->chain[i] = callPtr->chain[i + 1];
}
callPtr->chain[i].mPtr = mPtr;
callPtr->chain[i].isFilter = (doneFilters != NULL);
@@ -1817,7 +1820,7 @@ TclOORenderCallChain(
*/
objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
- for (i=0 ; i<callPtr->numChain ; i++) {
+ for (i = 0 ; i < callPtr->numChain ; i++) {
struct MInvoke *miPtr = &callPtr->chain[i];
descObjs[0] =
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 6685f08..f745ff0 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -50,6 +50,12 @@ struct DeclaredSlot {
resolver, NULL, NULL}}
/*
+ * A [string match] pattern used to determine if a method should be exported.
+ */
+
+#define PUBLIC_PATTERN "[a-z]*"
+
+/*
* Forward declarations.
*/
@@ -278,7 +284,7 @@ TclOOObjectSetFilters(
} else {
filtersList = Tcl_Realloc(oPtr->filters.list, size);
}
- for (i=0 ; i<numFilters ; i++) {
+ for (i = 0 ; i < numFilters ; i++) {
filtersList[i] = filters[i];
Tcl_IncrRefCount(filters[i]);
}
@@ -337,7 +343,7 @@ TclOOClassSetFilters(
} else {
filtersList = Tcl_Realloc(classPtr->filters.list, size);
}
- for (i=0 ; i<numFilters ; i++) {
+ for (i = 0 ; i < numFilters ; i++) {
filtersList[i] = filters[i];
Tcl_IncrRefCount(filters[i]);
}
@@ -400,7 +406,11 @@ TclOOObjectSetMixins(
FOREACH(mixinPtr, oPtr->mixins) {
if (mixinPtr != oPtr->selfCls) {
TclOOAddToInstances(oPtr, mixinPtr);
- /* For the new copy created by memcpy */
+
+ /*
+ * For the new copy created by memcpy().
+ */
+
AddRef(mixinPtr->thisPtr);
}
}
@@ -452,7 +462,11 @@ TclOOClassSetMixins(
memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
FOREACH(mixinPtr, classPtr->mixins) {
TclOOAddToMixinSubs(classPtr, mixinPtr);
- /* For the new copy created by memcpy */
+
+ /*
+ * For the new copy created by memcpy.
+ */
+
AddRef(mixinPtr->thisPtr);
}
}
@@ -724,15 +738,16 @@ TclOOUnknownDefinition(
* Got one match, and only one match!
*/
- Tcl_Obj **newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj*)*(objc-1));
+ Tcl_Obj **newObjv =
+ TclStackAlloc(interp, sizeof(Tcl_Obj*) * (objc - 1));
int result;
newObjv[0] = Tcl_NewStringObj(matchedStr, -1);
Tcl_IncrRefCount(newObjv[0]);
if (objc > 2) {
- memcpy(newObjv+1, objv+2, sizeof(Tcl_Obj *) * (objc-2));
+ memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2));
}
- result = Tcl_EvalObjv(interp, objc-1, newObjv, 0);
+ result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0);
Tcl_DecrRefCount(newObjv[0]);
TclStackFree(interp, newObjv);
return result;
@@ -1039,17 +1054,20 @@ MagicDefinitionInvoke(
obj2Ptr = Tcl_NewObj();
cmd = FindCommand(interp, objv[cmdIndex], nsPtr);
if (cmd == NULL) {
- /* punt this case! */
+ /*
+ * Punt this case!
+ */
+
Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]);
} else {
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
}
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
/* TODO: overflow? */
- Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-offset, objv+offset);
+ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset);
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
- result = Tcl_EvalObjv(interp, objc-cmdIndex, objs, TCL_EVAL_INVOKE);
+ result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE);
if (isRoot) {
TclResetRewriteEnsemble(interp, 1);
}
@@ -1685,7 +1703,7 @@ TclOODefineDeleteMethodObjCmd(
return TCL_ERROR;
}
- for (i=1 ; i<objc ; i++) {
+ for (i = 1; i < objc; i++) {
/*
* Delete the method structure from the appropriate hash table.
*/
@@ -1811,7 +1829,7 @@ TclOODefineExportObjCmd(
return TCL_ERROR;
}
- for (i=1 ; i<objc ; i++) {
+ for (i = 1; i < objc; i++) {
/*
* Exporting is done by adding the PUBLIC_METHOD flag to the method
* record. If there is no such method in this object or class (i.e.
@@ -1904,7 +1922,7 @@ TclOODefineForwardObjCmd(
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
- isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
+ isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN)
? PUBLIC_METHOD : 0;
if (IsPrivateDefine(interp)) {
isPublic = TRUE_PRIVATE_METHOD;
@@ -1914,7 +1932,7 @@ TclOODefineForwardObjCmd(
* Create the method structure.
*/
- prefixObj = Tcl_NewListObj(objc-2, objv+2);
+ prefixObj = Tcl_NewListObj(objc - 2, objv + 2);
if (isInstanceForward) {
mPtr = TclOONewForwardInstanceMethod(interp, oPtr, isPublic, objv[1],
prefixObj);
@@ -2002,7 +2020,7 @@ TclOODefineMethodObjCmd(
if (IsPrivateDefine(interp)) {
isPublic = TRUE_PRIVATE_METHOD;
} else {
- isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
+ isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN)
? PUBLIC_METHOD : 0;
}
}
@@ -2124,7 +2142,7 @@ TclOODefineUnexportObjCmd(
return TCL_ERROR;
}
- for (i=1 ; i<objc ; i++) {
+ for (i = 1; i < objc; i++) {
/*
* Unexporting is done by removing the PUBLIC_METHOD flag from the
* method record. If there is no such method in this object or class
@@ -2340,7 +2358,7 @@ ClassFilterSet(
int filterc;
Tcl_Obj **filterv;
- if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"filterList");
return TCL_ERROR;
@@ -2424,7 +2442,7 @@ ClassMixinSet(
Tcl_Obj **mixinv;
Class **mixins;
- if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"mixinList");
return TCL_ERROR;
@@ -2445,7 +2463,7 @@ ClassMixinSet(
mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);
- for (i=0 ; i<mixinc ; i++) {
+ for (i = 0; i < mixinc; i++) {
mixins[i] = GetClassInOuterContext(interp, mixinv[i],
"may only mix in classes");
if (mixins[i] == NULL) {
@@ -2529,7 +2547,7 @@ ClassSuperSet(
Tcl_Obj **superv;
Class **superclasses, *superPtr;
- if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"superclassList");
return TCL_ERROR;
@@ -2576,14 +2594,14 @@ ClassSuperSet(
superc = 1;
AddRef(superclasses[0]->thisPtr);
} else {
- for (i=0 ; i<superc ; i++) {
+ for (i = 0; i < superc; i++) {
superclasses[i] = GetClassInOuterContext(interp, superv[i],
"only a class can be a superclass");
if (superclasses[i] == NULL) {
i--;
goto failedAfterAlloc;
}
- for (j=0 ; j<i ; j++) {
+ for (j = 0; j < i; j++) {
if (superclasses[j] == superclasses[i]) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"class should only be a direct superclass once",
@@ -2705,7 +2723,7 @@ ClassVarsSet(
Tcl_Obj **varv;
int i;
- if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"filterList");
return TCL_ERROR;
@@ -2724,7 +2742,7 @@ ClassVarsSet(
return TCL_ERROR;
}
- for (i=0 ; i<varc ; i++) {
+ for (i = 0; i < varc; i++) {
const char *varName = TclGetString(varv[i]);
if (strstr(varName, "::") != NULL) {
@@ -2803,7 +2821,7 @@ ObjFilterSet(
int filterc;
Tcl_Obj **filterv;
- if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"filterList");
return TCL_ERROR;
@@ -2877,7 +2895,7 @@ ObjMixinSet(
Class **mixins;
int i;
- if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"mixinList");
return TCL_ERROR;
@@ -2892,7 +2910,7 @@ ObjMixinSet(
mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);
- for (i=0 ; i<mixinc ; i++) {
+ for (i = 0; i < mixinc; i++) {
mixins[i] = GetClassInOuterContext(interp, mixinv[i],
"may only mix in classes");
if (mixins[i] == NULL) {
@@ -2967,7 +2985,7 @@ ObjVarsSet(
int varc, i;
Tcl_Obj **varv;
- if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"variableList");
return TCL_ERROR;
@@ -2980,7 +2998,7 @@ ObjVarsSet(
return TCL_ERROR;
}
- for (i=0 ; i<varc ; i++) {
+ for (i = 0; i < varc; i++) {
const char *varName = TclGetString(varv[i]);
if (strstr(varName, "::") != NULL) {
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 3119fcb..147fc96 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -972,8 +972,10 @@ AsyncHandlerProc(
Tcl_MutexLock(&asyncTestMutex);
for (asyncPtr = firstHandler; asyncPtr != NULL;
- asyncPtr = asyncPtr->nextPtr) {
- if (asyncPtr->id == id) break;
+ asyncPtr = asyncPtr->nextPtr) {
+ if (asyncPtr->id == id) {
+ break;
+ }
}
Tcl_MutexUnlock(&asyncTestMutex);
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 0833722..c89318f 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -310,8 +310,8 @@ TclCreateAbsoluteTimerHandler(
timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);
/*
- * Add the event to the queue in the correct position
- * (ordered by event firing time).
+ * Add the event to the queue in the correct position (ordered by event
+ * firing time).
*/
for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
@@ -1013,8 +1013,8 @@ AfterDelay(
Tcl_GetTime(&now);
endTime = now;
- endTime.sec += (long)(ms/1000);
- endTime.usec += ((int)(ms%1000))*1000;
+ endTime.sec += (long)(ms / 1000);
+ endTime.usec += ((int)(ms % 1000)) * 1000;
if (endTime.usec >= 1000000) {
endTime.sec++;
endTime.usec -= 1000000;
@@ -1042,17 +1042,17 @@ AfterDelay(
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
- if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
- diff = 1;
- }
+ if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
+ diff = 1;
+ }
if (diff > 0) {
- Tcl_Sleep((int) diff);
- if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
- break;
- }
+ Tcl_Sleep((long) diff);
+ if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
+ break;
+ }
} else {
- break;
- }
+ break;
+ }
} else {
diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
if (diff > TCL_TIME_MAXIMUM_SLICE) {