diff options
Diffstat (limited to 'itcl/itcl/generic/itcl_cmds.c')
| -rw-r--r-- | itcl/itcl/generic/itcl_cmds.c | 50 |
1 files changed, 38 insertions, 12 deletions
diff --git a/itcl/itcl/generic/itcl_cmds.c b/itcl/itcl/generic/itcl_cmds.c index 773e3098af1..dff4a46890f 100644 --- a/itcl/itcl/generic/itcl_cmds.c +++ b/itcl/itcl/generic/itcl_cmds.c @@ -103,6 +103,9 @@ static char safeInitScript[] = extern ItclStubs itclStubs; + +int itclCompatFlags = -1; + /* * ------------------------------------------------------------------------ @@ -140,6 +143,26 @@ Initialize(interp) } /* + * Set the compatability options. Stubs allows us to load into many + * version of the Tcl core. Some problems have crept-in, and we need + * to adapt dynamically regarding use of some internal structures that + * have changed since 8.1.0 + * + * TODO: make a TIP for exporting a Tcl_CommandIsDeleted function in the core. + */ + if (itclCompatFlags == -1) { + int maj, min, ptch, type; + + itclCompatFlags = 0; + Tcl_GetVersion(&maj, &min, &ptch, &type); + + if ((maj == 8) && (min >= 4)) { + itclCompatFlags = ITCL_COMPAT_USECMDFLAGS; + } + } + + + /* * Initialize the ensemble package first, since we need this * for other parts of [incr Tcl]. */ @@ -392,7 +415,15 @@ ItclDelObjectInfo(cdata) while (entry) { contextObj = (ItclObject*)Tcl_GetHashValue(entry); Tcl_DeleteCommandFromToken(info->interp, contextObj->accessCmd); - entry = Tcl_NextHashEntry(&place); + /* + * Fix 227804: Whenever an object to delete was found we + * have to reset the search to the beginning as the + * current entry in the search was deleted and accessing it + * is therefore not allowed anymore. + */ + + entry = Tcl_FirstHashEntry(&info->objects, &place); + /*entry = Tcl_NextHashEntry(&place);*/ } Tcl_DeleteHashTable(&info->objects); @@ -438,8 +469,8 @@ Itcl_FindClassesCmd(clientData, interp, objc, objv) int forceFullNames = 0; char *pattern; - char *name; - int i, newEntry, handledActiveNs; + CONST char *name; + int newEntry, handledActiveNs; Tcl_HashTable unique; Tcl_HashEntry *entry; Tcl_HashSearch place; @@ -568,7 +599,8 @@ Itcl_FindObjectsCmd(clientData, interp, objc, objv) ItclClass *isaDefn = NULL; char *name, *token; - int i, pos, newEntry, match, handledActiveNs; + CONST char *cmdName; + int pos, newEntry, match, handledActiveNs; ItclObject *contextObj; Tcl_HashTable unique; Tcl_HashEntry *entry; @@ -679,8 +711,8 @@ Itcl_FindObjectsCmd(clientData, interp, objc, objv) Tcl_GetCommandFullName(interp, cmd, objPtr); name = Tcl_GetStringFromObj(objPtr, (int*)NULL); } else { - name = Tcl_GetCommandName(interp, cmd); - objPtr = Tcl_NewStringObj(name, -1); + cmdName = Tcl_GetCommandName(interp, cmd); + objPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_CreateHashEntry(&unique, (char*)cmd, &newEntry); @@ -772,13 +804,7 @@ Itcl_ProtectionCmd(clientData, interp, objc, objv) oldLevel = Itcl_Protection(interp, pLevel); if (objc == 2) { - /* CYGNUS LOCAL - Fix for 8.1 */ -#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 - result = Tcl_EvalObj(interp, objv[1], 0); -#else result = Tcl_EvalObj(interp, objv[1]); -#endif - /* END CYGNUS LOCAL */ } else { result = Itcl_EvalArgs(interp, objc-1, objv+1); } |