diff options
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r-- | generic/tclLoad.c | 98 |
1 files changed, 63 insertions, 35 deletions
diff --git a/generic/tclLoad.c b/generic/tclLoad.c index ce4d6a4..5cacab1 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -132,9 +132,34 @@ Tcl_LoadObjCmd( Tcl_LoadHandle loadHandle; Tcl_UniChar ch; unsigned len; + int index, flags = 0; + Tcl_Obj *const *savedobjv = objv; + static const char *const options[] = { + "-global", "-lazy", "--", NULL + }; + enum options { + LOAD_GLOBAL, LOAD_LAZY, LOAD_LAST + }; + while (objc > 2) { + if (TclGetString(objv[1])[0] != '-') { + break; + } + if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + ++objv; --objc; + if (LOAD_GLOBAL == (enum options) index) { + flags |= TCL_LOAD_GLOBAL; + } else if (LOAD_LAZY == (enum options) index) { + flags |= TCL_LOAD_LAZY; + } else { + break; + } + } if ((objc < 2) || (objc > 4)) { - Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?"); + Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { @@ -157,9 +182,8 @@ Tcl_LoadObjCmd( } } if ((fullFileName[0] == 0) && (packageName == NULL)) { - Tcl_SetResult(interp, - "must specify either file name or package name", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify either file name or package name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY", NULL); code = TCL_ERROR; @@ -225,9 +249,9 @@ Tcl_LoadObjCmd( * Can't have two different packages loaded from the same file. */ - Tcl_AppendResult(interp, "file \"", fullFileName, - "\" is already loaded for package \"", - pkgPtr->packageName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "file \"%s\" is already loaded for package \"%s\"", + fullFileName, pkgPtr->packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "SPLITPERSONALITY", NULL); code = TCL_ERROR; @@ -263,8 +287,8 @@ Tcl_LoadObjCmd( */ if (fullFileName[0] == 0) { - Tcl_AppendResult(interp, "package \"", packageName, - "\" isn't loaded statically", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "package \"%s\" isn't loaded statically", packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC", NULL); code = TCL_ERROR; @@ -321,9 +345,9 @@ Tcl_LoadObjCmd( } if (p == pkgGuess) { Tcl_DecrRefCount(splitPtr); - Tcl_AppendResult(interp, - "couldn't figure out package name for ", - fullFileName, NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't figure out package name for %s", + fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "WHATPACKAGE", NULL); code = TCL_ERROR; @@ -366,7 +390,7 @@ Tcl_LoadObjCmd( symbols[1] = NULL; Tcl_MutexLock(&packageMutex); - code = Tcl_LoadFile(interp, objv[1], symbols, 0, &initProc, + code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc, &loadHandle); Tcl_MutexUnlock(&packageMutex); if (code != TCL_OK) { @@ -392,7 +416,7 @@ Tcl_LoadObjCmd( pkgPtr->unloadProc = (Tcl_PackageUnloadProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&unloadName)); - pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *) + pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *) Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeUnloadName)); pkgPtr->interpRefCount = 0; @@ -418,9 +442,9 @@ Tcl_LoadObjCmd( if (Tcl_IsSafe(target)) { if (pkgPtr->safeInitProc == NULL) { - Tcl_AppendResult(interp, - "can't use package in a safe interpreter: no ", - pkgPtr->packageName, "_SafeInit procedure", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't use package in a safe interpreter: no" + " %s_SafeInit procedure", pkgPtr->packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE", NULL); code = TCL_ERROR; @@ -429,9 +453,9 @@ Tcl_LoadObjCmd( 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_SetObjResult(interp, Tcl_ObjPrintf( + "can't attach package to interpreter: no %s_Init procedure", + pkgPtr->packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT", NULL); code = TCL_ERROR; @@ -581,9 +605,8 @@ Tcl_UnloadObjCmd( } } if ((fullFileName[0] == 0) && (packageName == NULL)) { - Tcl_SetResult(interp, - "must specify either file name or package name", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "must specify either file name or package name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY", NULL); code = TCL_ERROR; @@ -655,8 +678,9 @@ Tcl_UnloadObjCmd( * It's an error to try unload a static package. */ - Tcl_AppendResult(interp, "package \"", packageName, - "\" is loaded statically and cannot be unloaded", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "package \"%s\" is loaded statically and cannot be unloaded", + packageName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC", NULL); code = TCL_ERROR; @@ -667,8 +691,8 @@ Tcl_UnloadObjCmd( * The DLL pointed by the provided filename has never been loaded. */ - Tcl_AppendResult(interp, "file \"", fullFileName, - "\" has never been loaded", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "file \"%s\" has never been loaded", fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", NULL); code = TCL_ERROR; @@ -696,8 +720,9 @@ Tcl_UnloadObjCmd( * The package has not been loaded in this interpreter. */ - Tcl_AppendResult(interp, "file \"", fullFileName, - "\" has never been loaded in this interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "file \"%s\" has never been loaded in this interpreter", + fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED", NULL); code = TCL_ERROR; @@ -712,8 +737,9 @@ Tcl_UnloadObjCmd( if (Tcl_IsSafe(target)) { if (pkgPtr->safeUnloadProc == NULL) { - Tcl_AppendResult(interp, "file \"", fullFileName, - "\" cannot be unloaded under a safe interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "file \"%s\" cannot be unloaded under a safe interpreter", + fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", NULL); code = TCL_ERROR; @@ -722,8 +748,9 @@ Tcl_UnloadObjCmd( unloadProc = pkgPtr->safeUnloadProc; } else { if (pkgPtr->unloadProc == NULL) { - Tcl_AppendResult(interp, "file \"", fullFileName, - "\" cannot be unloaded under a trusted interpreter", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "file \"%s\" cannot be unloaded under a trusted interpreter", + fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT", NULL); code = TCL_ERROR; @@ -862,8 +889,9 @@ Tcl_UnloadObjCmd( } } #else - Tcl_AppendResult(interp, "file \"", fullFileName, - "\" cannot be unloaded: unloading disabled", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "file \"%s\" cannot be unloaded: unloading disabled", + fullFileName)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED", NULL); code = TCL_ERROR; |