Attachment "lconvert.diff" to
ticket [684534ffff]
added by
nobody
2003-02-11 18:46:22.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.72
diff -b -u -r1.72 tclBasic.c
--- generic/tclBasic.c 3 Feb 2003 20:16:52 -0000 1.72
+++ generic/tclBasic.c 11 Feb 2003 10:53:37 -0000
@@ -120,6 +120,8 @@
(CompileProc *) NULL, 1},
{"lappend", (Tcl_CmdProc *) NULL, Tcl_LappendObjCmd,
TclCompileLappendCmd, 1},
+ {"lconvert", (Tcl_CmdProc *) NULL, Tcl_LconvertObjCmd,
+ (CompileProc *) NULL, 0},
{"lindex", (Tcl_CmdProc *) NULL, Tcl_LindexObjCmd,
TclCompileLindexCmd, 1},
{"linsert", (Tcl_CmdProc *) NULL, Tcl_LinsertObjCmd,
@@ -1755,6 +1757,8 @@
#define NUM_ARGS 20
CONST char *(argStorage[NUM_ARGS]);
CONST char **argv = argStorage;
+ int newObjc; /* new argument count */
+ Tcl_Obj **newObjv; /* new argument objects. */
/*
* Create the string argument array "argv". Make sure argv is large
@@ -1762,20 +1766,23 @@
* end-of-argv word.
*/
- if ((objc + 1) > NUM_ARGS) {
- argv = (CONST char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
+ /* check for internal parameter lists */
+ newObjv = TclCheckPLists(interp, objc, objv, &newObjc);
+
+ if ((newObjc + 1) > NUM_ARGS) {
+ argv = (CONST char **) ckalloc((unsigned)(newObjc + 1) * sizeof(char *));
}
- for (i = 0; i < objc; i++) {
- argv[i] = Tcl_GetString(objv[i]);
+ for (i = 0; i < newObjc; i++) {
+ argv[i] = Tcl_GetString(newObjv[i]);
}
- argv[objc] = 0;
+ argv[newObjc] = 0;
/*
* Invoke the command's string-based Tcl_CmdProc.
*/
- result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
+ result = (*cmdPtr->proc)(cmdPtr->clientData, interp, newObjc, argv);
/*
* Free the argv array if malloc'ed storage was used.
@@ -1784,6 +1791,9 @@
if (argv != argStorage) {
ckfree((char *) argv);
}
+
+ TclFreePLists(objc, objv, newObjc, newObjv);
+
return result;
#undef NUM_ARGS
}
@@ -1830,6 +1840,8 @@
#define NUM_ARGS 20
Tcl_Obj *(argStorage[NUM_ARGS]);
register Tcl_Obj **objv = argStorage;
+ int newObjc; /* new argument count */
+ Tcl_Obj **newObjv; /* new argument objects. */
/*
* Create the object argument array "objv". Make sure objv is large
@@ -1854,8 +1866,11 @@
/*
* Invoke the command's object-based Tcl_ObjCmdProc.
*/
+ newObjv = TclCheckPLists(interp, argc, objv, &newObjc);
+
+ result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, newObjc, newObjv);
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);
+ TclFreePLists(argc, objv, newObjc, newObjv);
/*
* Move the interpreter's object result to the string result,
@@ -2978,6 +2993,9 @@
int i;
CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
* in case TCL_EVAL_GLOBAL was set. */
+ int newObjc; /* new argument count */
+ Tcl_Obj **newObjv2; /* new argument objects. */
+
int code = TCL_OK;
int traceCode = TCL_OK;
int checkTraces = 1;
@@ -3073,7 +3091,13 @@
if (flags & TCL_EVAL_GLOBAL) {
iPtr->varFramePtr = NULL;
}
- code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+
+ newObjv2 = TclCheckPLists(interp, objc, objv, &newObjc);
+
+ code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, newObjc, newObjv2);
+
+ TclFreePLists(objc, objv, newObjc, newObjv2);
+
iPtr->varFramePtr = savedVarFramePtr;
}
if (Tcl_AsyncReady()) {
@@ -3949,7 +3973,7 @@
* (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt)
*/
if (!(iPtr->flags & USE_EVAL_DIRECT) &&
- (objPtr->typePtr == &tclListType) && /* is a list... */
+ (TclIsListObj(objPtr)) && /* is a list... */
(objPtr->bytes == NULL) /* ...without a string rep */) {
register List *listRepPtr =
(List *) objPtr->internalRep.twoPtrValue.ptr1;
@@ -4540,6 +4564,8 @@
register int i;
int length, result;
char *bytes;
+ int newObjc; /* new argument count */
+ Tcl_Obj **newObjv; /* new argument objects. */
if (interp == (Tcl_Interp *) NULL) {
return TCL_ERROR;
@@ -4620,9 +4646,13 @@
* have gotten changed by earlier invocations.
*/
+ newObjv = TclCheckPLists(interp, objc, objv, &newObjc);
+
Tcl_ResetResult(interp);
iPtr->cmdCount++;
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, newObjc, newObjv);
+
+ TclFreePLists(objc, objv, newObjc, newObjv);
/*
* If an error occurred, record information about what was being
Index: generic/tclCmdIL.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdIL.c,v
retrieving revision 1.44
diff -b -u -r1.44 tclCmdIL.c
--- generic/tclCmdIL.c 11 Jun 2002 13:22:36 -0000 1.44
+++ generic/tclCmdIL.c 11 Feb 2003 10:53:41 -0000
@@ -2126,7 +2126,7 @@
* repeated shimmering; see TIP#22 and TIP#33 for the details.
*/
- if ( argPtr->typePtr != &tclListType
+ if (!TclIsListObj(argPtr)
&& TclGetIntForIndex( NULL , argPtr, 0, &index ) == TCL_OK ) {
/*
@@ -2203,7 +2203,7 @@
* it might have just been converted to something else.
*/
- if (listPtr->typePtr != &tclListType) {
+ if (!TclIsListObj(listPtr)) {
result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
&elemPtrs);
if (result != TCL_OK) {
@@ -2344,7 +2344,7 @@
* if objv[1] overlaps with one of the other parameters.
*/
- if (listPtr->typePtr != &tclListType) {
+ if (!TclIsListObj(listPtr)) {
result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
&elemPtrs);
if (result != TCL_OK) {
@@ -2615,7 +2615,7 @@
* converted to an int above if the argument objects were shared.
*/
- if (listPtr->typePtr != &tclListType) {
+ if (!TclIsListObj(listPtr)) {
result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
&elemPtrs);
if (result != TCL_OK) {
@@ -3826,3 +3826,57 @@
}
return diff;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LconvertObjCmd --
+ *
+ * This procedure is invoked to process the "lconvert" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+Tcl_LconvertObjCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ register int objc; /* Number of arguments. */
+ register Tcl_Obj *CONST objv[]; /* The argument objects. */
+{
+ Tcl_Obj *newValuePtr;
+ char *newType;
+
+ /* convert the list to the specified type */
+ if (objc >= 2) {
+ newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL, 0);
+
+ if (newValuePtr != NULL) {
+ if (objc >= 3) {
+ newType = Tcl_GetString(objv[2]);
+ } else {
+ newType = NULL;
+ }
+
+ return TclChangeListType(interp, newValuePtr, newType);
+ } else {
+ Tcl_SetResult(interp, "cannot change type of non-existant list",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "varName ?type?");
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
\ No newline at end of file
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.80
diff -b -u -r1.80 tclCmdMZ.c
--- generic/tclCmdMZ.c 17 Jan 2003 14:19:44 -0000 1.80
+++ generic/tclCmdMZ.c 11 Feb 2003 10:53:45 -0000
@@ -4210,6 +4210,8 @@
int curLevel;
int traceCode = TCL_OK;
TraceCommandInfo* tcmdPtr;
+ int newObjc; /* new argument count */
+ Tcl_Obj **newObjv; /* new argument objects. */
if (command == NULL || iPtr->tracePtr == NULL ||
(iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
@@ -4264,11 +4266,16 @@
tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
tcmdPtr->curFlags = traceFlags;
tcmdPtr->curCode = code;
+
+ newObjv = TclCheckPLists(interp, objc, objv, &newObjc);
+
traceCode = (tracePtr->proc)((ClientData)tcmdPtr,
(Tcl_Interp*)interp,
curLevel, command,
(Tcl_Command)cmdPtr,
- objc, objv);
+ newObjc, newObjv);
+
+ TclFreePLists(objc, objv, newObjc, newObjv);
}
} else {
/* Old-style trace */
@@ -4325,6 +4332,8 @@
Interp *iPtr = (Interp *) interp;
char *commandCopy;
int traceCode;
+ int newObjc; /* new argument count */
+ Tcl_Obj **newObjv; /* new argument objects. */
/*
* Copy the command characters into a new string.
@@ -4337,10 +4346,13 @@
/*
* Call the trace procedure then free allocated storage.
*/
+ newObjv = TclCheckPLists(interp, objc, objv, &newObjc);
traceCode = (tracePtr->proc)( tracePtr->clientData, (Tcl_Interp*) iPtr,
iPtr->numLevels, commandCopy,
- (Tcl_Command) cmdPtr, objc, objv );
+ (Tcl_Command) cmdPtr, newObjc, newObjv);
+
+ TclFreePLists(objc, objv, newObjc, newObjv);
ckfree((char *) commandCopy);
return(traceCode);
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.118
diff -b -u -r1.118 tclInt.h
--- generic/tclInt.h 10 Feb 2003 10:26:25 -0000 1.118
+++ generic/tclInt.h 11 Feb 2003 10:53:49 -0000
@@ -1589,6 +1589,7 @@
extern Tcl_ObjType tclEndOffsetType;
extern Tcl_ObjType tclIntType;
extern Tcl_ObjType tclListType;
+extern Tcl_ObjType tclPListType;
extern Tcl_ObjType tclProcBodyType;
extern Tcl_ObjType tclStringType;
extern Tcl_ObjType tclArraySearchType;
@@ -1817,6 +1818,18 @@
Tcl_FSUnloadFileProc **unloadProcPtr));
EXTERN int TclpUtime _ANSI_ARGS_((Tcl_Obj *pathPtr,
struct utimbuf *tval));
+EXTERN int TclChangeListType _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *listPtr, CONST char *newType));
+EXTERN int TclIsListObj
+ _ANSI_ARGS_((Tcl_Obj *listPtr));
+EXTERN int TclIsPListObj
+ _ANSI_ARGS_((Tcl_Obj *listPtr));
+EXTERN Tcl_Obj ** TclCheckPLists _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[],
+ int *newObjc));
+EXTERN void TclFreePLists _ANSI_ARGS_((int origObjc,
+ Tcl_Obj *CONST origObjv[],
+ int objc, Tcl_Obj *CONST objv[]));
/*
*----------------------------------------------------------------
@@ -1897,6 +1910,8 @@
EXTERN int Tcl_JoinObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LappendObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tcl_LconvertObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LindexObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
Index: generic/tclListObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclListObj.c,v
retrieving revision 1.13
diff -b -u -r1.13 tclListObj.c
--- generic/tclListObj.c 7 Jan 2002 23:09:13 -0000 1.13
+++ generic/tclListObj.c 11 Feb 2003 10:53:51 -0000
@@ -49,6 +49,16 @@
SetListFromAny /* setFromAnyProc */
};
+/* JJM: new hack to allow "parameter" lists. */
+/* When this code works, a TIP will be forthcoming. */
+Tcl_ObjType tclPListType = {
+ "plist", /* name */
+ FreeListInternalRep, /* freeIntRepProc */
+ DupListInternalRep, /* dupIntRepProc */
+ UpdateStringOfList, /* updateStringProc */
+ SetListFromAny /* setFromAnyProc */
+};
+
/*
*----------------------------------------------------------------------
*
@@ -324,7 +334,7 @@
{
register List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
+ if (!TclIsListObj(listPtr)) {
int result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -375,7 +385,7 @@
if (Tcl_IsShared(listPtr)) {
panic("Tcl_ListObjAppendList called with shared object");
}
- if (listPtr->typePtr != &tclListType) {
+ if (!TclIsListObj(listPtr)) {
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -437,7 +447,7 @@
if (Tcl_IsShared(listPtr)) {
panic("Tcl_ListObjAppendElement called with shared object");
}
- if (listPtr->typePtr != &tclListType) {
+ if (!TclIsListObj(listPtr)) {
int result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -521,7 +531,7 @@
{
register List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
+ if (!TclIsListObj(listPtr)) {
int result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -568,7 +578,7 @@
{
register List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
+ if (!TclIsListObj(listPtr)) {
int result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -637,7 +647,7 @@
if (Tcl_IsShared(listPtr)) {
panic("Tcl_ListObjReplace called with shared object");
}
- if (listPtr->typePtr != &tclListType) {
+ if (!TclIsListObj(listPtr)) {
result = SetListFromAny(interp, listPtr);
if (result != TCL_OK) {
return result;
@@ -849,7 +859,7 @@
* avoid repeated shimmering; see TIP #22 and #23 for details.
*/
- if ( indexArgPtr->typePtr != &tclListType
+ if (!TclIsListObj(indexArgPtr)
&& TclGetIntForIndex( NULL, indexArgPtr, 0, &index ) == TCL_OK ) {
/*
@@ -1316,7 +1326,7 @@
if ( Tcl_IsShared( listPtr ) ) {
panic( "Tcl_ListObjSetElement called with shared object" );
}
- if ( listPtr->typePtr != &tclListType ) {
+ if ( !TclIsListObj(listPtr) ) {
result = SetListFromAny( interp, listPtr );
if ( result != TCL_OK ) {
return result;
@@ -1655,4 +1665,252 @@
*dst = 0;
}
listPtr->length = dst - listPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChangeListType --
+ *
+ * Change the type of the list from list to plist or vice versa.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChangeListType(interp, listPtr, newType)
+ Tcl_Interp *interp; /* Used to report errors if not NULL. */
+ Tcl_Obj *listPtr; /* List object to change. */
+ CONST char *newType; /* What to? (either list or plist) */
+{
+ if (newType == NULL) {
+ if (listPtr->typePtr == &tclPListType) {
+ Tcl_SetResult(interp, "plist",
+ TCL_STATIC);
+ } else if (listPtr->typePtr == &tclListType) {
+ Tcl_SetResult(interp, "list",
+ TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "unknown",
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ } else if (strcmp(newType, "list") == 0) {
+ if (listPtr->typePtr == &tclPListType) {
+ listPtr->typePtr = &tclListType;
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+ } else {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "object is not a parameter list",
+ TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
+ } else if (strcmp(newType, "plist") == 0) {
+ if (listPtr->typePtr == &tclListType) {
+ listPtr->typePtr = &tclPListType;
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+ } else {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "object is not a list",
+ TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
+ } else {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "unknown list type",
+ TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIsListObj --
+ *
+ * Determines if the passed Tcl_Obj is a list or a plist.
+ *
+ * Results:
+ * Returns 1 if the Tcl_Obj is a list or a plist.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIsListObj(listPtr)
+ Tcl_Obj *listPtr; /* List object to check. */
+{
+ if ((listPtr->typePtr == &tclListType) || (listPtr->typePtr == &tclPListType)) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIsPListObj --
+ *
+ * Determines if the passed Tcl_Obj is a plist (parameter list).
+ *
+ * Results:
+ * Returns 1 if the Tcl_Obj is a plist.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclIsPListObj(listPtr)
+ Tcl_Obj *listPtr; /* List object to check. */
+{
+ if (listPtr->typePtr == &tclPListType) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+Tcl_Obj **
+TclCheckPLists(interp, objc, objv, newObjc)
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+ int *newObjc;
+{
+ int result;
+ int index;
+ List *listRepPtr;
+ int paramObjc;
+ int paramIndex;
+ Tcl_Obj **paramObjv;
+ int elemIndex;
+ Tcl_Obj **elemPtrs;
+ int listLen;
+
+ /* shortcut for no arguments */
+ if (objc == 0) return (Tcl_Obj **)objv;
+
+ /* init these vars to known state */
+ paramObjc = 0;
+ paramObjv = NULL;
+
+ /* we require an interp */
+ if (interp == NULL) goto error;
+ if (newObjc == NULL) goto error;
+
+ /* NOTE: We must do this counting only loop first
+ * so we know how much storage to allocate
+ * below.
+ */
+
+ /* now, we start counting arguments */
+ paramObjc = 0;
+ for (index = 0; index < objc; index++) {
+ if (objv[index]->typePtr == &tclPListType) {
+ /* a magical list of parameters (plist) */
+ listRepPtr = (List *) objv[index]->internalRep.twoPtrValue.ptr1;
+ paramObjc += listRepPtr->elemCount;
+ } else {
+ /* just another parameter */
+ paramObjc++;
+ }
+ }
+
+ /*
+ * Now, we can proceed with constructing the new argument list.
+ */
+ if (paramObjc > 0) {
+ /* optimize for common case where there are NO plists in the args. */
+ if (paramObjc != objc) {
+ paramObjv = (Tcl_Obj **) ckalloc((unsigned)(paramObjc + 1) * sizeof(Tcl_Obj *));
+ paramIndex = 0; /* where are we in the destination array? */
+ for (index = 0; index < objc; index++) {
+ if (objv[index]->typePtr == &tclPListType) {
+ result = Tcl_ListObjGetElements(interp, objv[index], &listLen, &elemPtrs);
+
+ if (result == TCL_OK) {
+ /* copy this plist into the final parameter list (flatten) */
+ for (elemIndex = 0; elemIndex < listLen; elemIndex++) {
+ paramObjv[paramIndex] = elemPtrs[elemIndex];
+
+ Tcl_IncrRefCount(paramObjv[paramIndex]);
+
+ paramIndex++;
+ }
+ } else {
+ goto error;
+ }
+ } else {
+ paramObjv[paramIndex] = objv[index];
+
+ Tcl_IncrRefCount(paramObjv[paramIndex]);
+
+ paramIndex++;
+ }
+ }
+
+ paramObjv[paramObjc] = 0;
+ *newObjc = paramObjc;
+ } else {
+ /* no changes, there must not be any plists embedded in the arguments. */
+ paramObjv = (Tcl_Obj **)objv;
+ *newObjc = objc;
+ }
+ } else {
+ /* this is a fatal error. */
+ panic("no parameters found in TclCheckPLists");
+
+ paramObjv = NULL;
+ }
+
+ return paramObjv;
+error:
+ /* we suffered an error, clean up allocated storage and bail */
+ TclFreePLists(objc, objv, paramObjc, paramObjv);
+
+ panic("unknown failure in TclCheckPLists");
+
+ return NULL;
+}
+
+void
+TclFreePLists(origObjc, origObjv, objc, objv)
+ int origObjc;
+ Tcl_Obj *CONST origObjv[];
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int index;
+
+ if (objv != NULL) {
+ /*
+ * NOTE: Only free if it's been allocated by us and not simply referred to.
+ */
+ if (objv != origObjv) {
+ for (index = 0; index < objc; index++)
+ {
+ Tcl_DecrRefCount(objv[index]);
+ }
+
+ ckfree((char *) objv);
+ }
+ }
}
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.31
diff -b -u -r1.31 tclNamesp.c
--- generic/tclNamesp.c 15 Jul 2002 22:18:07 -0000 1.31
+++ generic/tclNamesp.c 11 Feb 2003 10:53:56 -0000
@@ -1124,6 +1124,8 @@
Tcl_Command autoCmd, importedCmd;
ImportedCmdData *dataPtr;
int wasExported, i, result;
+ int newObjc; /* new argument count */
+ Tcl_Obj **newObjv; /* new argument objects. */
/*
* If the specified namespace is NULL, use the current namespace.
@@ -1155,8 +1157,13 @@
Tcl_IncrRefCount(objv[1]);
cmdPtr = (Command *) autoCmd;
+
+ newObjv = TclCheckPLists(interp, 2, objv, &newObjc);
+
result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
- 2, objv);
+ newObjc, newObjv);
+
+ TclFreePLists(2, objv, newObjc, newObjv);
Tcl_DecrRefCount(objv[0]);
Tcl_DecrRefCount(objv[1]);
@@ -1473,9 +1480,18 @@
{
register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
register Command *realCmdPtr = dataPtr->realCmdPtr;
+ int newObjc; /* new argument count */
+ Tcl_Obj **newObjv; /* new argument objects. */
+ int result; /* result of command */
+
+ newObjv = TclCheckPLists(interp, objc, objv, &newObjc);
+
+ result = (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
+ newObjc, newObjv);
+
+ TclFreePLists(objc, objv, newObjc, newObjv);
- return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
- objc, objv);
+ return result;
}
/*
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.42
diff -b -u -r1.42 tclObj.c
--- generic/tclObj.c 17 Jan 2003 22:11:02 -0000 1.42
+++ generic/tclObj.c 11 Feb 2003 10:53:59 -0000
@@ -238,6 +238,7 @@
#endif
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType);
+ Tcl_RegisterObjType(&tclPListType);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclProcBodyType);
Tcl_RegisterObjType(&tclArraySearchType);
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.36
diff -b -u -r1.36 tclUtil.c
--- generic/tclUtil.c 19 Nov 2002 02:34:50 -0000 1.36
+++ generic/tclUtil.c 11 Feb 2003 10:54:01 -0000
@@ -1040,7 +1040,7 @@
*/
for (i = 0; i < objc; i++) {
objPtr = objv[i];
- if ((objPtr->typePtr != &tclListType) || (objPtr->bytes != NULL)) {
+ if ((!TclIsListObj(objPtr)) || (objPtr->bytes != NULL)) {
break;
}
}
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.69
diff -b -u -r1.69 tclVar.c
--- generic/tclVar.c 12 Nov 2002 02:23:03 -0000 1.69
+++ generic/tclVar.c 11 Feb 2003 10:54:07 -0000
@@ -2727,7 +2727,7 @@
* Convert the variable's old value to a list object if necessary.
*/
- if (varValuePtr->typePtr != &tclListType) {
+ if (!TclIsListObj(varValuePtr)) {
int result = tclListType.setFromAnyProc(interp, varValuePtr);
if (result != TCL_OK) {
if (createdNewObj) {
