summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclNamesp.c58
-rw-r--r--generic/tclPkg.c45
-rw-r--r--generic/tclTimer.c8
4 files changed, 81 insertions, 37 deletions
diff --git a/ChangeLog b/ChangeLog
index d9dcc21..30fad98 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2011-05-09 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNamesp.c (NamespacePathCmd): Convert to use Tcl_Obj API
+ * generic/tclPkg.c (Tcl_PackageObjCmd): for result generation in
+ * generic/tclTimer.c (Tcl_AfterObjCmd): [after info], [namespace
+ path] and [package versions].
+
2011-05-09 Don Porter <dgp@users.sourceforge.net>
* generic/tclListObj.c: Revise empty string tests so that we avoid
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index f3c93e7..9a2152a 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -3959,16 +3959,15 @@ NamespacePathCmd(
*/
if (objc == 1) {
- /*
- * Not a very fast way to compute this, but easy to get right.
- */
+ Tcl_Obj *resultObj = Tcl_NewObj();
for (i=0 ; i<nsPtr->commandPathLength ; i++) {
if (nsPtr->commandPathArray[i].nsPtr != NULL) {
- Tcl_AppendElement(interp,
- nsPtr->commandPathArray[i].nsPtr->fullName);
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
+ nsPtr->commandPathArray[i].nsPtr->fullName, -1));
}
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
@@ -4844,8 +4843,9 @@ TclLogCommandInfo(
* the error. */
int length, /* Number of bytes in command (-1 means use
* all bytes up to first null byte). */
- const unsigned char *pc, /* current pc of bytecode execution context */
- Tcl_Obj **tosPtr) /* current stack of bytecode execution context */
+ const unsigned char *pc, /* Current pc of bytecode execution context */
+ Tcl_Obj **tosPtr) /* Current stack of bytecode execution
+ * context */
{
register const char *p;
Interp *iPtr = (Interp *) interp;
@@ -4930,32 +4930,46 @@ TclLogCommandInfo(
iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
- /* reset while keeping the list intrep as much as possible */
+
+ /*
+ * Reset while keeping the list intrep as much as possible.
+ */
+
Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
if (pc != NULL) {
Tcl_Obj *innerContext;
innerContext = TclGetInnerContext(interp, pc, tosPtr);
if (innerContext != NULL) {
- Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
+ iPtr->innerLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext);
}
} else if (command != NULL) {
- Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
- Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(command, length));
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
+ iPtr->innerLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
+ Tcl_NewStringObj(command, length));
}
}
if (!iPtr->framePtr->objc) {
- /* special frame, nothing to report */
+ /*
+ * Special frame, nothing to report.
+ */
} else if (iPtr->varFramePtr != iPtr->framePtr) {
- /* uplevel case, [lappend errorstack UP $relativelevel] */
+ /*
+ * uplevel case, [lappend errorstack UP $relativelevel]
+ */
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(
iPtr->framePtr->level - iPtr->varFramePtr->level));
} else if (iPtr->framePtr != iPtr->rootFramePtr) {
- /* normal case, [lappend errorstack CALL [info level 0]] */
+ /*
+ * normal case, [lappend errorstack CALL [info level 0]]
+ */
+
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj(
iPtr->framePtr->objc, iPtr->framePtr->objv));
@@ -4979,7 +4993,12 @@ TclLogCommandInfo(
*
*----------------------------------------------------------------------
*/
-void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length)
+
+void
+TclErrorStackResetIf(
+ Tcl_Interp *interp,
+ const char *msg,
+ int length)
{
Interp *iPtr = (Interp *) interp;
@@ -4996,10 +5015,15 @@ void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length)
iPtr->resetErrorStack = 0;
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
- /* reset while keeping the list intrep as much as possible */
+
+ /*
+ * Reset while keeping the list intrep as much as possible.
+ */
+
Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
- Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(msg, length));
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
+ Tcl_NewStringObj(msg, length));
}
}
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 67503cb..fdaea57 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -882,18 +882,25 @@ Tcl_PackageObjCmd(
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
- }
- tablePtr = &iPtr->packageTable;
- for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&search)) {
- pkgPtr = Tcl_GetHashValue(hPtr);
- if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
+ } else {
+ Tcl_Obj *resultObj;
+
+ resultObj = Tcl_NewObj();
+ tablePtr = &iPtr->packageTable;
+ for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ pkgPtr = Tcl_GetHashValue(hPtr);
+ if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
+ Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj(
+ Tcl_GetHashKey(tablePtr, hPtr), -1));
+ }
}
+ Tcl_SetObjResult(interp, resultObj);
}
break;
case PKG_PRESENT: {
const char *name;
+
if (objc < 3) {
goto require;
}
@@ -1098,23 +1105,27 @@ Tcl_PackageObjCmd(
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "package");
return TCL_ERROR;
- }
- argv2 = TclGetString(objv[2]);
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
- if (hPtr != NULL) {
- pkgPtr = Tcl_GetHashValue(hPtr);
- for (availPtr = pkgPtr->availPtr; availPtr != NULL;
- availPtr = availPtr->nextPtr) {
- Tcl_AppendElement(interp, availPtr->version);
+ } else {
+ Tcl_Obj *resultObj = Tcl_NewObj();
+
+ argv2 = TclGetString(objv[2]);
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
+ if (hPtr != NULL) {
+ pkgPtr = Tcl_GetHashValue(hPtr);
+ for (availPtr = pkgPtr->availPtr; availPtr != NULL;
+ availPtr = availPtr->nextPtr) {
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(availPtr->version, -1));
+ }
}
+ Tcl_SetObjResult(interp, resultObj);
}
break;
case PKG_VSATISFIES: {
char *argv2i = NULL;
if (objc < 4) {
- Tcl_WrongNumArgs(interp, 2, objv,
- "version ?requirement ...?");
+ Tcl_WrongNumArgs(interp, 2, objv, "version ?requirement ...?");
return TCL_ERROR;
}
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 6682d21..cf91dca 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -793,7 +793,6 @@ Tcl_AfterObjCmd(
AfterAssocData *assocPtr;
int length;
int index;
- char buf[16 + TCL_INTEGER_SPACE];
static const char *const afterSubCmds[] = {
"cancel", "idle", "info", NULL
};
@@ -952,13 +951,16 @@ Tcl_AfterObjCmd(
break;
case AFTER_INFO:
if (objc == 2) {
+ Tcl_Obj *resultObj = Tcl_NewObj();
+
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
afterPtr = afterPtr->nextPtr) {
if (assocPtr->interp == interp) {
- sprintf(buf, "after#%d", afterPtr->id);
- Tcl_AppendElement(interp, buf);
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
+ "after#%d", afterPtr->id));
}
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
if (objc != 3) {
generated by cgit v0.12 at 2024-11-23 03:51:34 (GMT)