| ︙ | | |
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
|
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
|
-
-
+
|
static int
NotArrayError(
Tcl_Interp *interp,
Tcl_Obj *name)
{
const char *nameStr = TclGetString(name);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't an array", nameStr));
TclPrintfResult(interp, "\"%s\" isn't an array", nameStr);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, (char *)NULL);
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | | |
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
|
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
|
-
+
-
+
|
if (!(arrayPtr != NULL
? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
: (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
|| (varFramePtr == NULL)
|| !HasLocalVars(varFramePtr)
|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
TclPrintfResult((Tcl_Interp *) iPtr,
"bad variable name \"%s\": can't create namespace "
"variable that refers to procedure variable",
TclGetString(myNamePtr)));
TclGetString(myNamePtr));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", (char *)NULL);
return TCL_ERROR;
}
}
return TclPtrObjMakeUpvarIdx(interp, otherPtr, myNamePtr, myFlags, index);
}
|
| ︙ | | |
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
|
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
|
-
+
-
+
|
if (p != NULL) {
p += strlen(p)-1;
if (*p == ')') {
/*
* myName looks like an array reference.
*/
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
TclPrintfResult((Tcl_Interp *) iPtr,
"bad variable name \"%s\": can't create a scalar "
"variable that looks like an array element", myName));
"variable that looks like an array element", myName);
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
(char *)NULL);
return TCL_ERROR;
}
}
/*
|
| ︙ | | |
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
|
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
|
-
-
+
+
-
-
+
+
|
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj(
"can't upvar from variable to itself", -1));
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", (char *)NULL);
return TCL_ERROR;
}
if (TclIsVarTraced(varPtr)) {
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
"variable \"%s\" has traces: can't use for upvar", myName));
TclPrintfResult((Tcl_Interp *) iPtr,
"variable \"%s\" has traces: can't use for upvar", myName);
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", (char *)NULL);
return TCL_ERROR;
} else if (!TclIsVarUndefined(varPtr)) {
Var *linkPtr;
/*
* The variable already existed. Make sure this variable "varPtr"
* isn't the same as "otherPtr" (avoid circular links). Also, if it's
* not an upvar then it's an error. If it is an upvar, then just
* disconnect it from the thing it currently refers to.
*/
if (!TclIsVarLink(varPtr)) {
Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
"variable \"%s\" already exists", myName));
TclPrintfResult((Tcl_Interp *) iPtr,
"variable \"%s\" already exists", myName);
Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", (char *)NULL);
return TCL_ERROR;
}
linkPtr = varPtr->value.linkPtr;
if (linkPtr == otherPtr) {
return TCL_OK;
|
| ︙ | | |
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
|
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
|
-
-
+
|
}
if ((result == 0) && hasLevel) {
/*
* Synthesize an error message since TclObjGetFrame doesn't do this
* for this particular case.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad level \"%s\"", TclGetString(levelObj)));
TclPrintfResult(interp, "bad level \"%s\"", TclGetString(levelObj));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
TclGetString(levelObj), (char *)NULL);
return TCL_ERROR;
}
/*
* We've now finished with parsing levels; skip to the variable names.
|
| ︙ | | |
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
|
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
|
-
-
+
-
+
-
+
-
-
+
|
return searchPtr;
}
}
}
if ((handle[0] != 's') || (handle[1] != '-')
|| (strtoul(handle + 2, &end, 10), end == (handle + 2))
|| (*end != '-')) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"illegal search identifier \"%s\"", handle));
TclPrintfResult(interp, "illegal search identifier \"%s\"", handle);
} else if (strcmp(end + 1, TclGetString(varNamePtr)) != 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
TclPrintfResult(interp,
"search identifier \"%s\" isn't for variable \"%s\"",
handle, TclGetString(varNamePtr)));
handle, TclGetString(varNamePtr));
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't find search \"%s\"", handle));
TclPrintfResult(interp, "couldn't find search \"%s\"", handle);
}
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", handle, (char *)NULL);
return NULL;
}
/*
*----------------------------------------------------------------------
|
| ︙ | | |
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
|
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
|
-
+
-
+
|
{
if (!part1Ptr) {
if (index == -1) {
Tcl_Panic("invalid part1Ptr and invalid index together");
}
part1Ptr = localName(((Interp *)interp)->varFramePtr, index);
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't %s \"%s%s%s%s\": %s",
TclPrintfResult(interp, "can't %s \"%s%s%s%s\": %s",
operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""),
(part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""),
reason));
reason);
}
/*
*----------------------------------------------------------------------
*
* Internal functions for variable name object types --
*
|
| ︙ | | |
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
|
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
|
-
-
+
|
varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr);
}
}
if (simpleName != name) {
Tcl_DecrRefCount(simpleNamePtr);
}
if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown variable \"%s\"", name));
TclPrintfResult(interp, "unknown variable \"%s\"", name);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, (char *)NULL);
}
return (Tcl_Var) varPtr;
}
/*
*----------------------------------------------------------------------
|
| ︙ | | |