summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdIL.c76
1 files changed, 43 insertions, 33 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index c143304..99c8316 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.111 2007/03/11 16:54:57 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.112 2007/03/12 16:26:27 dkf Exp $
*/
#include "tclInt.h"
@@ -1430,6 +1430,7 @@ InfoGlobalsCmd(
pattern = NULL;
} else if (objc == 3) {
pattern = TclGetString(objv[2]);
+
/*
* Strip leading global-namespace qualifiers. [Bug 1057461]
*/
@@ -1551,10 +1552,11 @@ InfoLevelCmd(
{
Interp *iPtr = (Interp *) interp;
- if (objc == 2) { /* just "info level". */
+ if (objc == 2) { /* Just "info level" */
Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
return TCL_OK;
- }
+ }
+
if (objc == 3) {
int level;
CallFrame *framePtr, *rootFramePtr = iPtr->rootFramePtr;
@@ -1564,15 +1566,12 @@ InfoLevelCmd(
}
if (level <= 0) {
if (iPtr->varFramePtr == rootFramePtr) {
- levelError:
- Tcl_AppendResult(interp, "bad level \"",
- TclGetString(objv[2]), "\"", NULL);
- return TCL_ERROR;
+ goto levelError;
}
level += iPtr->varFramePtr->level;
}
- for (framePtr = iPtr->varFramePtr; framePtr != rootFramePtr;
- framePtr = framePtr->callerVarPtr) {
+ for (framePtr=iPtr->varFramePtr ; framePtr!=rootFramePtr;
+ framePtr=framePtr->callerVarPtr) {
if (framePtr->level == level) {
break;
}
@@ -1581,13 +1580,18 @@ InfoLevelCmd(
goto levelError;
}
- Tcl_SetObjResult(interp,
+ Tcl_SetObjResult(interp,
Tcl_NewListObj(framePtr->objc, framePtr->objv));
return TCL_OK;
}
Tcl_WrongNumArgs(interp, 2, objv, "?number?");
return TCL_ERROR;
+
+ levelError:
+ Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[2]), "\"",
+ NULL);
+ return TCL_ERROR;
}
/*
@@ -1765,7 +1769,7 @@ AppendLocals(
CompiledLocal *localPtr;
Var *varPtr;
int i, localVarCt;
- char *varName;
+ const char *varName;
Tcl_HashTable *localVarTablePtr;
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
@@ -2801,8 +2805,7 @@ Tcl_LrangeObjCmd(
register Tcl_Obj *CONST objv[])
/* Argument objects. */
{
- Tcl_Obj *listPtr;
- Tcl_Obj **elemPtrs;
+ Tcl_Obj *listPtr, **elemPtrs;
int listLen, first, result;
if (objc != 4) {
@@ -2839,6 +2842,7 @@ Tcl_LrangeObjCmd(
if (first <= last) {
int numElems = (last - first + 1);
+
Tcl_SetObjResult(interp,
Tcl_NewListObj(numElems, &(elemPtrs[first])));
}
@@ -3160,6 +3164,7 @@ Tcl_LsearchObjCmd(
double patDouble, objDouble;
SortInfo sortInfo;
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
+ SortStrCmpFn_t strCmpFn = strcmp;
Tcl_RegExp regexp = NULL;
static CONST char *options[] = {
"-all", "-ascii", "-decreasing", "-dictionary",
@@ -3181,7 +3186,6 @@ Tcl_LsearchObjCmd(
enum modes {
EXACT, GLOB, REGEXP, SORTED
};
- SortStrCmpFn_t strCmpFn = strcmp;
mode = GLOB;
dataType = ASCII;
@@ -3284,10 +3288,10 @@ Tcl_LsearchObjCmd(
i++;
if (objv[i] == objv[objc - 2]) {
/*
- * Take copy to prevent shimmering problems. Note that it
- * does not matter if the index obj is also a component of the
- * list being searched. We only need to copy where the list
- * and the index are one-and-the-same.
+ * Take copy to prevent shimmering problems. Note that it does
+ * not matter if the index obj is also a component of the list
+ * being searched. We only need to copy where the list and the
+ * index are one-and-the-same.
*/
startPtr = Tcl_DuplicateObj(objv[i]);
@@ -3388,9 +3392,8 @@ Tcl_LsearchObjCmd(
if (regexp == NULL) {
/*
* Failed to compile the RE. Try again without the TCL_REG_NOSUB
- * flag in case the RE had sub-expressions in it [Bug 1366683].
- * If this fails, an error message will be left in the
- * interpreter.
+ * flag in case the RE had sub-expressions in it [Bug 1366683]. If
+ * this fails, an error message will be left in the interpreter.
*/
regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
@@ -3623,7 +3626,7 @@ Tcl_LsearchObjCmd(
if (length == elemLen) {
/*
* This split allows for more optimal compilation of
- * memcmp.
+ * memcmp/strcasecmp.
*/
if (noCase) {
@@ -3634,6 +3637,7 @@ Tcl_LsearchObjCmd(
}
}
break;
+
case DICTIONARY:
bytes = TclGetString(itemPtr);
match = (DictionaryCompare(bytes, patternBytes) == 0);
@@ -3673,6 +3677,7 @@ Tcl_LsearchObjCmd(
match = Tcl_StringCaseMatch(TclGetString(itemPtr),
patternBytes, noCase);
break;
+
case REGEXP:
match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0);
if (match < 0) {
@@ -3714,6 +3719,7 @@ Tcl_LsearchObjCmd(
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else if (returnSubindices) {
int j;
+
itemPtr = Tcl_NewIntObj(i);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr,
@@ -3735,6 +3741,7 @@ Tcl_LsearchObjCmd(
} else if (!inlineReturn) {
if (returnSubindices) {
int j;
+
itemPtr = Tcl_NewIntObj(index);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_ListObjAppendElement(interp, itemPtr,
@@ -4013,6 +4020,8 @@ Tcl_LsortObjCmd(
listObj = objv[objc-1];
if (sortInfo.sortMode == SORTMODE_COMMAND) {
+ Tcl_Obj *newCommandPtr, *newObjPtr;
+
/*
* When sorting using a command, we are reentrant and therefore might
* have the representation of the list being sorted shimmered out from
@@ -4022,6 +4031,9 @@ Tcl_LsortObjCmd(
listObj = TclListObjCopy(interp,listObj);
if (listObj == NULL) {
+ if (sortInfo.indexc > 1) {
+ ckfree((char *) sortInfo.indexv);
+ }
return TCL_ERROR;
}
@@ -4030,9 +4042,8 @@ Tcl_LsortObjCmd(
* dummy arguments on the end, and replace these arguments later.
*/
- Tcl_Obj *newCommandPtr = Tcl_DuplicateObj(cmdPtr);
- Tcl_Obj *newObjPtr = Tcl_NewObj();
-
+ newCommandPtr = Tcl_DuplicateObj(cmdPtr);
+ TclNewObj(newObjPtr);
Tcl_IncrRefCount(newCommandPtr);
if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
!= TCL_OK) {
@@ -4185,8 +4196,7 @@ MergeLists(
SortInfo *infoPtr) /* Information needed by the comparison
* operator. */
{
- SortElement *headPtr;
- SortElement *tailPtr;
+ SortElement *headPtr, *tailPtr;
int cmp;
if (leftPtr == NULL) {
@@ -4473,7 +4483,8 @@ DictionaryCompare(
diff = uniLeftLower - uniRightLower;
if (diff) {
return diff;
- } else if (secondaryDiff == 0) {
+ }
+ if (secondaryDiff == 0) {
if (Tcl_UniCharIsUpper(uniLeft) && Tcl_UniCharIsLower(uniRight)) {
secondaryDiff = -1;
} else if (Tcl_UniCharIsUpper(uniRight)
@@ -4535,8 +4546,7 @@ SelectObjFromSublist(
int listLen, index;
Tcl_Obj *currentObj;
- if (Tcl_ListObjLength(infoPtr->interp, objPtr,
- &listLen) != TCL_OK) {
+ if (Tcl_ListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
@@ -4559,9 +4569,9 @@ SelectObjFromSublist(
char buffer[TCL_INTEGER_SPACE];
TclFormatInt(buffer, index);
- Tcl_AppendResult(infoPtr->interp,
- "element ", buffer, " missing from sublist \"",
- TclGetString(objPtr), "\"", NULL);
+ Tcl_AppendResult(infoPtr->interp, "element ", buffer,
+ " missing from sublist \"", TclGetString(objPtr), "\"",
+ NULL);
infoPtr->resultCode = TCL_ERROR;
return NULL;
}
generated by cgit v0.12 at 2024-12-29 04:55:00 (GMT)