diff options
Diffstat (limited to 'generic/tclLoad.c')
| -rw-r--r-- | generic/tclLoad.c | 36 |
1 files changed, 34 insertions, 2 deletions
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 } |