summaryrefslogtreecommitdiff
path: root/itcl/itcl/generic/itcl_util.c
diff options
context:
space:
mode:
Diffstat (limited to 'itcl/itcl/generic/itcl_util.c')
-rw-r--r--itcl/itcl/generic/itcl_util.c101
1 files changed, 55 insertions, 46 deletions
diff --git a/itcl/itcl/generic/itcl_util.c b/itcl/itcl/generic/itcl_util.c
index 40c7803ee11..64cef44be51 100644
--- a/itcl/itcl/generic/itcl_util.c
+++ b/itcl/itcl/generic/itcl_util.c
@@ -82,15 +82,12 @@ typedef struct InterpState {
void
Itcl_Assert(testExpr, fileName, lineNumber)
- char *testExpr; /* string representing test expression */
- char *fileName; /* file name containing this call */
- int lineNumber; /* line number containing this call */
+ CONST char *testExpr; /* string representing test expression */
+ CONST char *fileName; /* file name containing this call */
+ int lineNumber; /* line number containing this call */
{
-#ifndef NDEBUG
- fprintf(stderr, "Assertion failed: \"%s\" (line %d of %s)",
- testExpr, lineNumber, fileName);
- abort();
-#endif
+ Tcl_Panic("Itcl Assertion failed: \"%s\" (line %d of %s)",
+ testExpr, lineNumber, fileName);
}
@@ -699,7 +696,7 @@ Itcl_ReleaseData(cdata)
}
if (!entry) {
Tcl_MutexUnlock(&ItclPreservedListLock);
- panic("Itcl_ReleaseData can't find reference for 0x%x", cdata);
+ Tcl_Panic("Itcl_ReleaseData can't find reference for 0x%x", cdata);
}
/*
@@ -751,7 +748,11 @@ Itcl_SaveInterpState(interp, status)
Interp *iPtr = (Interp*)interp;
InterpState *info;
- char *val;
+ CONST char *val;
+
+#ifndef ERR_IN_PROGRESS /* this disappeared in 8.5a2 */
+ return (Itcl_InterpState) Tcl_SaveInterpState(interp, status);
+#endif
info = (InterpState*)ckalloc(sizeof(InterpState));
info->validate = TCL_STATE_VALID;
@@ -770,7 +771,11 @@ Itcl_SaveInterpState(interp, status)
/*
* If an error is in progress, preserve its state.
*/
+#ifdef ERR_IN_PROGRESS /* this disappeared in 8.5a2 */
if ((iPtr->flags & ERR_IN_PROGRESS) != 0) {
+#else
+ if (iPtr->errorInfo != NULL) {
+#endif
val = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
if (val) {
info->errorInfo = ckalloc((unsigned)(strlen(val)+1));
@@ -811,12 +816,15 @@ Itcl_RestoreInterpState(interp, state)
Tcl_Interp* interp; /* interpreter being modified */
Itcl_InterpState state; /* token representing interpreter state */
{
- Interp *iPtr = (Interp*)interp;
InterpState *info = (InterpState*)state;
int status;
+#ifndef ERR_IN_PROGRESS /* this disappeared in 8.5a2 */
+ return Tcl_RestoreInterpState(interp, (Tcl_InterpState)state);
+#endif
+
if (info->validate != TCL_STATE_VALID) {
- panic("bad token in Itcl_RestoreInterpState");
+ Tcl_Panic("bad token in Itcl_RestoreInterpState");
}
Tcl_ResetResult(interp);
@@ -832,10 +840,7 @@ Itcl_RestoreInterpState(interp, state)
}
if (info->errorCode) {
- (void) Tcl_SetVar2(interp, "errorCode", (char*)NULL,
- info->errorCode, TCL_GLOBAL_ONLY);
- iPtr->flags |= ERROR_CODE_SET;
-
+ Tcl_SetObjErrorCode(interp, Tcl_NewStringObj(info->errorCode, -1));
ckfree(info->errorCode);
}
@@ -871,8 +876,13 @@ Itcl_DiscardInterpState(state)
{
InterpState *info = (InterpState*)state;
+#ifndef ERR_IN_PROGRESS /* this disappeared in 8.5a2 */
+ Tcl_DiscardInterpState((Tcl_InterpState)state);
+ return;
+#endif
+
if (info->validate != TCL_STATE_VALID) {
- panic("bad token in Itcl_DiscardInterpState");
+ Tcl_Panic("bad token in Itcl_DiscardInterpState");
}
if (info->errorInfo) {
@@ -1149,12 +1159,12 @@ Itcl_GetTrueNamespace(interp, info)
*/
void
Itcl_ParseNamespPath(name, buffer, head, tail)
- char *name; /* path name to class member */
+ CONST char *name; /* path name to class member */
Tcl_DString *buffer; /* dynamic string buffer (uninitialized) */
char **head; /* returns "namesp::namesp::namesp" part */
char **tail; /* returns "element" part */
{
- register char *sep;
+ register char *sep, *newname;
Tcl_DStringInit(buffer);
@@ -1164,12 +1174,12 @@ Itcl_ParseNamespPath(name, buffer, head, tail)
* scope qualifier.
*/
Tcl_DStringAppend(buffer, name, -1);
- name = Tcl_DStringValue(buffer);
+ newname = Tcl_DStringValue(buffer);
- for (sep=name; *sep != '\0'; sep++)
+ for (sep=newname; *sep != '\0'; sep++)
;
- while (--sep > name) {
+ while (--sep > newname) {
if (*sep == ':' && *(sep-1) == ':') {
break;
}
@@ -1180,20 +1190,20 @@ Itcl_ParseNamespPath(name, buffer, head, tail)
* up until the head is found. This supports the Tcl namespace
* behavior, which allows names like "foo:::bar".
*/
- if (sep > name) {
+ if (sep > newname) {
*tail = sep+1;
- while (sep > name && *(sep-1) == ':') {
+ while (sep > newname && *(sep-1) == ':') {
sep--;
}
*sep = '\0';
- *head = name;
+ *head = newname;
}
/*
* No :: separators--the whole name is treated as a tail.
*/
else {
- *tail = name;
+ *tail = newname;
*head = NULL;
}
}
@@ -1218,19 +1228,21 @@ Itcl_ParseNamespPath(name, buffer, head, tail)
*/
int
Itcl_DecodeScopedCommand(interp, name, rNsPtr, rCmdPtr)
- Tcl_Interp *interp; /* current interpreter */
- char *name; /* string to be decoded */
- Tcl_Namespace **rNsPtr; /* returns: namespace for scoped value */
- char **rCmdPtr; /* returns: simple command word */
+ Tcl_Interp *interp; /* current interpreter */
+ CONST char *name; /* string to be decoded */
+ Tcl_Namespace **rNsPtr; /* returns: namespace for scoped value */
+ char **rCmdPtr; /* returns: simple command word */
{
Tcl_Namespace *nsPtr = NULL;
- char *cmdName = name;
+ char *cmdName;
int len = strlen(name);
-
- char *pos;
+ CONST char *pos;
int listc, result;
char **listv;
+ cmdName = ckalloc((unsigned)strlen(name)+1);
+ strcpy(cmdName, name);
+
if ((*name == 'n') && (len > 17) && (strncmp(name, "namespace", 9) == 0)) {
for (pos = (name + 9); (*pos == ' '); pos++) {
/* empty body: skip over spaces */
@@ -1238,7 +1250,8 @@ Itcl_DecodeScopedCommand(interp, name, rNsPtr, rCmdPtr)
if ((*pos == 'i') && ((pos + 7) <= (name + len))
&& (strncmp(pos, "inscope", 7) == 0)) {
- result = Tcl_SplitList(interp, name, &listc, &listv);
+ result = Tcl_SplitList(interp, (CONST84 char *)name, &listc,
+ &listv);
if (result == TCL_OK) {
if (listc != 4) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -1246,15 +1259,14 @@ Itcl_DecodeScopedCommand(interp, name, rNsPtr, rCmdPtr)
"namespace inscope namesp command\"",
(char*)NULL);
result = TCL_ERROR;
- }
- else {
+ } else {
nsPtr = Tcl_FindNamespace(interp, listv[2],
(Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
if (!nsPtr) {
result = TCL_ERROR;
- }
- else {
+ } else {
+ ckfree(cmdName);
cmdName = ckalloc((unsigned)(strlen(listv[3])+1));
strcpy(cmdName, listv[3]);
}
@@ -1313,7 +1325,7 @@ Itcl_EvalArgs(interp, objc, objv)
cmdPtr = (Command*)cmd;
cmdlinec = objc;
- cmdlinev = (Tcl_Obj**)objv;
+ cmdlinev = (Tcl_Obj **) objv;
/*
* If the command is still not found, handle it with the
@@ -1327,16 +1339,13 @@ Itcl_EvalArgs(interp, objc, objv)
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"invalid command name \"",
- Tcl_GetStringFromObj(objv[0], (int*)NULL), "\"",
- (char*)NULL);
+ Tcl_GetStringFromObj(objv[0], NULL), "\"", NULL);
return TCL_ERROR;
}
cmdPtr = (Command*)cmd;
cmdlinePtr = Itcl_CreateArgs(interp, "unknown", objc, objv);
-
- (void) Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
- &cmdlinec, &cmdlinev);
+ Tcl_ListObjGetElements(NULL, cmdlinePtr, &cmdlinec, &cmdlinev);
}
/*
@@ -1373,7 +1382,7 @@ Itcl_EvalArgs(interp, objc, objv)
Tcl_Obj*
Itcl_CreateArgs(interp, string, objc, objv)
Tcl_Interp *interp; /* current interpreter */
- char *string; /* first command word */
+ CONST char *string; /* first command word */
int objc; /* number of arguments */
Tcl_Obj *CONST objv[]; /* argument objects */
{
@@ -1382,7 +1391,7 @@ Itcl_CreateArgs(interp, string, objc, objv)
listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
- Tcl_NewStringObj(string, -1));
+ Tcl_NewStringObj((CONST84 char *)string, -1));
for (i=0; i < objc; i++) {
Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objv[i]);
View Lorry Controller Status