diff options
author | Keith Seitz <keiths@redhat.com> | 2008-07-22 20:39:42 +0000 |
---|---|---|
committer | Keith Seitz <keiths@redhat.com> | 2008-07-22 20:39:42 +0000 |
commit | 24af8de1062fda6b0c35651e8b0b9860e3f2ddbd (patch) | |
tree | 46ea83d88a2ce5f019f728543106bec210325004 /itcl/itcl/generic/itcl_util.c | |
parent | 5601295b75f82401817b35387a9843a18a9ae357 (diff) | |
download | gdb-24af8de1062fda6b0c35651e8b0b9860e3f2ddbd.tar.gz |
imported Itcl 3.3ITCL_3_3
Diffstat (limited to 'itcl/itcl/generic/itcl_util.c')
-rw-r--r-- | itcl/itcl/generic/itcl_util.c | 101 |
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]); |