summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2018-04-19 17:40:10 (GMT)
committerdgp <dgp@users.sourceforge.net>2018-04-19 17:40:10 (GMT)
commit346eec18923b94fd1c361528afd629c79262631a (patch)
tree937b45972cbaeaeaea478d702456543743aa96b1
parent47fc4afd862da2e3956e8437f7689ba043ac3a43 (diff)
parentddb7bbe66c5b805d02fc11f55c53e909e1af45ac (diff)
downloadtcl-346eec18923b94fd1c361528afd629c79262631a.zip
tcl-346eec18923b94fd1c361528afd629c79262631a.tar.gz
tcl-346eec18923b94fd1c361528afd629c79262631a.tar.bz2
merge 8.7
-rw-r--r--generic/tclCompCmds.c18
-rw-r--r--generic/tclExecute.c17
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclTrace.c53
-rw-r--r--generic/tclVar.c659
-rw-r--r--library/http/http.tcl7
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--tests/msgcat.test16
-rw-r--r--tests/var.test34
-rw-r--r--unix/Makefile.in4
-rw-r--r--win/Makefile.in4
11 files changed, 360 insertions, 458 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index b9bc228..3a162cc 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -322,11 +322,22 @@ TclCompileArraySetCmd(
*/
if (isDataValid && !isDataEven) {
+ /* Abandon custom compile and let invocation raise the error */
+ code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
+ goto done;
+
+ /*
+ * We used to compile to the bytecode that would throw the error,
+ * but that was wrong because it would not invoke the array trace
+ * on the variable.
+ *
PushStringLiteral(envPtr, "list must have an even number of elements");
PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
TclEmitInt4( 0, envPtr);
goto done;
+ *
+ */
}
/*
@@ -404,6 +415,10 @@ TclCompileArraySetCmd(
* Start issuing instructions to write to the array.
*/
+ TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
+ TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
+ TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
+
CompileWord(envPtr, dataTokenPtr, interp, 2);
if (!isDataLiteral || !isDataValid) {
/*
@@ -428,9 +443,6 @@ TclCompileArraySetCmd(
TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
}
- TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
- TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
- TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
offsetBack = CurrentOffset(envPtr);
Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c06632b..49c74da 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4015,17 +4015,12 @@ TEBCresume(
varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
/*createPart1*/0, /*createPart2*/0, &arrayPtr);
doArrayExists:
- if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
- && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- DECACHE_STACK_INFO();
- result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
- NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|
- TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
- CACHE_STACK_INFO();
- if (result == TCL_ERROR) {
- TRACE_ERROR(interp);
- goto gotError;
- }
+ DECACHE_STACK_INFO();
+ result = TclCheckArrayTraces(interp, varPtr, arrayPtr, part1Ptr, opnd);
+ CACHE_STACK_INFO();
+ if (result == TCL_ERROR) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
objResultPtr = TCONST(1);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 27e7ce8..e9afbbb 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2889,8 +2889,6 @@ MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
CmdFrame *cfPtr);
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
CmdFrame **cfPtrPtr, int *wordPtr);
-MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
- Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum);
MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
int strLen, const unsigned char *pattern,
@@ -2898,6 +2896,8 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
MODULE_SCOPE double TclCeil(const mp_int *a);
MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
+MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
+ Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
const char *value);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index f86f472..8663eae 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -191,8 +191,10 @@ Tcl_TraceObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int optionIndex;
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
const char *name;
const char *flagOps, *p;
+#endif
/* Main sub commands to 'trace' */
static const char *const traceOptions[] = {
"add", "info", "remove",
@@ -365,12 +367,14 @@ Tcl_TraceObjCmd(
}
return TCL_OK;
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
badVarOps:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad operations \"%s\": should be one or more of rwua",
flagOps));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
return TCL_ERROR;
+#endif
}
/*
@@ -912,9 +916,11 @@ TraceVariableObjCmd(
+ 1 + length);
ctvarPtr->traceCmdInfo.flags = flags;
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
if (objv[0] == NULL) {
ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
}
+#endif
ctvarPtr->traceCmdInfo.length = length;
flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
@@ -939,7 +945,11 @@ TraceVariableObjCmd(
TraceVarInfo *tvarPtr = clientData;
if ((tvarPtr->length == length)
- && ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
+ && ((tvarPtr->flags
+#ifndef TCL_REMOVE_OBSOLETE_TRACES
+& ~TCL_TRACE_OLD_STYLE
+#endif
+ )==flags)
&& (strncmp(command, tvarPtr->command,
(size_t) length) == 0)) {
Tcl_UntraceVar2(interp, name, NULL,
@@ -2468,6 +2478,47 @@ TclVarTraceExists(
/*
*----------------------------------------------------------------------
*
+ * TclCheckArrayTraces --
+ *
+ * This function is invoked to when we operate on an array variable,
+ * to allow any array traces to fire.
+ *
+ * Results:
+ * Returns TCL_OK to indicate normal operation. Returns TCL_ERROR if
+ * invocation of a trace function indicated an error. When TCL_ERROR is
+ * returned, then error information is left in interp.
+ *
+ * Side effects:
+ * Almost anything can happen, depending on trace; this function itself
+ * doesn't have any side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCheckArrayTraces(
+ Tcl_Interp *interp,
+ Var *varPtr,
+ Var *arrayPtr,
+ Tcl_Obj *name,
+ int index)
+{
+ int code = TCL_OK;
+
+ if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
+ && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
+ Interp *iPtr = (Interp *)interp;
+
+ code = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, name, NULL,
+ (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| TCL_TRACE_ARRAY),
+ /* leaveErrMsg */ 1, index);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclCallVarTraces --
*
* This function is invoked to find and invoke relevant trace functions
diff --git a/generic/tclVar.c b/generic/tclVar.c
index a2fa680..7a71990 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -181,6 +181,9 @@ static int ArrayForNRCmd(ClientData dummy, Tcl_Interp *interp, int
static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
Var *varPtr, int flags, int index);
+static int LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
+ Var **varPtrPtr, int *isArrayPtr);
+static int NotArrayError(Tcl_Interp *interp, Tcl_Obj *name);
static Tcl_Var ObjFindNamespaceVar(Tcl_Interp *interp,
Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
int flags);
@@ -193,7 +196,6 @@ static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
static void UnsetVarStruct(Var *varPtr, Var *arrayPtr,
Interp *iPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, int flags, int index);
-static Var * VerifyArray(Tcl_Interp *interp, Tcl_Obj *varNameObj);
/*
* Functions defined in this file that may be exported in the future for use
@@ -252,6 +254,42 @@ TclVarHashCreateVar(
return varPtr;
}
+
+static int
+LocateArray(
+ Tcl_Interp *interp,
+ Tcl_Obj *name,
+ Var **varPtrPtr,
+ int *isArrayPtr)
+{
+ Var *arrayPtr, *varPtr = TclObjLookupVarEx(interp, name, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+
+ if (TclCheckArrayTraces(interp, varPtr, arrayPtr, name, -1) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (varPtrPtr) {
+ *varPtrPtr = varPtr;
+ }
+ if (isArrayPtr) {
+ *isArrayPtr = varPtr && !TclIsVarUndefined(varPtr)
+ && TclIsVarArray(varPtr);
+ }
+ return TCL_OK;
+}
+
+static int
+NotArrayError(
+ Tcl_Interp *interp,
+ Tcl_Obj *name)
+{
+ const char *nameStr = Tcl_GetString(name);
+
+ Tcl_SetObjResult(interp,
+ Tcl_ObjPrintf("\"%s\" isn't an array", nameStr));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, NULL);
+ return TCL_ERROR;
+}
/*
*----------------------------------------------------------------------
@@ -2871,175 +2909,6 @@ Tcl_LappendObjCmd(
/*
*----------------------------------------------------------------------
*
- * TclArraySet --
- *
- * Set the elements of an array. If there are no elements to set, create
- * an empty array. This routine is used by the Tcl_ArrayObjCmd and by the
- * TclSetupEnv routine.
- *
- * Results:
- * A standard Tcl result object.
- *
- * Side effects:
- * A variable will be created if one does not already exist.
- * Callers must Incr arrayNameObj if they pland to Decr it.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclArraySet(
- Tcl_Interp *interp, /* Current interpreter. */
- Tcl_Obj *arrayNameObj, /* The array name. */
- Tcl_Obj *arrayElemObj) /* The array elements list or dict. If this is
- * NULL, create an empty array. */
-{
- Var *varPtr, *arrayPtr;
- int result, i;
-
- varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
- /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
- /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- return TCL_ERROR;
- }
- if (arrayPtr) {
- CleanupVar(varPtr, arrayPtr);
- TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
- TclGetString(arrayNameObj), NULL);
- return TCL_ERROR;
- }
-
- if (arrayElemObj == NULL) {
- goto ensureArray;
- }
-
- /*
- * Install the contents of the dictionary or list into the array.
- */
-
- if (arrayElemObj->typePtr == &tclDictType) {
- Tcl_Obj *keyPtr, *valuePtr;
- Tcl_DictSearch search;
- int done;
-
- if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
- return TCL_ERROR;
- }
- if (done == 0) {
- /*
- * Empty, so we'll just force the array to be properly existing
- * instead.
- */
-
- goto ensureArray;
- }
-
- /*
- * Don't need to look at result of Tcl_DictObjFirst as we've just
- * successfully used a dictionary operation on the same object.
- */
-
- for (Tcl_DictObjFirst(interp, arrayElemObj, &search,
- &keyPtr, &valuePtr, &done) ; !done ;
- Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
- /*
- * At this point, it would be nice if the key was directly usable
- * by the array. This isn't the case though.
- */
-
- Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
- keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
-
- if ((elemVarPtr == NULL) ||
- (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
- keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
- Tcl_DictObjDone(&search);
- return TCL_ERROR;
- }
- }
- return TCL_OK;
- } else {
- /*
- * Not a dictionary, so assume (and convert to, for backward-
- * -compatibility reasons) a list.
- */
-
- int elemLen;
- Tcl_Obj **elemPtrs, *copyListObj;
-
- result = TclListObjGetElements(interp, arrayElemObj,
- &elemLen, &elemPtrs);
- if (result != TCL_OK) {
- return result;
- }
- if (elemLen & 1) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "list must have an even number of elements", -1));
- Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
- return TCL_ERROR;
- }
- if (elemLen == 0) {
- goto ensureArray;
- }
-
- /*
- * We needn't worry about traces invalidating arrayPtr: should that be
- * the case, TclPtrSetVarIdx will return NULL so that we break out of
- * the loop and return an error.
- */
-
- copyListObj = TclListObjCopy(NULL, arrayElemObj);
- for (i=0 ; i<elemLen ; i+=2) {
- Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
- elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
-
- if ((elemVarPtr == NULL) ||
- (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
- elemPtrs[i],elemPtrs[i+1],TCL_LEAVE_ERR_MSG,-1) == NULL)){
- result = TCL_ERROR;
- break;
- }
- }
- Tcl_DecrRefCount(copyListObj);
- return result;
- }
-
- /*
- * The list is empty make sure we have an array, or create one if
- * necessary.
- */
-
- ensureArray:
- if (varPtr != NULL) {
- if (TclIsVarArray(varPtr)) {
- /*
- * Already an array, done.
- */
-
- return TCL_OK;
- }
- if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
- /*
- * Either an array element, or a scalar: lose!
- */
-
- TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
- needArray, -1);
- Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
- return TCL_ERROR;
- }
- }
- TclSetVarArray(varPtr);
- varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
- TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* ArrayForObjCmd
* ArrayForNRCmd
* ArrayForLoopCallback
@@ -3390,52 +3259,6 @@ ArrayForLoopCallback(
/* ARGSUSED */
-static Var *
-VerifyArray(
- Tcl_Interp *interp,
- Tcl_Obj *varNameObj)
-{
- Interp *iPtr = (Interp *) interp;
- const char *varName = TclGetString(varNameObj);
- Var *arrayPtr;
-
- /*
- * Locate the array variable.
- */
-
- Var *varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-
- /*
- * Special array trace used to keep the env array in sync for array names,
- * array get, etc.
- */
-
- if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
- && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
- (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
- return NULL;
- }
- }
-
- /*
- * Verify that it is indeed an array variable. This test comes after the
- * traces - the variable may actually become an array as an effect of said
- * traces.
- */
-
- if ((varPtr == NULL) || !TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr)) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "\"%s\" isn't an array", varName));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
- return NULL;
- }
-
- return varPtr;
-}
-
static int
ArrayStartSearchCmd(
ClientData clientData,
@@ -3443,26 +3266,31 @@ ArrayStartSearchCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *) interp;
+ Interp *iPtr = (Interp *)interp;
Var *varPtr;
Tcl_HashEntry *hPtr;
- int isNew;
+ int isNew, isArray;
ArraySearch *searchPtr;
+ const char *varName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
return TCL_ERROR;
}
- varPtr = VerifyArray(interp, objv[1]);
- if (varPtr == NULL) {
+ if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
return TCL_ERROR;
}
+ if (!isArray) {
+ return NotArrayError(interp, objv[1]);
+ }
+
/*
* Make a new array search with a free name.
*/
+ varName = TclGetString(objv[1]);
searchPtr = ckalloc(sizeof(ArraySearch));
hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
if (isNew) {
@@ -3555,7 +3383,7 @@ ArrayAnyMoreCmd(
Interp *iPtr = (Interp *) interp;
Var *varPtr;
Tcl_Obj *varNameObj, *searchObj;
- int gotValue;
+ int gotValue, isArray;
ArraySearch *searchPtr;
if (objc != 3) {
@@ -3565,11 +3393,14 @@ ArrayAnyMoreCmd(
varNameObj = objv[1];
searchObj = objv[2];
- varPtr = VerifyArray(interp, varNameObj);
- if (varPtr == NULL) {
+ if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
return TCL_ERROR;
}
+ if (!isArray) {
+ return NotArrayError(interp, varNameObj);
+ }
+
/*
* Get the search.
*/
@@ -3631,6 +3462,7 @@ ArrayNextElementCmd(
Var *varPtr;
Tcl_Obj *varNameObj, *searchObj;
ArraySearch *searchPtr;
+ int isArray;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3639,11 +3471,14 @@ ArrayNextElementCmd(
varNameObj = objv[1];
searchObj = objv[2];
- varPtr = VerifyArray(interp, varNameObj);
- if (varPtr == NULL) {
+ if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
return TCL_ERROR;
}
+ if (!isArray) {
+ return NotArrayError(interp, varNameObj);
+ }
+
/*
* Get the search.
*/
@@ -3709,6 +3544,7 @@ ArrayDoneSearchCmd(
Var *varPtr;
Tcl_Obj *varNameObj, *searchObj;
ArraySearch *searchPtr;
+ int isArray;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
@@ -3717,11 +3553,14 @@ ArrayDoneSearchCmd(
varNameObj = objv[1];
searchObj = objv[2];
- varPtr = VerifyArray(interp, varNameObj);
- if (varPtr == NULL) {
+ if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
return TCL_ERROR;
}
+ if (!isArray) {
+ return NotArrayError(interp, varNameObj);
+ }
+
/*
* Get the search.
*/
@@ -3762,45 +3601,19 @@ ArrayExistsCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *) interp;
- Var *varPtr, *arrayPtr;
- Tcl_Obj *arrayNameObj;
- int notArray;
+ Interp *iPtr = (Interp *)interp;
+ int isArray;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
return TCL_ERROR;
}
- arrayNameObj = objv[1];
-
- /*
- * Locate the array variable.
- */
-
- varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-
- /*
- * Special array trace used to keep the env array in sync for array names,
- * array get, etc.
- */
- if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
- && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL,
- (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
- return TCL_ERROR;
- }
+ if (TCL_ERROR == LocateArray(interp, objv[1], NULL, &isArray)) {
+ return TCL_ERROR;
}
- /*
- * Check whether we've actually got an array variable.
- */
-
- notArray = ((varPtr == NULL) || !TclIsVarArray(varPtr)
- || TclIsVarUndefined(varPtr));
- Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]);
+ Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[isArray]);
return TCL_OK;
}
@@ -3829,13 +3642,12 @@ ArrayGetCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *) interp;
- Var *varPtr, *arrayPtr, *varPtr2;
+ Var *varPtr, *varPtr2;
Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
Tcl_Obj **nameObjPtr, *patternObj;
Tcl_HashSearch search;
const char *pattern;
- int i, count, result;
+ int i, count, result, isArray;
switch (objc) {
case 2:
@@ -3851,35 +3663,12 @@ ArrayGetCmd(
return TCL_ERROR;
}
- /*
- * Locate the array variable.
- */
-
- varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-
- /*
- * Special array trace used to keep the env array in sync for array names,
- * array get, etc.
- */
-
- if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
- && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
- (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
- return TCL_ERROR;
- }
+ if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
+ return TCL_ERROR;
}
- /*
- * Verify that it is indeed an array variable. This test comes after the
- * traces - the variable may actually become an array as an effect of said
- * traces. If not an array, it's an empty result.
- */
-
- if ((varPtr == NULL) || !TclIsVarArray(varPtr)
- || TclIsVarUndefined(varPtr)) {
+ /* If not an array, it's an empty result. */
+ if (!isArray) {
return TCL_OK;
}
@@ -4017,39 +3806,20 @@ ArrayNamesCmd(
"-exact", "-glob", "-regexp", NULL
};
enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
- Interp *iPtr = (Interp *) interp;
- Var *varPtr, *arrayPtr, *varPtr2;
- Tcl_Obj *varNameObj, *nameObj, *resultObj, *patternObj;
+ Var *varPtr, *varPtr2;
+ Tcl_Obj *nameObj, *resultObj, *patternObj;
Tcl_HashSearch search;
const char *pattern = NULL;
- int mode = OPT_GLOB;
+ int isArray, mode = OPT_GLOB;
if ((objc < 2) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?");
return TCL_ERROR;
}
- varNameObj = objv[1];
patternObj = (objc > 2 ? objv[objc-1] : NULL);
- /*
- * Locate the array variable.
- */
-
- varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-
- /*
- * Special array trace used to keep the env array in sync for array names,
- * array get, etc.
- */
-
- if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
- && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
- (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
- return TCL_ERROR;
- }
+ if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
+ return TCL_ERROR;
}
/*
@@ -4061,14 +3831,9 @@ ArrayNamesCmd(
return TCL_ERROR;
}
- /*
- * Verify that it is indeed an array variable. This test comes after the
- * traces - the variable may actually become an array as an effect of said
- * traces. If not an array, the result is empty.
- */
+ /* If not an array, the result is empty. */
- if ((varPtr == NULL) || !TclIsVarArray(varPtr)
- || TclIsVarUndefined(varPtr)) {
+ if (!isArray) {
return TCL_OK;
}
@@ -4205,36 +3970,156 @@ ArraySetCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *arrayNameObj;
+ Tcl_Obj *arrayElemObj;
Var *varPtr, *arrayPtr;
+ int result, i;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName list");
return TCL_ERROR;
}
+ if (TCL_ERROR == LocateArray(interp, objv[1], NULL, NULL)) {
+ return TCL_ERROR;
+ }
+
+ arrayNameObj = objv[1];
+ varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
+ /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
+ /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (arrayPtr) {
+ CleanupVar(varPtr, arrayPtr);
+ TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+ TclGetString(arrayNameObj), NULL);
+ return TCL_ERROR;
+ }
+
/*
- * Locate the array variable.
+ * Install the contents of the dictionary or list into the array.
*/
- varPtr = TclObjLookupVarEx(interp, objv[1], NULL, /*flags*/ 0,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ arrayElemObj = objv[2];
+ if (arrayElemObj->typePtr == &tclDictType && arrayElemObj->bytes == NULL) {
+ Tcl_Obj *keyPtr, *valuePtr;
+ Tcl_DictSearch search;
+ int done;
+
+ if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (done == 0) {
+ /*
+ * Empty, so we'll just force the array to be properly existing
+ * instead.
+ */
+
+ goto ensureArray;
+ }
+
+ /*
+ * Don't need to look at result of Tcl_DictObjFirst as we've just
+ * successfully used a dictionary operation on the same object.
+ */
+
+ for (Tcl_DictObjFirst(interp, arrayElemObj, &search,
+ &keyPtr, &valuePtr, &done) ; !done ;
+ Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done)) {
+ /*
+ * At this point, it would be nice if the key was directly usable
+ * by the array. This isn't the case though.
+ */
+
+ Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
+ keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
+
+ if ((elemVarPtr == NULL) ||
+ (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
+ keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
+ Tcl_DictObjDone(&search);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+ } else {
+ /*
+ * Not a dictionary, so assume (and convert to, for backward-
+ * -compatibility reasons) a list.
+ */
+
+ int elemLen;
+ Tcl_Obj **elemPtrs, *copyListObj;
+
+ result = TclListObjGetElements(interp, arrayElemObj,
+ &elemLen, &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (elemLen & 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "list must have an even number of elements", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
+ return TCL_ERROR;
+ }
+ if (elemLen == 0) {
+ goto ensureArray;
+ }
+
+ /*
+ * We needn't worry about traces invalidating arrayPtr: should that be
+ * the case, TclPtrSetVarIdx will return NULL so that we break out of
+ * the loop and return an error.
+ */
+
+ copyListObj = TclListObjCopy(NULL, arrayElemObj);
+ for (i=0 ; i<elemLen ; i+=2) {
+ Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
+ elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);
+
+ if ((elemVarPtr == NULL) ||
+ (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
+ elemPtrs[i],elemPtrs[i+1],TCL_LEAVE_ERR_MSG,-1) == NULL)){
+ result = TCL_ERROR;
+ break;
+ }
+ }
+ Tcl_DecrRefCount(copyListObj);
+ return result;
+ }
/*
- * Special array trace used to keep the env array in sync for array names,
- * array get, etc.
+ * The list is empty make sure we have an array, or create one if
+ * necessary.
*/
- if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
- && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, objv[1], NULL,
- (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
+ ensureArray:
+ if (varPtr != NULL) {
+ if (TclIsVarArray(varPtr)) {
+ /*
+ * Already an array, done.
+ */
+
+ return TCL_OK;
+ }
+ if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
+ /*
+ * Either an array element, or a scalar: lose!
+ */
+
+ TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
+ needArray, -1);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
return TCL_ERROR;
}
}
-
- return TclArraySet(interp, objv[1], objv[2]);
+ TclSetVarArray(varPtr);
+ varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
+ TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
+ return TCL_OK;
}
/*
@@ -4262,47 +4147,23 @@ ArraySizeCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *) interp;
- Var *varPtr, *arrayPtr;
- Tcl_Obj *varNameObj;
+ Var *varPtr;
Tcl_HashSearch search;
Var *varPtr2;
- int size = 0;
+ int isArray, size = 0;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
return TCL_ERROR;
}
- varNameObj = objv[1];
-
- /*
- * Locate the array variable.
- */
-
- varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-
- /*
- * Special array trace used to keep the env array in sync for array names,
- * array get, etc.
- */
- if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
- && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
- (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
- return TCL_ERROR;
- }
+ if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
+ return TCL_ERROR;
}
- /*
- * Verify that it is indeed an array variable. This test comes after the
- * traces - the variable may actually become an array as an effect of said
- * traces. We can only iterate over the array if it exists...
- */
+ /* We can only iterate over the array if it exists... */
- if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+ if (isArray) {
/*
* Must iterate in order to get chance to check for present but
* "undefined" entries.
@@ -4346,10 +4207,10 @@ ArrayStatsCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *) interp;
- Var *varPtr, *arrayPtr;
+ Var *varPtr;
Tcl_Obj *varNameObj;
char *stats;
+ int isArray;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
@@ -4357,40 +4218,12 @@ ArrayStatsCmd(
}
varNameObj = objv[1];
- /*
- * Locate the array variable.
- */
-
- varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-
- /*
- * Special array trace used to keep the env array in sync for array names,
- * array get, etc.
- */
-
- if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
- && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
- (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
- return TCL_ERROR;
- }
+ if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
+ return TCL_ERROR;
}
- /*
- * Verify that it is indeed an array variable. This test comes after the
- * traces - the variable may actually become an array as an effect of said
- * traces.
- */
-
- if ((varPtr == NULL) || !TclIsVarArray(varPtr)
- || TclIsVarUndefined(varPtr)) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "\"%s\" isn't an array", TclGetString(varNameObj)));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
- TclGetString(varNameObj), NULL);
- return TCL_ERROR;
+ if (!isArray) {
+ return NotArrayError(interp, varNameObj);
}
stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
@@ -4429,12 +4262,12 @@ ArrayUnsetCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *) interp;
- Var *varPtr, *arrayPtr, *varPtr2, *protectedVarPtr;
+ Var *varPtr, *varPtr2, *protectedVarPtr;
Tcl_Obj *varNameObj, *patternObj, *nameObj;
Tcl_HashSearch search;
const char *pattern;
const int unsetFlags = 0; /* Should this be TCL_LEAVE_ERR_MSG? */
+ int isArray;
switch (objc) {
case 2:
@@ -4450,35 +4283,11 @@ ArrayUnsetCmd(
return TCL_ERROR;
}
- /*
- * Locate the array variable
- */
-
- varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
- /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-
- /*
- * Special array trace used to keep the env array in sync for array names,
- * array get, etc.
- */
-
- if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
- && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
- if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
- (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
- TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
- return TCL_ERROR;
- }
+ if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
+ return TCL_ERROR;
}
- /*
- * Verify that it is indeed an array variable. This test comes after the
- * traces - the variable may actually become an array as an effect of said
- * traces.
- */
-
- if ((varPtr == NULL) || !TclIsVarArray(varPtr)
- || TclIsVarUndefined(varPtr)) {
+ if (!isArray) {
return TCL_OK;
}
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 9f5310b..186d067 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
-package provide http 2.8.12
+package provide http 2.8.13
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -602,7 +602,7 @@ proc http::geturl {url args} {
if {[info exists state(-myaddr)]} {
lappend sockopts -myaddr $state(-myaddr)
}
- if {[catch {eval $defcmd $sockopts $targetAddr} sock]} {
+ if {[catch {eval $defcmd $sockopts $targetAddr} sock errdict]} {
# something went wrong while trying to establish the connection.
# Clean up after events and such, but DON'T call the command
# callback (if available) because we're going to throw an
@@ -611,7 +611,8 @@ proc http::geturl {url args} {
set state(sock) $sock
Finish $token "" 1
cleanup $token
- return -code error $sock
+ dict unset errdict -level
+ return -options $errdict $sock
}
}
set state(sock) $sock
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index d3fc7af..3324af9 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
-package ifneeded http 2.8.12 [list tclPkgSetup $dir http 2.8.12 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.8.13 [list tclPkgSetup $dir http 2.8.13 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 0d2f928..12030fb 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -1317,33 +1317,33 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
interp bgerror {} $bgerrorsaved
- # Tests msgcat-15.*: [mcutil]
+ # Tests msgcat-18.*: [mcutil]
- test msgcat-15.1 {mcutil - no argument} -body {
+ test msgcat-18.1 {mcutil - no argument} -body {
mcutil
} -returnCodes 1\
-result {wrong # args: should be "mcutil subcommand ?arg ...?"}
- test msgcat-15.2 {mcutil - wrong argument} -body {
+ test msgcat-18.2 {mcutil - wrong argument} -body {
mcutil junk
} -returnCodes 1\
-result {unknown subcommand "junk": must be getpreferences, or getsystemlocale}
- test msgcat-15.3 {mcutil - partial argument} -body {
+ test msgcat-18.3 {mcutil - partial argument} -body {
mcutil getsystem
} -returnCodes 1\
-result {unknown subcommand "getsystem": must be getpreferences, or getsystemlocale}
- test msgcat-15.4 {mcutil getpreferences - no argument} -body {
+ test msgcat-18.4 {mcutil getpreferences - no argument} -body {
mcutil getpreferences
} -returnCodes 1\
-result {wrong # args: should be "mcutil getpreferences locale"}
- test msgcat-15.5 {mcutil getpreferences - DE_de} -body {
+ test msgcat-18.5 {mcutil getpreferences - DE_de} -body {
mcutil getpreferences DE_de
} -result {de_de de {}}
- test msgcat-15.6 {mcutil getsystemlocale - wrong argument} -body {
+ test msgcat-18.6 {mcutil getsystemlocale - wrong argument} -body {
mcutil getsystemlocale DE_de
} -returnCodes 1\
-result {wrong # args: should be "mcutil getsystemlocale"}
@@ -1351,7 +1351,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
# The result is system dependent
# So just test if it runs
# The environment variable version was test with test 0.x
- test msgcat-15.7 {mcutil getsystemlocale} -body {
+ test msgcat-18.7 {mcutil getsystemlocale} -body {
mcutil getsystemlocale
set ok ok
} -result {ok}
diff --git a/tests/var.test b/tests/var.test
index 6ac3e52..2bf671a 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -820,6 +820,18 @@ test var-17.1 {TclArraySet [Bug 1669489]} -setup {
} -cleanup {
unset -nocomplain ::a ::elements
} -result {}
+test var-17.2 {TclArraySet Dict shortcut only on pure value} -setup {
+ unset -nocomplain a d
+ set d {p 1 p 2}
+ dict get $d p
+ set foo 0
+} -body {
+ trace add variable a write "[list incr [namespace which -variable foo]];#"
+ array set a $d
+ set foo
+} -cleanup {
+ unset -nocomplain a d foo
+} -result 2
test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
set already 0
@@ -931,6 +943,28 @@ test var-20.9 {[bc1a96407a] array set compiled w/ trace} -setup {
test var-20.10 {[bc1a96407a] array set don't compile bad varname} -body {
apply {{} {set name foo(bar); array set $name {a 1}}}
} -returnCodes error -match glob -result *
+test var-20.11 {array set don't compile bad initializer} -setup {
+ unset -nocomplain foo
+ trace add variable foo array {set foo(bar) baz;#}
+} -body {
+ catch {array set foo bad}
+ set foo(bar)
+} -cleanup {
+ unset -nocomplain foo
+} -result baz
+test var-20.12 {array set don't compile bad initializer} -setup {
+ unset -nocomplain ::foo
+ trace add variable ::foo array {set ::foo(bar) baz;#}
+} -body {
+ catch {apply {{} {
+ set value bad
+ array set ::foo $value
+
+ }}}
+ set ::foo(bar)
+} -cleanup {
+ unset -nocomplain ::foo
+} -result baz
test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
proc linenumber {} {dict get [info frame -1] line}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 83a8aed..51c06e5 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -844,8 +844,8 @@ install-libraries: libraries
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
done;
- @echo "Installing package http 2.8.12 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.12.tm;
+ @echo "Installing package http 2.8.13 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.13.tm;
@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
@for i in $(TOP_DIR)/library/opt/*.tcl ; \
do \
diff --git a/win/Makefile.in b/win/Makefile.in
index 56ccb4d..6326075 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -653,8 +653,8 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
done;
- @echo "Installing package http 2.8.12 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.12.tm;
+ @echo "Installing package http 2.8.13 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.13.tm;
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \