diff options
| -rw-r--r-- | ChangeLog | 3 | ||||
| -rw-r--r-- | generic/tclInterp.c | 161 | ||||
| -rw-r--r-- | generic/tclListObj.c | 6 | ||||
| -rw-r--r-- | generic/tclLoad.c | 36 |
4 files changed, 122 insertions, 84 deletions
@@ -1,5 +1,8 @@ 2011-04-02 Donal K. Fellows <dkf@users.sf.net> + * generic/tclInterp.c, generic/tclListObj.c, generic/tclLoad.c: + More generation of errorCodes ([interp], [lset], [load], [unload]). + * generic/tclEvent.c, generic/tclFileName.c: More generation of errorCode information (default [bgerror] and [glob]). diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 67761ed..a156a57 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -300,8 +300,8 @@ Tcl_Init( { if (tclPreInitScript != NULL) { if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { - return (TCL_ERROR); - }; + return TCL_ERROR; + } } /* @@ -559,6 +559,7 @@ Tcl_InterpObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + Tcl_Interp *slaveInterp; int index; static const char *const options[] = { "alias", "aliases", "bgerror", "cancel", @@ -588,7 +589,7 @@ Tcl_InterpObjCmd( } switch ((enum option) index) { case OPT_ALIAS: { - Tcl_Interp *slaveInterp, *masterInterp; + Tcl_Interp *masterInterp; if (objc < 4) { aliasArgs: @@ -622,18 +623,13 @@ Tcl_InterpObjCmd( } goto aliasArgs; } - case OPT_ALIASES: { - Tcl_Interp *slaveInterp; - + case OPT_ALIASES: slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { return TCL_ERROR; } return AliasList(interp, slaveInterp); - } - case OPT_BGERROR: { - Tcl_Interp *slaveInterp; - + case OPT_BGERROR: if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?"); return TCL_ERROR; @@ -643,10 +639,8 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3); - } case OPT_CANCEL: { int i, flags; - Tcl_Interp *slaveInterp; Tcl_Obj *resultObjPtr; static const char *const cancelOptions[] = { "-unwind", "--", NULL @@ -680,8 +674,7 @@ Tcl_InterpObjCmd( } } - endOfForLoop: - + endOfForLoop: if ((i + 2) < objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? ?--? ?path? ?result?"); @@ -689,35 +682,34 @@ Tcl_InterpObjCmd( } /* - * Did they specify a slave interp to cancel the script in - * progress in? If not, use the current interp. + * Did they specify a slave interp to cancel the script in progress + * in? If not, use the current interp. */ if (i < objc) { slaveInterp = GetInterp(interp, objv[i]); + if (slaveInterp == NULL) { + return TCL_ERROR; + } i++; } else { slaveInterp = interp; } - if (slaveInterp != NULL) { - if (i < objc) { - resultObjPtr = objv[i]; - - /* - * Tcl_CancelEval removes this reference. - */ + if (i < objc) { + resultObjPtr = objv[i]; - Tcl_IncrRefCount(resultObjPtr); - i++; - } else { - resultObjPtr = NULL; - } + /* + * Tcl_CancelEval removes this reference. + */ - return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags); + Tcl_IncrRefCount(resultObjPtr); + i++; } else { - return TCL_ERROR; + resultObjPtr = NULL; } + + return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags); } case OPT_CREATE: { int i, last, safe; @@ -787,13 +779,11 @@ Tcl_InterpObjCmd( Tcl_SetObjResult(interp, slavePtr); return TCL_OK; } - case OPT_DEBUG: { - /* TIP #378 */ - Tcl_Interp *slaveInterp; - + case OPT_DEBUG: /* TIP #378 */ /* * Currently only -frame supported, otherwise ?-option ?value?? */ + if (objc < 3 || objc > 5) { Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??"); return TCL_ERROR; @@ -803,11 +793,9 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3); - } case OPT_DELETE: { int i; InterpInfo *iiPtr; - Tcl_Interp *slaveInterp; for (i = 2; i < objc; i++) { slaveInterp = GetInterp(interp, objv[i]); @@ -816,6 +804,8 @@ Tcl_InterpObjCmd( } else if (slaveInterp == interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot delete the current interpreter", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "DELETESELF", NULL); return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo; @@ -824,9 +814,7 @@ Tcl_InterpObjCmd( } return TCL_OK; } - case OPT_EVAL: { - Tcl_Interp *slaveInterp; - + case OPT_EVAL: if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?"); return TCL_ERROR; @@ -836,12 +824,9 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveEval(interp, slaveInterp, objc - 3, objv + 3); - } case OPT_EXISTS: { - int exists; - Tcl_Interp *slaveInterp; + int exists = 1; - exists = 1; slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { if (objc > 3) { @@ -853,9 +838,7 @@ Tcl_InterpObjCmd( Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists)); return TCL_OK; } - case OPT_EXPOSE: { - Tcl_Interp *slaveInterp; - + case OPT_EXPOSE: if ((objc < 4) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?"); return TCL_ERROR; @@ -865,10 +848,7 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3); - } - case OPT_HIDE: { - Tcl_Interp *slaveInterp; /* A slave. */ - + case OPT_HIDE: if ((objc < 4) || (objc > 5)) { Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?"); return TCL_ERROR; @@ -878,30 +858,22 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveHide(interp, slaveInterp, objc - 3, objv + 3); - } - case OPT_HIDDEN: { - Tcl_Interp *slaveInterp; /* A slave. */ - + case OPT_HIDDEN: slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { return TCL_ERROR; } return SlaveHidden(interp, slaveInterp); - } - case OPT_ISSAFE: { - Tcl_Interp *slaveInterp; - + case OPT_ISSAFE: slaveInterp = GetInterp2(interp, objc, objv); if (slaveInterp == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp))); return TCL_OK; - } case OPT_INVOKEHID: { int i; const char *namespaceName; - Tcl_Interp *slaveInterp; static const char *const hiddenOptions[] = { "-global", "-namespace", "--", NULL }; @@ -944,7 +916,6 @@ Tcl_InterpObjCmd( objv + i); } case OPT_LIMIT: { - Tcl_Interp *slaveInterp; static const char *const limitTypes[] = { "commands", "time", NULL }; @@ -973,9 +944,7 @@ Tcl_InterpObjCmd( return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv); } } - case OPT_MARKTRUSTED: { - Tcl_Interp *slaveInterp; - + case OPT_MARKTRUSTED: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; @@ -985,10 +954,7 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveMarkTrusted(interp, slaveInterp); - } - case OPT_RECLIMIT: { - Tcl_Interp *slaveInterp; - + case OPT_RECLIMIT: if (objc != 3 && objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?"); return TCL_ERROR; @@ -998,9 +964,7 @@ Tcl_InterpObjCmd( return TCL_ERROR; } return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3); - } case OPT_SLAVES: { - Tcl_Interp *slaveInterp; InterpInfo *iiPtr; Tcl_Obj *resultPtr; Tcl_HashEntry *hPtr; @@ -1024,8 +988,7 @@ Tcl_InterpObjCmd( } case OPT_TRANSFER: case OPT_SHARE: { - Tcl_Interp *slaveInterp; /* A slave. */ - Tcl_Interp *masterInterp; /* Its master. */ + Tcl_Interp *masterInterp; /* The master of the slave. */ Tcl_Channel chan; if (objc != 5) { @@ -1060,7 +1023,6 @@ Tcl_InterpObjCmd( return TCL_OK; } case OPT_TARGET: { - Tcl_Interp *slaveInterp; InterpInfo *iiPtr; Tcl_HashEntry *hPtr; Alias *aliasPtr; @@ -1093,6 +1055,8 @@ Tcl_InterpObjCmd( Tcl_AppendResult(interp, "target interpreter for alias \"", aliasName, "\" in path \"", Tcl_GetString(objv[2]), "\" is not my descendant", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "TARGETSHROUDED", NULL); return TCL_ERROR; } return TCL_OK; @@ -1437,6 +1401,8 @@ TclPreventAliasLoop( Tcl_AppendResult(interp, "cannot define or rename alias \"", Tcl_GetCommandName(cmdInterp, cmd), "\": would create a loop", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "ALIASLOOP", NULL); return TCL_ERROR; } @@ -2292,6 +2258,8 @@ SlaveBgerror( || (length < 1)) { Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "BGERRORFORMAT", NULL); return TCL_ERROR; } TclSetBgErrorHandler(slaveInterp, objv[0]); @@ -2728,8 +2696,8 @@ SlaveDebugCmd( Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME)); Tcl_SetObjResult(interp, resultPtr); } else { - if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, - "debug option", 0, &debugType) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, "debug option", + 0, &debugType) != TCL_OK) { return TCL_ERROR; } if (debugType == DEBUG_TYPE_FRAME) { @@ -2738,11 +2706,13 @@ SlaveDebugCmd( != TCL_OK) { return TCL_ERROR; } + /* - * Quietly ignore attempts to disable interp debugging. - * This is a one-way switch as frame debug info is maintained - * in a stack that must be consistent once turned on. + * Quietly ignore attempts to disable interp debugging. This + * is a one-way switch as frame debug info is maintained in a + * stack that must be consistent once turned on. */ + if (debugType) { iPtr->flags |= INTERP_DEBUG_FRAME; } @@ -2847,6 +2817,8 @@ SlaveExpose( Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot expose commands", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", + NULL); return TCL_ERROR; } @@ -2890,6 +2862,8 @@ SlaveRecursionLimit( if (Tcl_IsSafe(interp)) { Tcl_AppendResult(interp, "permission denied: " "safe interpreters cannot change recursion limit", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", + NULL); return TCL_ERROR; } if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { @@ -2898,6 +2872,8 @@ SlaveRecursionLimit( if (limit <= 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "recursion limit must be > 0", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT", + NULL); return TCL_ERROR; } Tcl_SetRecursionLimit(slaveInterp, limit); @@ -2905,6 +2881,7 @@ SlaveRecursionLimit( if (interp == slaveInterp && iPtr->numLevels > limit) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "falling back due to new recursion limit", -1)); + Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, objv[0]); @@ -2946,6 +2923,8 @@ SlaveHide( Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot hide commands", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", + NULL); return TCL_ERROR; } @@ -3028,6 +3007,8 @@ SlaveInvokeHidden( Tcl_SetObjResult(interp, Tcl_NewStringObj( "not allowed to invoke hidden commands from safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", + NULL); return TCL_ERROR; } @@ -3082,6 +3063,8 @@ SlaveMarkTrusted( Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot mark trusted", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", + NULL); return TCL_ERROR; } ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP; @@ -3339,6 +3322,7 @@ Tcl_LimitCheck( } else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "command count limit exceeded", NULL); + Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL); Tcl_Release(interp); return TCL_ERROR; } @@ -3364,6 +3348,7 @@ Tcl_LimitCheck( } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "time limit exceeded", NULL); + Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL); Tcl_Release(interp); return TCL_ERROR; } @@ -4429,8 +4414,7 @@ SlaveCommandLimitCmd( } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { - Tcl_WrongNumArgs(interp, consumedObjc, objv, - "?-option value ...?"); + Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { int i, scriptLen = 0, limitLen = 0; @@ -4455,6 +4439,8 @@ SlaveCommandLimitCmd( if (gran < 1) { Tcl_AppendResult(interp, "granularity must be at " "least 1", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "BADVALUE", NULL); return TCL_ERROR; } break; @@ -4470,6 +4456,8 @@ SlaveCommandLimitCmd( if (limit < 0) { Tcl_AppendResult(interp, "command limit value must be at " "least 0", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "BADVALUE", NULL); return TCL_ERROR; } break; @@ -4617,8 +4605,7 @@ SlaveTimeLimitCmd( } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { - Tcl_WrongNumArgs(interp, consumedObjc, objv, - "?-option value ...?"); + Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { int i, scriptLen = 0, milliLen = 0, secLen = 0; @@ -4647,6 +4634,8 @@ SlaveTimeLimitCmd( if (gran < 1) { Tcl_AppendResult(interp, "granularity must be at " "least 1", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "BADVALUE", NULL); return TCL_ERROR; } break; @@ -4662,6 +4651,8 @@ SlaveTimeLimitCmd( if (tmp < 0) { Tcl_AppendResult(interp, "milliseconds must be at least 0", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "BADVALUE", NULL); return TCL_ERROR; } limitMoment.usec = ((long)tmp)*1000; @@ -4678,6 +4669,8 @@ SlaveTimeLimitCmd( if (tmp < 0) { Tcl_AppendResult(interp, "seconds must be at least 0", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "BADVALUE", NULL); return TCL_ERROR; } limitMoment.sec = tmp; @@ -4694,11 +4687,15 @@ SlaveTimeLimitCmd( if (secObj != NULL && secLen == 0 && milliLen > 0) { Tcl_AppendResult(interp, "may only set -milliseconds " "if -seconds is not also being reset", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "BADUSAGE", NULL); return TCL_ERROR; } if (milliLen == 0 && (secObj == NULL || secLen > 0)) { Tcl_AppendResult(interp, "may only reset -milliseconds " "if -seconds is also being reset", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", + "BADUSAGE", NULL); return TCL_ERROR; } } diff --git a/generic/tclListObj.c b/generic/tclListObj.c index b27163d..9128333 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1339,6 +1339,8 @@ TclLsetFlat( /* ...the index points outside the sublist. */ Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", + NULL); break; } @@ -1511,6 +1513,8 @@ TclListObjSetElement( if (!length) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", + NULL); return TCL_ERROR; } result = SetListFromAny(interp, listPtr); @@ -1531,6 +1535,8 @@ TclListObjSetElement( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", + NULL); } return TCL_ERROR; } diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 371a437..707d6ec 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -160,6 +160,8 @@ Tcl_LoadObjCmd( Tcl_SetResult(interp, "must specify either file name or package name", TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY", + NULL); code = TCL_ERROR; goto done; } @@ -226,6 +228,8 @@ Tcl_LoadObjCmd( Tcl_AppendResult(interp, "file \"", fullFileName, "\" is already loaded for package \"", pkgPtr->packageName, "\"", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", + "SPLITPERSONALITY", NULL); code = TCL_ERROR; Tcl_MutexUnlock(&packageMutex); goto done; @@ -261,6 +265,8 @@ Tcl_LoadObjCmd( if (fullFileName[0] == 0) { Tcl_AppendResult(interp, "package \"", packageName, "\" isn't loaded statically", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC", + NULL); code = TCL_ERROR; goto done; } @@ -312,6 +318,8 @@ Tcl_LoadObjCmd( Tcl_AppendResult(interp, "couldn't figure out package name for ", fullFileName, NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", + "WHATPACKAGE", NULL); code = TCL_ERROR; goto done; } @@ -407,11 +415,22 @@ Tcl_LoadObjCmd( Tcl_AppendResult(interp, "can't use package in a safe interpreter: no ", pkgPtr->packageName, "_SafeInit procedure", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE", + NULL); code = TCL_ERROR; goto done; } code = pkgPtr->safeInitProc(target); } else { + if (pkgPtr->initProc == NULL) { + Tcl_AppendResult(interp, + "can't attach package to interpreter: no ", + pkgPtr->packageName, "_Init procedure", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT", + NULL); + code = TCL_ERROR; + goto done; + } code = pkgPtr->initProc(target); } @@ -555,6 +574,8 @@ Tcl_UnloadObjCmd( Tcl_SetResult(interp, "must specify either file name or package name", TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY", + NULL); code = TCL_ERROR; goto done; } @@ -626,6 +647,8 @@ Tcl_UnloadObjCmd( Tcl_AppendResult(interp, "package \"", packageName, "\" is loaded statically and cannot be unloaded", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC", + NULL); code = TCL_ERROR; goto done; } @@ -636,6 +659,8 @@ Tcl_UnloadObjCmd( Tcl_AppendResult(interp, "file \"", fullFileName, "\" has never been loaded", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", + NULL); code = TCL_ERROR; goto done; } @@ -663,6 +688,8 @@ Tcl_UnloadObjCmd( Tcl_AppendResult(interp, "file \"", fullFileName, "\" has never been loaded in this interpreter", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", + NULL); code = TCL_ERROR; goto done; } @@ -677,6 +704,8 @@ Tcl_UnloadObjCmd( if (pkgPtr->safeUnloadProc == NULL) { Tcl_AppendResult(interp, "file \"", fullFileName, "\" cannot be unloaded under a safe interpreter", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", + NULL); code = TCL_ERROR; goto done; } @@ -685,6 +714,8 @@ Tcl_UnloadObjCmd( if (pkgPtr->unloadProc == NULL) { Tcl_AppendResult(interp, "file \"", fullFileName, "\" cannot be unloaded under a trusted interpreter", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", + NULL); code = TCL_ERROR; goto done; } @@ -771,8 +802,7 @@ Tcl_UnloadObjCmd( */ if (pkgPtr->fileName[0] != '\0') { - - Tcl_MutexLock(&packageMutex); + Tcl_MutexLock(&packageMutex); if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) { /* * Remove this library from the loaded library cache. @@ -824,6 +854,8 @@ Tcl_UnloadObjCmd( #else Tcl_AppendResult(interp, "file \"", fullFileName, "\" cannot be unloaded: unloading disabled", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED", + NULL); code = TCL_ERROR; #endif } |