summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBasic.c119
-rw-r--r--generic/tclBinary.c5
-rw-r--r--generic/tclOO.c167
-rw-r--r--generic/tclOOCall.c33
-rw-r--r--generic/tclOODefineCmds.c98
-rw-r--r--generic/tclTest.c6
-rw-r--r--generic/tclTimer.c20
-rwxr-xr-xwin/tclWinFile.c309
-rw-r--r--win/tclWinPipe.c459
9 files changed, 788 insertions, 428 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5480835..d252f00 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2109,14 +2109,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++;
@@ -2136,16 +2138,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).
*/
ckfree(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
@@ -2324,16 +2325,18 @@ TclCreateObjCommandInNs (
break;
}
+ /*
+ * An existing command conflicts. Try to delete it...
+ */
- /* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
/*
* [***] This is wrong. See Tcl Bug a16752c252.
- * However, this buggy behavior is kept under particular
- * circumstances to accommodate deployed binaries of the
- * "tclcompiler" program. http://sourceforge.net/projects/tclpro/
- * that crash if the bug is fixed.
+ * However, this buggy behavior is kept under particular circumstances
+ * to accommodate deployed binaries of the "tclcompiler" program
+ * <http://sourceforge.net/projects/tclpro/> that crash if the bug is
+ * fixed.
*/
if (cmdPtr->objProc == TclInvokeStringCommand
@@ -2357,7 +2360,10 @@ TclCreateObjCommandInNs (
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
}
- /* Make sure namespace doesn't get deallocated. */
+ /*
+ * Make sure namespace doesn't get deallocated.
+ */
+
cmdPtr->nsPtr->refCount++;
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
@@ -4315,15 +4321,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);
@@ -4339,14 +4352,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);
@@ -4354,10 +4365,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) {
@@ -4366,9 +4377,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) {
@@ -4379,9 +4389,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++;
@@ -4449,8 +4459,6 @@ TclNRRunCallbacks(
* are to be run. */
{
Interp *iPtr = (Interp *) interp;
- NRE_callback *callbackPtr;
- Tcl_NRPostProc *procPtr;
/*
* If the interpreter has a non-empty string result, the result object is
@@ -4466,11 +4474,14 @@ TclNRRunCallbacks(
(void) Tcl_GetObjResult(interp);
}
- /* This is the trampoline. */
+ /*
+ * This is the trampoline.
+ */
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);
@@ -6676,14 +6687,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);
@@ -8065,13 +8079,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;
@@ -8424,8 +8446,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);
@@ -9108,9 +9132,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 d810e84..0ef4bda 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -639,7 +639,10 @@ TclAppendBytesToByteArray(
"TclAppendBytesToByteArray");
}
if (len == 0) {
- /* Append zero bytes is a no-op. */
+ /*
+ * Append zero bytes is a no-op.
+ */
+
return;
}
if (objPtr->typePtr != &tclByteArrayType) {
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 39d3806..1c2277e 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -365,14 +365,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),
@@ -387,30 +387,50 @@ InitFoundation(
* spliced manually.
*/
- /* Stand up a phony class for bootstrapping. */
+ /*
+ * Stand up a phony class for bootstrapping.
+ */
+
fPtr->objectCls = &fakeCls;
- /* referenced in TclOOAllocClass to increment the refCount. */
+
+ /*
+ * Referenced in TclOOAllocClass to increment the refCount.
+ */
+
fakeCls.thisPtr = &fakeObject;
fPtr->objectCls = TclOOAllocClass(interp,
AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
- /* Corresponding TclOODecrRefCount in KillFoudation */
+ /*
+ * Corresponding TclOODecrRefCount in KillFoudation.
+ */
+
AddRef(fPtr->objectCls->thisPtr);
- /* This is why it is unnecessary in this routine to replace the
+ /*
+ * This is why it is unnecessary in this routine to replace the
* incremented reference count of fPtr->objectCls that was swallowed by
- * fakeObject. */
+ * fakeObject.
+ */
+
fPtr->objectCls->superclasses.num = 0;
ckfree(fPtr->objectCls->superclasses.list);
fPtr->objectCls->superclasses.list = NULL;
- /* special initialization for the primordial objects */
+ /*
+ * Special initialization for the primordial objects.
+ */
+
fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
fPtr->objectCls->flags |= ROOT_OBJECT;
fPtr->classCls = TclOOAllocClass(interp,
AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
- /* Corresponding TclOODecrRefCount in KillFoudation */
+
+ /*
+ * Corresponding TclOODecrRefCount in KillFoudation.
+ */
+
AddRef(fPtr->classCls->thisPtr);
/*
@@ -421,7 +441,10 @@ InitFoundation(
* KillFoundation.
*/
- /* Rewire bootstrapped objects. */
+ /*
+ * Rewire bootstrapped objects.
+ */
+
fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
AddRef(fPtr->classCls->thisPtr);
TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
@@ -433,17 +456,20 @@ InitFoundation(
fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
fPtr->classCls->flags |= ROOT_CLASS;
- /* Standard initialization for new Objects */
+ /*
+ * Standard initialization for new Objects.
+ */
+
TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
/*
* 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]);
}
@@ -467,7 +493,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);
@@ -651,10 +677,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
@@ -692,7 +716,7 @@ AllocObject(
/*
* An object starts life with a refCount of 2 to mark the two stages of
* destruction it occur: A call to ObjectRenamedTrace(), and a call to
- * ObjectNamespaceDeleted().
+ * ObjectNamespaceDeleted().
*/
oPtr->refCount = 2;
@@ -847,10 +871,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,
@@ -869,7 +897,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,
@@ -890,8 +918,12 @@ TclOODeleteDescendants(
if (clsPtr->instances.num > 0) {
while (clsPtr->instances.num > 0) {
- instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
- /* This condition also covers the case where instancePtr == oPtr */
+ instancePtr = clsPtr->instances.list[clsPtr->instances.num - 1];
+
+ /*
+ * This condition also covers the case where instancePtr == oPtr
+ */
+
if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
!(instancePtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp, instancePtr->command);
@@ -905,7 +937,6 @@ TclOODeleteDescendants(
clsPtr->instances.size = 0;
}
}
-
/*
* ----------------------------------------------------------------------
@@ -924,7 +955,7 @@ TclOOReleaseClassContents(
Object *oPtr) /* The object representing the class. */
{
FOREACH_HASH_DECLS;
- int i;
+ int i;
Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
Method *mPtr;
Foundation *fPtr = oPtr->fPtr;
@@ -1065,7 +1096,8 @@ ObjectNamespaceDeleted(
int i;
if (Deleted(oPtr)) {
- /* To do: Can ObjectNamespaceDeleted ever be called twice? If not,
+ /*
+ * TODO: Can ObjectNamespaceDeleted ever be called twice? If not,
* this guard could be removed.
*/
return;
@@ -1078,7 +1110,10 @@ ObjectNamespaceDeleted(
*/
oPtr->flags |= OBJECT_DELETED;
- /* Let the dominoes fall */
+ /*
+ * Let the dominoes fall!
+ */
+
if (oPtr->classPtr) {
TclOODeleteDescendants(interp, oPtr);
}
@@ -1089,12 +1124,13 @@ ObjectNamespaceDeleted(
* in that case when the destructor is partially deleted before the uses
* of it have gone. [Bug 2949397]
*/
+
if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
CallContext *contextPtr =
TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
int result;
-
Tcl_InterpState state;
+
oPtr->flags |= DESTRUCTOR_CALLED;
if (contextPtr != NULL) {
@@ -1113,12 +1149,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,
@@ -1128,6 +1164,7 @@ ObjectNamespaceDeleted(
* The namespace must have been deleted directly. Delete the command
* as well.
*/
+
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
}
@@ -1140,7 +1177,7 @@ ObjectNamespaceDeleted(
* methods on the object.
*/
- /* To do: 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) {
@@ -1196,7 +1233,7 @@ ObjectNamespaceDeleted(
/*
* Because an object can be a class that is an instance of itself, the
* class object's class structure should only be cleaned after most of
- * the cleanup on the object is done.
+ * the cleanup on the object is done.
*
* The class of objects needs some special care; if it is deleted (and
* we're not killing the whole interpreter) we force the delete of the
@@ -1249,10 +1286,13 @@ int TclOODecrRefCount(Object *oPtr) {
return 0;
}
-/* setting the "empty" location to NULL makes debugging a little easier */
-#define REMOVEBODY { \
+/*
+ * Setting the "empty" location to NULL makes debugging a little easier.
+ */
+
+#define REMOVEBODY { \
for (; idx < num - 1; idx++) { \
- list[idx] = list[idx+1]; \
+ list[idx] = list[idx + 1]; \
} \
list[idx] = NULL; \
return; \
@@ -1690,7 +1730,6 @@ TclNRNewObjectInstance(
TclPushTailcallPoint(interp);
return TclOOInvokeContext(contextPtr, interp, objc, objv);
}
-
Object *
TclNewObjectInstanceCommon(
@@ -1705,21 +1744,17 @@ TclNewObjectInstanceCommon(
const char *simpleName = NULL;
Namespace *nsPtr = NULL, *dummy,
*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
- int isNew;
if (nameStr) {
- TclGetNamespaceForQualName(interp, nameStr, inNsPtr, TCL_CREATE_NS_IF_UNKNOWN,
- &nsPtr, &dummy, &dummy, &simpleName);
+ TclGetNamespaceForQualName(interp, nameStr, inNsPtr,
+ TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName);
/*
* Disallow creation of an object over an existing command.
*/
- hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, simpleName, &isNew);
- if (isNew) {
- /* Just kidding */
- Tcl_DeleteHashEntry(hPtr);
- } else {
+ 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));
@@ -1736,6 +1771,7 @@ TclNewObjectInstanceCommon(
oPtr->selfCls = classPtr;
AddRef(classPtr->thisPtr);
TclOOAddToInstances(oPtr, classPtr);
+
/*
* Check to see if we're really creating a class. If so, allocate the
* class structure as well.
@@ -1757,8 +1793,6 @@ TclNewObjectInstanceCommon(
return oPtr;
}
-
-
static int
FinalizeAlloc(
ClientData data[],
@@ -1794,13 +1828,21 @@ FinalizeAlloc(
(void) TclOOObjectName(interp, oPtr);
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
- /* This decrements the refcount of oPtr */
+
+ /*
+ * This decrements the refcount of oPtr.
+ */
+
TclOODeleteContext(contextPtr);
return TCL_ERROR;
}
Tcl_RestoreInterpState(interp, state);
*objectPtr = (Tcl_Object) oPtr;
- /* This decrements the refcount of oPtr */
+
+ /*
+ * This decrements the refcount of oPtr.
+ */
+
TclOODeleteContext(contextPtr);
return TCL_OK;
}
@@ -1885,7 +1927,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);
}
@@ -1915,7 +1961,8 @@ Tcl_CopyObjectInstance(
*/
o2Ptr->flags = oPtr->flags & ~(
- OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
+ OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
+
/*
* Copy the object's metadata.
*/
@@ -1979,9 +2026,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);
}
@@ -2018,7 +2067,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);
}
@@ -2619,7 +2672,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
@@ -2688,7 +2741,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 a46b8bc..cc02c68 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -110,7 +110,11 @@ TclOODeleteContext(
TclOODeleteChain(contextPtr->callPtr);
if (oPtr != NULL) {
TclStackFree(oPtr->fPtr->interp, contextPtr);
- /* Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore */
+
+ /*
+ * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore
+ */
+
TclOODecrRefCount(oPtr);
}
}
@@ -265,7 +269,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);
}
@@ -343,7 +347,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;
@@ -568,7 +572,10 @@ TclOOGetSortedClassMethodList(
return i;
}
-/* Comparator for GetSortedMethodList */
+/*
+ * Comparator for GetSortedMethodList
+ */
+
static int
CmpStr(
const void *ptr1,
@@ -577,7 +584,7 @@ CmpStr(
const char **strPtr1 = (const char **) ptr1;
const char **strPtr2 = (const char **) ptr2;
- return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1);
+ return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1);
}
/*
@@ -824,7 +831,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)) {
/*
@@ -836,8 +843,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);
@@ -854,7 +861,7 @@ AddMethodToCallChain(
if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
callPtr->chain =
- ckalloc(sizeof(struct MInvoke) * (callPtr->numChain+1));
+ ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
memcpy(callPtr->chain, callPtr->staticChain,
sizeof(struct MInvoke) * callPtr->numChain);
} else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
@@ -1172,7 +1179,11 @@ TclOOGetCallContext(
returnContext:
contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
contextPtr->oPtr = oPtr;
- /* Corresponding TclOODecrRefCount() in TclOODeleteContext */
+
+ /*
+ * Corresponding TclOODecrRefCount() in TclOODeleteContext
+ */
+
AddRef(oPtr);
contextPtr->callPtr = callPtr;
contextPtr->skip = 2;
@@ -1528,7 +1539,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] = miPtr->isFilter
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 0271a43..f02e1d3 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -41,6 +41,12 @@ struct DeclaredSlot {
setter, NULL, NULL}}
/*
+ * A [string match] pattern used to determine if a method should be exported.
+ */
+
+#define PUBLIC_PATTERN "[a-z]*"
+
+/*
* Forward declarations.
*/
@@ -232,7 +238,7 @@ TclOOObjectSetFilters(
} else {
filtersList = ckrealloc(oPtr->filters.list, size);
}
- for (i=0 ; i<numFilters ; i++) {
+ for (i = 0 ; i < numFilters ; i++) {
filtersList[i] = filters[i];
Tcl_IncrRefCount(filters[i]);
}
@@ -290,7 +296,7 @@ TclOOClassSetFilters(
} else {
filtersList = ckrealloc(classPtr->filters.list, size);
}
- for (i=0 ; i<numFilters ; i++) {
+ for (i = 0 ; i < numFilters ; i++) {
filtersList[i] = filters[i];
Tcl_IncrRefCount(filters[i]);
}
@@ -352,7 +358,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);
}
}
@@ -403,7 +413,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);
}
}
@@ -556,15 +570,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;
@@ -666,7 +681,9 @@ InitDefineContext(
return TCL_ERROR;
}
- /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
+ /*
+ * framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules.
+ */
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, FRAME_IS_OO_DEFINE);
@@ -837,17 +854,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);
}
@@ -1277,7 +1297,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.
*/
@@ -1401,7 +1421,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.
@@ -1492,14 +1512,14 @@ 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;
/*
* 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);
@@ -1550,7 +1570,7 @@ TclOODefineMethodObjCmd(
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;
/*
@@ -1668,7 +1688,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
@@ -1803,7 +1823,7 @@ TclOODefineSlots(
Tcl_IncrRefCount(setName);
for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
- (Tcl_Class) slotCls, slotInfoPtr->name, NULL,-1,NULL,0);
+ (Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0);
if (slotObject == NULL) {
continue;
@@ -1874,7 +1894,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;
@@ -1957,7 +1977,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;
@@ -1978,7 +1998,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) {
@@ -2061,7 +2081,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;
@@ -2108,14 +2128,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",
@@ -2135,8 +2155,12 @@ ClassSuperSet(
ckfree(superclasses);
return TCL_ERROR;
}
- /* Corresponding TclOODecrRefCount() is near the end of this
- * function */
+
+ /*
+ * Corresponding TclOODecrRefCount() is near the end of this
+ * function.
+ */
+
AddRef(superclasses[i]->thisPtr);
}
}
@@ -2222,7 +2246,7 @@ ClassVarsSet(
Tcl_Obj **varv, *variableObj;
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;
@@ -2241,7 +2265,7 @@ ClassVarsSet(
return TCL_ERROR;
}
- for (i=0 ; i<varc ; i++) {
+ for (i = 0; i < varc; i++) {
const char *varName = Tcl_GetString(varv[i]);
if (strstr(varName, "::") != NULL) {
@@ -2260,7 +2284,7 @@ ClassVarsSet(
}
}
- for (i=0 ; i<varc ; i++) {
+ for (i = 0; i < varc; i++) {
Tcl_IncrRefCount(varv[i]);
}
FOREACH(variableObj, oPtr->classPtr->variables) {
@@ -2285,7 +2309,7 @@ ClassVarsSet(
Tcl_HashTable uniqueTable;
Tcl_InitObjHashTable(&uniqueTable);
- for (i=n=0 ; i<varc ; i++) {
+ for (i = n = 0; i < varc; i++) {
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
if (created) {
oPtr->classPtr->variables.list[n++] = varv[i];
@@ -2357,7 +2381,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;
@@ -2430,7 +2454,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;
@@ -2445,7 +2469,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) {
@@ -2509,7 +2533,7 @@ ObjVarsSet(
int varc, i;
Tcl_Obj **varv, *variableObj;
- if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
+ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
"variableList");
return TCL_ERROR;
@@ -2522,7 +2546,7 @@ ObjVarsSet(
return TCL_ERROR;
}
- for (i=0 ; i<varc ; i++) {
+ for (i = 0; i < varc; i++) {
const char *varName = Tcl_GetString(varv[i]);
if (strstr(varName, "::") != NULL) {
@@ -2540,7 +2564,7 @@ ObjVarsSet(
return TCL_ERROR;
}
}
- for (i=0 ; i<varc ; i++) {
+ for (i = 0; i < varc; i++) {
Tcl_IncrRefCount(varv[i]);
}
@@ -2565,7 +2589,7 @@ ObjVarsSet(
Tcl_HashTable uniqueTable;
Tcl_InitObjHashTable(&uniqueTable);
- for (i=n=0 ; i<varc ; i++) {
+ for (i = n = 0; i < varc; i++) {
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
if (created) {
oPtr->variables.list[n++] = varv[i];
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b39ef0a..b16957d 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -952,8 +952,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 c10986a..5755edc 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;
@@ -1019,8 +1019,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;
@@ -1053,11 +1053,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((long) diff);
- if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) break;
- } else break;
+ if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
+ break;
+ }
+ } else {
+ break;
+ }
} else {
diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
#ifndef TCL_WIDE_INT_IS_LONG
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 809bcf0..2f35d4a 100755
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -682,7 +682,8 @@ NativeReadReparse(
HANDLE hFile;
DWORD returnedLength;
- hFile = CreateFile(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, OPEN_EXISTING,
+ hFile = CreateFile(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL,
+ OPEN_EXISTING,
FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
if (hFile == INVALID_HANDLE_VALUE) {
@@ -844,7 +845,7 @@ tclWinDebugPanic(
#endif
abort();
}
-
+
/*
*---------------------------------------------------------------------------
*
@@ -1461,11 +1462,16 @@ TclpGetUserHome(
if (domain == NULL) {
const char *ptr;
- /* no domain - firstly check it's the current user */
- if ( (ptr = TclpGetUserName(&ds)) != NULL
- && strcasecmp(name, ptr) == 0
- ) {
- /* try safest and fastest way to get current user home */
+ /*
+ * No domain. Firstly check it's the current user
+ */
+
+ ptr = TclpGetUserName(&ds);
+ if (ptr != NULL && strcasecmp(name, ptr) == 0) {
+ /*
+ * Try safest and fastest way to get current user home
+ */
+
ptr = TclGetEnv("HOME", &ds);
if (ptr != NULL) {
Tcl_JoinPath(1, &ptr, bufferPtr);
@@ -1486,18 +1492,28 @@ TclpGetUserHome(
wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
/*
- * user does not exists - if domain was not specified,
- * try again using current domain.
+ * User does not exist; if domain was not specified, try again
+ * using current domain.
*/
+
rc = 1;
- if (domain != NULL) break;
- /* get current domain */
+ if (domain != NULL) {
+ break;
+ }
+
+ /*
+ * Get current domain
+ */
+
rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
- if (rc != 0) break;
+ if (rc != 0) {
+ break;
+ }
domain = INT2PTR(-1); /* repeat once */
}
if (rc == 0) {
DWORD i, size = MAX_PATH;
+
wHomeDir = uiPtr->usri1_home_dir;
if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
size = lstrlenW(wHomeDir);
@@ -1507,15 +1523,22 @@ TclpGetUserHome(
* User exists but has no home dir. Return
* "{GetProfilesDirectory}/<user>".
*/
+
GetProfilesDirectoryW(buf, &size);
Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
Tcl_DStringAppend(bufferPtr, "/", 1);
Tcl_DStringAppend(bufferPtr, name, nameLen);
}
result = Tcl_DStringValue(bufferPtr);
- /* be sure we returns normalized path */
- for (i = 0; i < size; ++i){
- if (result[i] == '\\') result[i] = '/';
+
+ /*
+ * Be sure we returns normalized path
+ */
+
+ for (i = 0; i < size; ++i) {
+ if (result[i] == '\\') {
+ result[i] = '/';
+ }
}
NetApiBufferFree((void *) uiPtr);
}
@@ -1603,48 +1626,72 @@ NativeAccess(
/*
* If it's not a directory (assume file), do several fast checks:
*/
+
if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
/*
* If the attributes say this is not writable at all. The file is a
* regular file (i.e., not a directory), then the file is not
- * writable, full stop. For directories, the read-only bit is
+ * writable, full stop. For directories, the read-only bit is
* (mostly) ignored by Windows, so we can't ascertain anything about
* directory access from the attrib data. However, if we have the
- * advanced 'getFileSecurityProc', then more robust ACL checks
- * will be done below.
+ * advanced 'getFileSecurityProc', then more robust ACL checks will be
+ * done below.
*/
+
if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
Tcl_SetErrno(EACCES);
return -1;
}
- /* If doesn't have the correct extension, it can't be executable */
+ /*
+ * If doesn't have the correct extension, it can't be executable
+ */
+
if ((mode & X_OK) && !NativeIsExec(nativePath)) {
Tcl_SetErrno(EACCES);
return -1;
}
- /* Special case for read/write/executable check on file */
+
+ /*
+ * Special case for read/write/executable check on file
+ */
+
if ((mode & (R_OK|W_OK|X_OK)) && !(mode & ~(R_OK|W_OK|X_OK))) {
DWORD mask = 0;
HANDLE hFile;
- if (mode & R_OK) { mask |= GENERIC_READ; }
- if (mode & W_OK) { mask |= GENERIC_WRITE; }
- if (mode & X_OK) { mask |= GENERIC_EXECUTE; }
+
+ if (mode & R_OK) {
+ mask |= GENERIC_READ;
+ }
+ if (mode & W_OK) {
+ mask |= GENERIC_WRITE;
+ }
+ if (mode & X_OK) {
+ mask |= GENERIC_EXECUTE;
+ }
hFile = CreateFile(nativePath, mask,
- FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL,
- OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL);
+ FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
+ NULL, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL);
if (hFile != INVALID_HANDLE_VALUE) {
CloseHandle(hFile);
return 0;
}
- /* fast exit if access was denied */
+
+ /*
+ * Fast exit if access was denied
+ */
+
if (GetLastError() == ERROR_ACCESS_DENIED) {
Tcl_SetErrno(EACCES);
return -1;
}
}
- /* We cannnot verify the access fast, check it below using security info. */
+
+ /*
+ * We cannnot verify the access fast, check it below using security
+ * info.
+ */
}
/*
@@ -2021,13 +2068,12 @@ NativeStat(
* 'getFileAttributesExProc', and if that isn't available, then on even
* simpler routines.
*
- * Special consideration must be given to Windows hardcoded names
- * like CON, NULL, COM1, LPT1 etc. For these, we still need to
- * do the CreateFile as some may not exist (e.g. there is no CON
- * in wish by default). However the subsequent GetFileInformationByHandle
- * will fail. We do a WinIsReserved to see if it is one of the special
- * names, and if successful, mock up a BY_HANDLE_FILE_INFORMATION
- * structure.
+ * Special consideration must be given to Windows hardcoded names like
+ * CON, NULL, COM1, LPT1 etc. For these, we still need to do the
+ * CreateFile as some may not exist (e.g. there is no CON in wish by
+ * default). However the subsequent GetFileInformationByHandle will
+ * fail. We do a WinIsReserved to see if it is one of the special names,
+ * and if successful, mock up a BY_HANDLE_FILE_INFORMATION structure.
*/
fileHandle = CreateFile(nativePath, GENERIC_READ,
@@ -2045,7 +2091,11 @@ NativeStat(
Tcl_SetErrno(ENOENT);
return -1;
}
- /* Mock up the expected structure */
+
+ /*
+ * Mock up the expected structure
+ */
+
memset(&data, 0, sizeof(data));
statPtr->st_atime = 0;
statPtr->st_mtime = 0;
@@ -2328,7 +2378,7 @@ TclpGetNativeCwd(
}
if (clientData != NULL) {
- if (_tcscmp((const TCHAR*)clientData, buffer) == 0) {
+ if (_tcscmp((const TCHAR *) clientData, buffer) == 0) {
return clientData;
}
}
@@ -2556,10 +2606,12 @@ TclpObjNormalizePath(
(int)(sizeof(WCHAR) * len));
lastValidPathEnd = currentPathEndPosition;
} else if (nextCheckpoint == 0) {
- /* Path starts with a drive designation
- * that's not actually on the system.
- * We still must normalize up past the
- * first separator. [Bug 3603434] */
+ /*
+ * Path starts with a drive designation that's not
+ * actually on the system. We still must normalize up
+ * past the first separator. [Bug 3603434]
+ */
+
currentPathEndPosition++;
}
}
@@ -2574,11 +2626,10 @@ TclpObjNormalizePath(
*/
/*
- * Check for symlinks, except at last component of path (we
- * don't follow final symlinks). Also a drive (C:/) for
- * example, may sometimes have the reparse flag set for some
- * reason I don't understand. We therefore don't perform this
- * check for drives.
+ * Check for symlinks, except at last component of path (we don't
+ * follow final symlinks). Also a drive (C:/) for example, may
+ * sometimes have the reparse flag set for some reason I don't
+ * understand. We therefore don't perform this check for drives.
*/
if (cur != 0 && !isDrive &&
@@ -2587,8 +2638,8 @@ TclpObjNormalizePath(
if (to != NULL) {
/*
- * Read the reparse point ok. Now, reparse points need
- * not be normalized, otherwise we could use:
+ * Read the reparse point ok. Now, reparse points need not
+ * be normalized, otherwise we could use:
*
* Tcl_GetStringFromObj(to, &pathLen);
* nextCheckpoint = pathLen;
@@ -2628,9 +2679,9 @@ TclpObjNormalizePath(
#ifndef TclNORM_LONG_PATH
/*
- * Now we convert the tail of the current path to its 'long
- * form', and append it to 'dsNorm' which holds the current
- * normalized path
+ * Now we convert the tail of the current path to its 'long form',
+ * and append it to 'dsNorm' which holds the current normalized
+ * path
*/
if (isDrive) {
@@ -2659,10 +2710,10 @@ TclpObjNormalizePath(
int dotLen = currentPathEndPosition-lastValidPathEnd;
/*
- * Path is just dots. We shouldn't really ever see a
- * path like that. However, to be nice we at least
- * don't mangle the path - we just add the dots as a
- * path segment and continue.
+ * Path is just dots. We shouldn't really ever see a path
+ * like that. However, to be nice we at least don't mangle
+ * the path - we just add the dots as a path segment and
+ * continue.
*/
Tcl_DStringAppend(&dsNorm, ((const char *)nativePath)
@@ -2680,8 +2731,7 @@ TclpObjNormalizePath(
handle = FindFirstFileW((WCHAR *) nativePath, &fData);
if (handle == INVALID_HANDLE_VALUE) {
/*
- * This is usually the '/' in 'c:/' at end of
- * string.
+ * This is usually the '/' in 'c:/' at end of string.
*/
Tcl_DStringAppend(&dsNorm, (const char *) L"/",
@@ -2711,8 +2761,8 @@ TclpObjNormalizePath(
}
/*
- * If we get here, we've got past one directory delimiter, so
- * we know it is no longer a drive.
+ * If we get here, we've got past one directory delimiter, so we
+ * know it is no longer a drive.
*/
isDrive = 0;
@@ -3007,7 +3057,11 @@ TclNativeCreateNativeRep(
if (validPathPtr == NULL) {
return NULL;
}
- /* refCount of validPathPtr was already incremented in Tcl_FSGetTranslatedPath */
+
+ /*
+ * refCount of validPathPtr was already incremented in
+ * Tcl_FSGetTranslatedPath
+ */
} else {
/*
* Make sure the normalized path is set.
@@ -3017,73 +3071,101 @@ TclNativeCreateNativeRep(
if (validPathPtr == NULL) {
return NULL;
}
- /* validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl, so incr refCount here */
+
+ /*
+ * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl,
+ * so incr refCount here
+ */
+
Tcl_IncrRefCount(validPathPtr);
}
str = Tcl_GetString(validPathPtr);
len = validPathPtr->length;
- if (strlen(str)!=(unsigned int)len) {
- /* String contains NUL-bytes. This is invalid. */
+ if (strlen(str) != (unsigned int) len) {
+ /*
+ * String contains NUL-bytes. This is invalid.
+ */
+
goto done;
}
- /* For a reserved device, strip a possible postfix ':' */
+
+ /*
+ * For a reserved device, strip a possible postfix ':'
+ */
+
len = WinIsReserved(str);
if (len == 0) {
- /* Let MultiByteToWideChar check for other invalid sequences, like
- * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */
+ /*
+ * Let MultiByteToWideChar check for other invalid sequences, like
+ * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames
+ */
+
len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0);
if (len==0) {
goto done;
}
}
- /* Overallocate 6 chars, making some room for extended paths */
- wp = nativePathPtr = ckalloc( (len+6) * sizeof(WCHAR) );
+
+ /*
+ * Overallocate 6 chars, making some room for extended paths
+ */
+
+ wp = nativePathPtr = ckalloc((len + 6) * sizeof(WCHAR));
if (nativePathPtr==0) {
goto done;
}
- MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len+1);
+ MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr,
+ len + 1);
+
/*
- ** If path starts with "//?/" or "\\?\" (extended path), translate
- ** any slashes to backslashes but leave the '?' intact
- */
- if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
- && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
+ * If path starts with "//?/" or "\\?\" (extended path), translate any
+ * slashes to backslashes but leave the '?' intact
+ */
+
+ if ((str[0] == '\\' || str[0] == '/') && (str[1] == '\\' || str[1] == '/')
+ && str[2] == '?' && (str[3] == '\\' || str[3] == '/')) {
wp[0] = wp[1] = wp[3] = '\\';
str += 4;
wp += 4;
}
+
/*
- ** If there is no "\\?\" prefix but there is a drive or UNC
- ** path prefix and the path is larger than MAX_PATH chars,
- ** no Win32 API function can handle that unless it is
- ** prefixed with the extended path prefix. See:
- ** <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath>
- **/
- if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
- && str[1]==':') {
- if (wp==nativePathPtr && len>MAX_PATH && (str[2]=='\\' || str[2]=='/')) {
- memmove(wp+4, wp, len*sizeof(WCHAR));
- memcpy(wp, L"\\\\?\\", 4*sizeof(WCHAR));
+ * If there is no "\\?\" prefix but there is a drive or UNC path prefix
+ * and the path is larger than MAX_PATH chars, no Win32 API function can
+ * handle that unless it is prefixed with the extended path prefix. See:
+ * <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath>
+ */
+
+ if (((str[0] >= 'A' && str[0] <= 'Z') || (str[0] >= 'a' && str[0] <= 'z'))
+ && str[1] == ':') {
+ if (wp == nativePathPtr && len > MAX_PATH
+ && (str[2] == '\\' || str[2] == '/')) {
+ memmove(wp + 4, wp, len * sizeof(WCHAR));
+ memcpy(wp, L"\\\\?\\", 4 * sizeof(WCHAR));
wp += 4;
}
+
/*
- ** If (remainder of) path starts with "<drive>:",
- ** leave the ':' intact.
+ * If (remainder of) path starts with "<drive>:", leave the ':'
+ * intact.
*/
+
wp += 2;
- } else if (wp==nativePathPtr && len>MAX_PATH
- && (str[0]=='\\' || str[0]=='/')
- && (str[1]=='\\' || str[1]=='/') && str[2]!='?') {
- memmove(wp+6, wp, len*sizeof(WCHAR));
- memcpy(wp, L"\\\\?\\UNC", 7*sizeof(WCHAR));
+ } else if (wp == nativePathPtr && len > MAX_PATH
+ && (str[0] == '\\' || str[0] == '/')
+ && (str[1] == '\\' || str[1] == '/') && str[2] != '?') {
+ memmove(wp + 6, wp, len * sizeof(WCHAR));
+ memcpy(wp, L"\\\\?\\UNC", 7 * sizeof(WCHAR));
wp += 7;
}
+
/*
- ** In the remainder of the path, translate invalid characters to
- ** characters in the Unicode private use area.
- */
+ * In the remainder of the path, translate invalid characters to
+ * characters in the Unicode private use area.
+ */
+
while (*wp != '\0') {
if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) {
*wp |= 0xF000;
@@ -3094,7 +3176,6 @@ TclNativeCreateNativeRep(
}
done:
-
TclDecrRefCount(validPathPtr);
return nativePathPtr;
}
@@ -3220,21 +3301,28 @@ TclWinFileOwned(
native = Tcl_FSGetNativePath(pathPtr);
if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT,
- OWNER_SECURITY_INFORMATION, &ownerSid,
- NULL, NULL, NULL, &secd) != ERROR_SUCCESS) {
- /* Either not a file, or we do not have access to it in which
- case we are in all likelihood not the owner */
+ OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL,
+ &secd) != ERROR_SUCCESS) {
+ /*
+ * Either not a file, or we do not have access to it in which case we
+ * are in all likelihood not the owner.
+ */
+
return 0;
}
/*
- * Getting the current process SID is a multi-step process.
- * We make the assumption that if a call fails, this process is
- * so underprivileged it could not possibly own anything. Normally
- * a process can *always* look up its own token.
+ * Getting the current process SID is a multi-step process. We make the
+ * assumption that if a call fails, this process is so underprivileged it
+ * could not possibly own anything. Normally a process can *always* look
+ * up its own token.
*/
+
if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) {
- /* Find out how big the buffer needs to be */
+ /*
+ * Find out how big the buffer needs to be.
+ */
+
bufsz = 0;
GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
if (bufsz) {
@@ -3246,15 +3334,20 @@ TclWinFileOwned(
CloseHandle(token);
}
- /* Free allocations and be done */
- if (secd)
+ /*
+ * Free allocations and be done.
+ */
+
+ if (secd) {
LocalFree(secd); /* Also frees ownerSid */
- if (buf)
+ }
+ if (buf) {
ckfree(buf);
+ }
return (owned != 0); /* Convert non-0 to 1 */
}
-
+
/*
* Local Variables:
* mode: c
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 83bd26e..ce3e746 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -124,8 +124,7 @@ typedef struct PipeInfo {
* write. Set to 0 if no error has been
* detected. This word is shared with the
* writer thread so access must be
- * synchronized with the writable object.
- */
+ * synchronized with the writable object. */
char *writeBuf; /* Current background output buffer. Access is
* synchronized with the writable object. */
int writeBufLen; /* Size of write buffer. Access is
@@ -218,7 +217,7 @@ static const Tcl_ChannelType pipeChannelType = {
NULL, /* handler proc. */
NULL, /* wide seek proc */
PipeThreadActionProc, /* thread action proc */
- NULL /* truncate */
+ NULL /* truncate */
};
/*
@@ -1445,9 +1444,12 @@ ApplicationType(
static const char *
BuildCmdLineBypassBS(
const char *current,
- const char **bspos
-) {
- /* mark first backslash possition */
+ const char **bspos)
+{
+ /*
+ * Mark first backslash position.
+ */
+
if (!*bspos) {
*bspos = current;
}
@@ -1462,14 +1464,14 @@ QuoteCmdLineBackslash(
Tcl_DString *dsPtr,
const char *start,
const char *current,
- const char *bspos
-) {
+ const char *bspos)
+{
if (!bspos) {
- if (current > start) { /* part before current (special) */
+ if (current > start) { /* part before current (special) */
Tcl_DStringAppend(dsPtr, start, (int) (current - start));
}
} else {
- if (bspos > start) { /* part before first backslash */
+ if (bspos > start) { /* part before first backslash */
Tcl_DStringAppend(dsPtr, start, (int) (bspos - start));
}
while (bspos++ < current) { /* each backslash twice */
@@ -1484,38 +1486,59 @@ QuoteCmdLinePart(
const char *start,
const char *special,
const char *specMetaChars,
- const char **bspos
-) {
+ const char **bspos)
+{
if (!*bspos) {
- /* rest before special (before quote) */
+ /*
+ * Rest before special (before quote).
+ */
+
QuoteCmdLineBackslash(dsPtr, start, special, NULL);
start = special;
} else {
- /* rest before first backslash and backslashes into new quoted block */
+ /*
+ * Rest before first backslash and backslashes into new quoted block.
+ */
+
QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
start = *bspos;
}
+
/*
- * escape all special chars enclosed in quotes like `"..."`, note that here we
- * don't must escape `\` (with `\`), because it's outside of the main quotes,
- * so `\` remains `\`, but important - not at end of part, because results as
- * before the quote, so `%\%\` should be escaped as `"%\%"\\`).
+ * escape all special chars enclosed in quotes like `"..."`, note that
+ * here we don't must escape `\` (with `\`), because it's outside of the
+ * main quotes, so `\` remains `\`, but important - not at end of part,
+ * because results as before the quote, so `%\%\` should be escaped as
+ * `"%\%"\\`).
*/
+
TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */
do {
*bspos = NULL;
special++;
if (*special == '\\') {
- /* bypass backslashes (and mark first backslash possition)*/
+ /*
+ * Bypass backslashes (and mark first backslash position).
+ */
+
special = BuildCmdLineBypassBS(special, bspos);
- if (*special == '\0') break;
+ if (*special == '\0') {
+ break;
+ }
}
} while (*special && strchr(specMetaChars, *special));
if (!*bspos) {
- /* unescaped rest before quote */
+ /*
+ * Unescaped rest before quote.
+ */
+
QuoteCmdLineBackslash(dsPtr, start, special, NULL);
} else {
- /* unescaped rest before first backslash (rather belongs to the main block) */
+ /*
+ * Unescaped rest before first backslash (rather belongs to the main
+ * block).
+ */
+
QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
}
TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */
@@ -1534,13 +1557,14 @@ BuildCommandLine(
const char *arg, *start, *special, *bspos;
int quote = 0, i;
Tcl_DString ds;
-
- /* characters to enclose in quotes if unpaired quote flag set */
static const char specMetaChars[] = "&|^<>!()%";
- /* character to enclose in quotes in any case (regardless unpaired-flag) */
+ /* Characters to enclose in quotes if unpaired
+ * quote flag set. */
static const char specMetaChars2[] = "%";
-
- /* Quote flags:
+ /* Character to enclose in quotes in any case
+ * (regardless of unpaired-flag). */
+ /*
+ * Quote flags:
* CL_ESCAPE - escape argument;
* CL_QUOTE - enclose in quotes;
* CL_UNPAIRED - previous arguments chain contains unpaired quote-char;
@@ -1572,30 +1596,31 @@ BuildCommandLine(
quote = CL_QUOTE;
} else {
for (start = arg;
- *start != '\0' &&
- (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
- start++
- ) {
- if (*start & 0x80) continue;
+ *start != '\0' &&
+ (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
+ start++) {
+ if (*start & 0x80) {
+ continue;
+ }
if (TclIsSpaceProc(*start)) {
- quote |= CL_QUOTE; /* quote only */
- if (bspos) { /* if backslash found - escape & quote */
+ quote |= CL_QUOTE; /* quote only */
+ if (bspos) { /* if backslash found, escape & quote */
quote |= CL_ESCAPE;
break;
}
continue;
}
if (strchr(specMetaChars, *start)) {
- quote |= (CL_ESCAPE|CL_QUOTE); /*escape & quote */
+ quote |= (CL_ESCAPE|CL_QUOTE); /* escape & quote */
break;
}
if (*start == '"') {
- quote |= CL_ESCAPE; /* escape only */
+ quote |= CL_ESCAPE; /* escape only */
continue;
}
if (*start == '\\') {
bspos = start;
- if (quote & CL_QUOTE) { /* if quote - escape & quote */
+ if (quote & CL_QUOTE) { /* if quote, escape & quote */
quote |= CL_ESCAPE;
break;
}
@@ -1605,56 +1630,116 @@ BuildCommandLine(
bspos = NULL;
}
if (quote & CL_QUOTE) {
- /* start of argument (main opening quote-char) */
+ /*
+ * Start of argument (main opening quote-char).
+ */
+
TclDStringAppendLiteral(&ds, "\"");
}
if (!(quote & CL_ESCAPE)) {
- /* nothing to escape */
+ /*
+ * Nothing to escape.
+ */
+
Tcl_DStringAppend(&ds, arg, -1);
} else {
start = arg;
for (special = arg; *special != '\0'; ) {
- /* position of `\` is important before quote or at end (equal `\"` because quoted) */
+ /*
+ * Position of `\` is important before quote or at end (equal
+ * `\"` because quoted).
+ */
+
if (*special == '\\') {
- /* bypass backslashes (and mark first backslash possition)*/
+ /*
+ * Bypass backslashes (and mark first backslash position)
+ */
+
special = BuildCmdLineBypassBS(special, &bspos);
- if (*special == '\0') break;
+ if (*special == '\0') {
+ break;
+ }
}
/* ["] */
if (*special == '"') {
- quote ^= CL_UNPAIRED; /* invert unpaired flag - observe unpaired quotes */
- /* add part before (and escape backslashes before quote) */
+ /*
+ * Invert the unpaired flag - observe unpaired quotes
+ */
+
+ quote ^= CL_UNPAIRED;
+
+ /*
+ * Add part before (and escape backslashes before quote).
+ */
+
QuoteCmdLineBackslash(&ds, start, special, bspos);
bspos = NULL;
- /* escape using backslash */
+
+ /*
+ * Escape using backslash
+ */
+
TclDStringAppendLiteral(&ds, "\\\"");
start = ++special;
continue;
}
- /* unpaired (escaped) quote causes special handling on meta-chars */
+
+ /*
+ * Unpaired (escaped) quote causes special handling on
+ * meta-chars
+ */
+
if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) {
- special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos);
- /* start to current or first backslash */
+ special = QuoteCmdLinePart(&ds, start, special,
+ specMetaChars, &bspos);
+
+ /*
+ * Start to current or first backslash
+ */
+
start = !bspos ? special : bspos;
continue;
}
- /* special case for % - should be enclosed always (paired also) */
+
+ /*
+ * Special case for % - should be enclosed always (paired
+ * also)
+ */
+
if (strchr(specMetaChars2, *special)) {
- special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos);
- /* start to current or first backslash */
+ special = QuoteCmdLinePart(&ds, start, special,
+ specMetaChars2, &bspos);
+
+ /*
+ * Start to current or first backslash.
+ */
+
start = !bspos ? special : bspos;
continue;
}
- /* other not special (and not meta) character */
- bspos = NULL; /* reset last backslash possition (not interesting) */
+
+ /*
+ * Other not special (and not meta) character
+ */
+
+ bspos = NULL; /* reset last backslash position (not
+ * interesting) */
special++;
}
- /* rest of argument (and escape backslashes before closing main quote) */
+
+ /*
+ * Rest of argument (and escape backslashes before closing main
+ * quote)
+ */
+
QuoteCmdLineBackslash(&ds, start, special,
- (quote & CL_QUOTE) ? bspos : NULL);
+ (quote & CL_QUOTE) ? bspos : NULL);
}
if (quote & CL_QUOTE) {
- /* end of argument (main closing quote-char) */
+ /*
+ * End of argument (main closing quote-char)
+ */
+
TclDStringAppendLiteral(&ds, "\"");
}
}
@@ -2192,8 +2277,9 @@ PipeOutputProc(
*errorCode = 0;
/* avoid blocking if pipe-thread exited */
- timeout = ((infoPtr->flags & PIPE_ASYNC) || !TclPipeThreadIsAlive(&infoPtr->writeTI)
- || TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
+ timeout = ((infoPtr->flags & PIPE_ASYNC)
+ || !TclPipeThreadIsAlive(&infoPtr->writeTI)
+ || TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
/*
* The writer thread is blocked waiting for a write to complete and
@@ -2379,6 +2465,7 @@ PipeWatchProc(
infoPtr->watchMask = mask & infoPtr->validMask;
if (infoPtr->watchMask) {
Tcl_Time blockTime = { 0, 0 };
+
if (!oldMask) {
infoPtr->nextPtr = tsdPtr->firstPipePtr;
tsdPtr->firstPipePtr = infoPtr;
@@ -2848,7 +2935,7 @@ static DWORD WINAPI
PipeReaderThread(
LPVOID arg)
{
- TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+ TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *) arg;
PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
HANDLE handle = NULL;
DWORD count, err;
@@ -2859,13 +2946,14 @@ PipeReaderThread(
* Wait for the main thread to signal before attempting to wait on the
* pipe becoming readable.
*/
+
if (!TclPipeThreadWaitForSignal(&pipeTI)) {
/* exit */
break;
}
if (!infoPtr) {
- infoPtr = (PipeInfo *)pipeTI->clientData;
+ infoPtr = (PipeInfo *) pipeTI->clientData;
handle = ((WinFile *) infoPtr->readFile)->handle;
}
@@ -3211,7 +3299,7 @@ TclPipeThreadCreateTI(
pipeTI = malloc(sizeof(TclPipeThreadInfo));
#else
pipeTI = ckalloc(sizeof(TclPipeThreadInfo));
-#endif
+#endif /* !_PTI_USE_CKALLOC */
pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL);
pipeTI->state = PTI_STATE_IDLE;
pipeTI->clientData = clientData;
@@ -3250,40 +3338,64 @@ TclPipeThreadWaitForSignal(
}
wakeEvent = pipeTI->evWakeUp;
+
/*
* Wait for the main thread to signal before attempting to do the work.
*/
- /* reset work state of thread (idle/waiting) */
- if ((state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_IDLE, PTI_STATE_WORK)) & (PTI_STATE_STOP|PTI_STATE_END)) {
- /* end of work, check the owner of structure */
+ /*
+ * Reset work state of thread (idle/waiting)
+ */
+
+ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_IDLE,
+ PTI_STATE_WORK);
+ if (state & (PTI_STATE_STOP|PTI_STATE_END)) {
+ /*
+ * End of work, check the owner of structure.
+ */
+
goto end;
}
- /* entering wait */
- waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE);
- if (waitResult != WAIT_OBJECT_0) {
+ /*
+ * Entering wait
+ */
+ waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE);
+ if (waitResult != WAIT_OBJECT_0) {
/*
* The control event was not signaled, so end of work (unexpected
* behaviour, main thread can be dead?).
*/
+
goto end;
}
- /* try to set work state of thread */
- if ((state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_WORK, PTI_STATE_IDLE)) & (PTI_STATE_STOP|PTI_STATE_END)) {
- /* end of work */
+ /*
+ * Try to set work state of thread
+ */
+
+ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_WORK,
+ PTI_STATE_IDLE);
+ if (state & (PTI_STATE_STOP|PTI_STATE_END)) {
+ /*
+ * End of work
+ */
+
goto end;
}
- /* signaled to work */
+ /*
+ * Signaled to work.
+ */
+
return 1;
-end:
- /* end of work, check the owner of the TI structure */
+ end:
+ /*
+ * End of work, check the owner of the TI structure.
+ */
+
if (state != PTI_STATE_STOP) {
*pipeTIPtr = NULL;
} else {
@@ -3313,7 +3425,8 @@ end:
int
TclPipeThreadStopSignal(
- TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent)
+ TclPipeThreadInfo **pipeTIPtr,
+ HANDLE wakeEvent)
{
TclPipeThreadInfo *pipeTI = *pipeTIPtr;
HANDLE evControl;
@@ -3324,28 +3437,27 @@ TclPipeThreadStopSignal(
}
evControl = pipeTI->evControl;
pipeTI->evWakeUp = wakeEvent;
- switch (
- (state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_STOP, PTI_STATE_IDLE))
- ) {
-
- case PTI_STATE_IDLE:
-
- /* Thread was idle/waiting, notify it goes teardown */
- SetEvent(evControl);
-
- *pipeTIPtr = NULL;
-
- case PTI_STATE_DOWN:
+ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP,
+ PTI_STATE_IDLE);
+ switch (state) {
+ case PTI_STATE_IDLE:
+ /*
+ * Thread was idle/waiting, notify it goes teardown
+ */
+ SetEvent(evControl);
+ *pipeTIPtr = NULL;
+ case PTI_STATE_DOWN:
return 1;
- default:
- /*
- * Thread works currently, we should try to end it, own the TI structure
- * (because of possible sharing the joint structures with thread)
- */
- InterlockedExchange(&pipeTI->state, PTI_STATE_END);
+ default:
+ /*
+ * Thread works currently, we should try to end it, own the TI
+ * structure (because of possible sharing the joint structures with
+ * thread)
+ */
+
+ InterlockedExchange(&pipeTI->state, PTI_STATE_END);
break;
}
@@ -3388,46 +3500,63 @@ TclPipeThreadStop(
pipeTI = *pipeTIPtr;
evControl = pipeTI->evControl;
pipeTI->evWakeUp = NULL;
+
/*
* Try to sane stop the pipe worker, corresponding its current state
*/
- switch (
- (state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_STOP, PTI_STATE_IDLE))
- ) {
- case PTI_STATE_IDLE:
+ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP,
+ PTI_STATE_IDLE);
+ switch (state) {
+ case PTI_STATE_IDLE:
+ /*
+ * Thread was idle/waiting, notify it goes teardown
+ */
- /* Thread was idle/waiting, notify it goes teardown */
- SetEvent(evControl);
+ SetEvent(evControl);
- /* we don't need to wait for it at all, thread frees himself (owns the TI structure) */
- pipeTI = NULL;
+ /*
+ * We don't need to wait for it at all, thread frees himself (owns the
+ * TI structure)
+ */
+
+ pipeTI = NULL;
break;
- case PTI_STATE_STOP:
- /* already stopped, thread frees himself (owns the TI structure) */
- pipeTI = NULL;
+ case PTI_STATE_STOP:
+ /*
+ * Already stopped, thread frees himself (owns the TI structure)
+ */
+
+ pipeTI = NULL;
break;
- case PTI_STATE_DOWN:
- /* Thread already down (?), do nothing */
+ case PTI_STATE_DOWN:
+ /*
+ * Thread already down (?), do nothing
+ */
- /* we don't need to wait for it, but we should free pipeTI */
- hThread = NULL;
+ /*
+ * We don't need to wait for it, but we should free pipeTI
+ */
+ hThread = NULL;
break;
/* case PTI_STATE_WORK: */
- default:
+ default:
+ /*
+ * Thread works currently, we should try to end it, own the TI
+ * structure (because of possible sharing the joint structures with
+ * thread)
+ */
+
+ state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_END,
+ PTI_STATE_WORK);
+ if (state == PTI_STATE_DOWN) {
/*
- * Thread works currently, we should try to end it, own the TI structure
- * (because of possible sharing the joint structures with thread)
+ * We don't need to wait for it, but we should free pipeTI
*/
- if ((state = InterlockedCompareExchange(&pipeTI->state,
- PTI_STATE_END, PTI_STATE_WORK)) == PTI_STATE_DOWN
- ) {
- /* we don't need to wait for it, but we should free pipeTI */
- hThread = NULL;
- };
+ hThread = NULL;
+ }
break;
}
@@ -3442,8 +3571,8 @@ TclPipeThreadStop(
GetExitCodeThread(hThread, &exitCode);
if (exitCode == STILL_ACTIVE) {
-
int inExit = (TclInExit() || TclInThreadExit());
+
/*
* Set the stop event so that if the pipe thread is blocked
* somewhere, it may hereafter sane exit cleanly.
@@ -3454,59 +3583,69 @@ TclPipeThreadStop(
/*
* Cancel all sync-IO of this thread (may be blocked there).
*/
+
if (tclWinProcs.cancelSynchronousIo) {
tclWinProcs.cancelSynchronousIo(hThread);
}
/*
- * Wait at most 20 milliseconds for the reader thread to
- * close (regarding TIP#398-fast-exit).
+ * Wait at most 20 milliseconds for the reader thread to close
+ * (regarding TIP#398-fast-exit).
*/
- /* if we want TIP#398-fast-exit. */
- if (WaitForSingleObject(hThread, inExit ? 0 : 20) == WAIT_TIMEOUT) {
+ /*
+ * If we want TIP#398-fast-exit.
+ */
+ if (WaitForSingleObject(hThread, inExit ? 0 : 20) == WAIT_TIMEOUT) {
/*
- * The thread must be blocked waiting for the pipe to
- * become readable in ReadFile(). There isn't a clean way
- * to exit the thread from this condition. We should
- * terminate the child process instead to get the reader
- * thread to fall out of ReadFile with a FALSE. (below) is
- * not the correct way to do this, but will stay here
- * until a better solution is found.
+ * The thread must be blocked waiting for the pipe to become
+ * readable in ReadFile(). There isn't a clean way to exit the
+ * thread from this condition. We should terminate the child
+ * process instead to get the reader thread to fall out of
+ * ReadFile with a FALSE. (below) is not the correct way to do
+ * this, but will stay here until a better solution is found.
*
- * Note that we need to guard against terminating the
- * thread while it is in the middle of Tcl_ThreadAlert
- * because it won't be able to release the notifier lock.
+ * Note that we need to guard against terminating the thread
+ * while it is in the middle of Tcl_ThreadAlert because it
+ * won't be able to release the notifier lock.
*
- * Also note that terminating threads during their initialization or teardown phase
- * may result in ntdll.dll's LoaderLock to remain locked indefinitely.
- * This causes ntdll.dll's LdrpInitializeThread() to deadlock trying to acquire LoaderLock.
- * LdrpInitializeThread() is executed within new threads to perform
- * initialization and to execute DllMain() of all loaded dlls.
- * As a result, all new threads are deadlocked in their initialization phase and never execute,
- * even though CreateThread() reports successful thread creation.
- * This results in a very weird process-wide behavior, which is extremely hard to debug.
+ * Also note that terminating threads during their
+ * initialization or teardown phase may result in ntdll.dll's
+ * LoaderLock to remain locked indefinitely. This causes
+ * ntdll.dll's LdrpInitializeThread() to deadlock trying to
+ * acquire LoaderLock. LdrpInitializeThread() is executed
+ * within new threads to perform initialization and to execute
+ * DllMain() of all loaded dlls. As a result, all new threads
+ * are deadlocked in their initialization phase and never
+ * execute, even though CreateThread() reports successful
+ * thread creation. This results in a very weird process-wide
+ * behavior, which is extremely hard to debug.
*
* THREADS SHOULD NEVER BE TERMINATED. Period.
*
- * But for now, check if thread is exiting, and if so, let it die peacefully.
+ * But for now, check if thread is exiting, and if so, let it
+ * die peacefully.
*
- * Also don't terminate if in exit (otherwise deadlocked in ntdll.dll's).
+ * Also don't terminate if in exit (otherwise deadlocked in
+ * ntdll.dll's).
*/
- if ( pipeTI->state != PTI_STATE_DOWN
- && WaitForSingleObject(hThread,
- inExit ? 50 : 5000) != WAIT_OBJECT_0
- ) {
+ if (pipeTI->state != PTI_STATE_DOWN
+ && WaitForSingleObject(hThread,
+ inExit ? 50 : 5000) != WAIT_OBJECT_0) {
/* BUG: this leaks memory */
if (inExit || !TerminateThread(hThread, 0)) {
- /* in exit or terminate fails, just give thread a chance to exit */
+ /*
+ * in exit or terminate fails, just give thread a
+ * chance to exit
+ */
+
if (InterlockedExchange(&pipeTI->state,
PTI_STATE_STOP) != PTI_STATE_DOWN) {
pipeTI = NULL;
}
- };
+ }
}
}
}
@@ -3518,11 +3657,11 @@ TclPipeThreadStop(
SetEvent(pipeTI->evWakeUp);
}
CloseHandle(pipeTI->evControl);
- #ifndef _PTI_USE_CKALLOC
+#ifndef _PTI_USE_CKALLOC
free(pipeTI);
- #else
+#else
ckfree(pipeTI);
- #endif
+#endif /* !_PTI_USE_CKALLOC */
}
}
@@ -3551,28 +3690,30 @@ TclPipeThreadExit(
{
LONG state;
TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+
/*
* If state of thread was set to stop (exactly), we can sane free its info
* structure, otherwise it is shared with main thread, so main thread will
* own it.
*/
+
if (!pipeTI) {
return;
}
*pipeTIPtr = NULL;
- if ((state = InterlockedExchange(&pipeTI->state,
- PTI_STATE_DOWN)) == PTI_STATE_STOP) {
+ state = InterlockedExchange(&pipeTI->state, PTI_STATE_DOWN);
+ if (state == PTI_STATE_STOP) {
CloseHandle(pipeTI->evControl);
if (pipeTI->evWakeUp) {
SetEvent(pipeTI->evWakeUp);
}
- #ifndef _PTI_USE_CKALLOC
+#ifndef _PTI_USE_CKALLOC
free(pipeTI);
- #else
+#else
ckfree(pipeTI);
/* be sure all subsystems used are finalized */
Tcl_FinalizeThread();
- #endif
+#endif /* !_PTI_USE_CKALLOC */
}
}
generated by cgit v0.12 at 2024-11-17 01:11:39 (GMT)