Index: doc/Load.3 ================================================================== --- doc/Load.3 +++ doc/Load.3 @@ -29,11 +29,12 @@ .AP "const char *const" symbols[] in Array of names of symbols to be resolved during the load of the library, or NULL if no symbols are to be resolved. If an array is given, the last entry in the array must be NULL. .AP int flags in -Reserved for future expansion. Must be 0. +The value should normally be 0, but \fITCL_LOAD_GLOBALfR or \fITCL_LOAD_LAZYfR +or a combination of those two is allowed as well. .AP void *procPtrs out Points to an array that will hold the addresses of the functions described in the \fIsymbols\fR argument. Should be NULL if no symbols are to be resolved. .AP Tcl_LoadHandle *loadHandlePtr out Points to a variable that will hold the handle to the abstract token Index: doc/load.n ================================================================== --- doc/load.n +++ doc/load.n @@ -9,15 +9,15 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME load \- Load machine code and initialize new commands .SH SYNOPSIS -\fBload \fIfileName\fR +\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName\fR .br -\fBload \fIfileName packageName\fR +\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName\fR .br -\fBload \fIfileName packageName interp\fR +\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName interp\fR .BE .SH DESCRIPTION .PP This command loads binary code from a file into the application's address space and calls an initialization procedure @@ -102,10 +102,26 @@ procedure) by that name; if one is found, it is used. Otherwise, the \fBload\fR command searches for a dynamically loaded package by that name, and uses it if it is found. If several different files have been \fBload\fRed with different versions of the package, Tcl picks the file that was loaded first. +.PP +If \fB\-global\fR is specified preceding the filename, all symbols +found in the shared library are exported for global use by other +libraries. The option \fB\-lazy\fR delays the actual loading of +symbols until their first actual use. The options may be abbreviated. +The option \fB\-\-\fR indicates the end of the options, and should +be used if you wish to use a filename which starts with \fB\-\fR +and you provide a packageName to the \fBload\fR command. +.PP +On platforms which do not support the \fB\-global\fR or \fB\-lazy\fR +options, the options still exist but have no effect. Note that use +of the \fB\-global\fR or \fB\-lazy\fR option may lead to crashes +in your application later (in case of symbol conflicts resp. missing +symbols), which cannot be detected during the \fBload\fR. So, only +use this when you know what you are doing, you will not get a nice +error message when something is wrong with the loaded library. .SH "PORTABILITY ISSUES" .TP \fBWindows\fR\0\0\0\0\0 . When a load fails with Index: generic/tcl.h ================================================================== --- generic/tcl.h +++ generic/tcl.h @@ -2358,10 +2358,18 @@ #define TCL_ZLIB_NO_FLUSH 0 #define TCL_ZLIB_FLUSH 2 #define TCL_ZLIB_FULLFLUSH 3 #define TCL_ZLIB_FINALIZE 4 +/* + *---------------------------------------------------------------------------- + * Definitions needed for the Tcl_LoadFile function. [TIP #416] + */ + +#define TCL_LOAD_GLOBAL 1 +#define TCL_LOAD_LAZY 2 + /* *---------------------------------------------------------------------------- * Single public declaration for NRE. */ Index: generic/tclLoad.c ================================================================== --- generic/tclLoad.c +++ generic/tclLoad.c @@ -130,13 +130,38 @@ Tcl_PackageInitProc *initProc; const char *p, *fullFileName, *packageName; 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) { return TCL_ERROR; } @@ -363,11 +388,11 @@ symbols[0] = Tcl_DStringValue(&initName); 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) { goto done; } @@ -389,11 +414,11 @@ Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeInitName)); 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; pkgPtr->safeInterpRefCount = 0; Index: tests/load.test ================================================================== --- tests/load.test +++ tests/load.test @@ -45,36 +45,42 @@ testConstraint testsimplefilesystem \ [llength [info commands testsimplefilesystem]] test load-1.1 {basic errors} {} { list [catch {load} msg] $msg -} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}" +} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}" test load-1.2 {basic errors} {} { list [catch {load a b c d} msg] $msg -} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}" +} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}" test load-1.3 {basic errors} {} { list [catch {load a b foobar} msg] $msg } {1 {could not find interpreter "foobar"}} test load-1.4 {basic errors} {} { - list [catch {load {}} msg] $msg + list [catch {load -global {}} msg] $msg } {1 {must specify either file name or package name}} test load-1.5 {basic errors} {} { - list [catch {load {} {}} msg] $msg + list [catch {load -lazy {} {}} msg] $msg } {1 {must specify either file name or package name}} test load-1.6 {basic errors} {} { list [catch {load {} Unknown} msg] $msg } {1 {package "Unknown" isn't loaded statically}} +test load-1.7 {basic errors} {} { + list [catch {load -abc foo} msg] $msg +} "1 {bad option \"-abc\": must be -global, -lazy, or --}" +test load-1.8 {basic errors} {} { + list [catch {load -global} msg] $msg +} "1 {couldn't figure out package name for -global}" test load-2.1 {basic loading, with guess for package name} \ [list $dll $loaded] { - load [file join $testDir pkga$ext] + load -global [file join $testDir pkga$ext] list [pkga_eq abc def] [lsort [info commands pkga_*]] } {0 {pkga_eq pkga_quote}} interp create -safe child test load-2.2 {loading into a safe interpreter, with package name conversion} \ [list $dll $loaded] { - load [file join $testDir pkgb$ext] pKgB child + load -lazy [file join $testDir pkgb$ext] pKgB child list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \ [catch {pkgb_sub 12 10} msg2] $msg2 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}} test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \ -body { @@ -124,11 +130,11 @@ test load-5.1 {file name not specified and no static package: pick default} \ [list $dll $loaded] { catch {interp delete x} interp create x - load [file join $testDir pkga$ext] pkga + load -global [file join $testDir pkga$ext] pkga load {} pkga x set result [info loaded x] interp delete x set result } [list [list [file join $testDir pkga$ext] Pkga]] Index: unix/tclLoadDl.c ================================================================== --- unix/tclLoadDl.c +++ unix/tclLoadDl.c @@ -73,22 +73,33 @@ int flags) { void *handle; Tcl_LoadHandle newHandle; const char *native; + int dlopenflags = 0; /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. */ native = Tcl_FSGetNativePath(pathPtr); /* - * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070] + * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ - handle = dlopen(native, RTLD_NOW | RTLD_LOCAL); + if (flags & TCL_LOAD_GLOBAL) { + dlopenflags |= RTLD_GLOBAL; + } else { + dlopenflags |= RTLD_LOCAL; + } + if (flags & TCL_LOAD_LAZY) { + dlopenflags |= RTLD_LAZY; + } else { + dlopenflags |= RTLD_NOW; + } + handle = dlopen(native, dlopenflags); if (handle == NULL) { /* * Let the OS loader examine the binary search path for whatever * string the user gave us which hopefully refers to a file on the * binary path. @@ -97,13 +108,13 @@ Tcl_DString ds; const char *fileName = Tcl_GetString(pathPtr); native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); /* - * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070] + * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ - handle = dlopen(native, RTLD_NOW | RTLD_LOCAL); + handle = dlopen(native, dlopenflags); Tcl_DStringFree(&ds); } if (handle == NULL) { /* @@ -151,11 +162,11 @@ const char *symbol) /* Symbol to look up. */ { const char *native; /* Name of the library to be loaded, in * system encoding */ Tcl_DString newName, ds; /* Buffers for converting the name to - * system encoding and prepending an + * system encoding and prepending an * underscore*/ void *handle = (void *) loadHandle->clientData; /* Native handle to the loaded library */ void *proc; /* Address corresponding to the resolved * symbol */ Index: unix/tclLoadDyld.c ================================================================== --- unix/tclLoadDyld.c +++ unix/tclLoadDyld.c @@ -168,10 +168,13 @@ #endif /* TCL_DYLD_USE_NSMODULE */ const char *errMsg = NULL; int result; Tcl_DString ds; const char *nativePath, *nativeFileName = NULL; +#if TCL_DYLD_USE_DLFCN + int dlopenflags = 0; +#endif /* TCL_DYLD_USE_DLFCN */ /* * First try the full path the user gave us. This is particularly * important if the cwd is inside a vfs, and we are trying to load using a * relative path. @@ -181,24 +184,31 @@ nativeFileName = Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr), -1, &ds); #if TCL_DYLD_USE_DLFCN /* - * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070] + * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ - dlHandle = dlopen(nativePath, RTLD_NOW | RTLD_LOCAL); + if (flags & TCL_LOAD_GLOBAL) { + dlopenflags |= RTLD_GLOBAL; + } else { + dlopenflags |= RTLD_LOCAL; + } + if (flags & TCL_LOAD_LAZY) { + dlopenflags |= RTLD_LAZY; + } else { + dlopenflags |= RTLD_NOW; + } + dlHandle = dlopen(nativePath, dlopenflags); if (!dlHandle) { /* * Let the OS loader examine the binary search path for whatever string * the user gave us which hopefully refers to a file on the binary * path. - * - * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070] - */ - dlHandle = dlopen(nativeFileName, RTLD_NOW | RTLD_LOCAL); + dlHandle = dlopen(nativeFileName, dlopenflags); if (!dlHandle) { errMsg = dlerror(); } } #endif /* TCL_DYLD_USE_DLFCN */ @@ -236,13 +246,14 @@ */ err = NSCreateObjectFileImageFromFile(nativePath, &dyldObjFileImage); if (err == NSObjectFileImageSuccess && dyldObjFileImage) { - module = NSLinkModule(dyldObjFileImage, nativePath, - NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_PRIVATE - | NSLINKMODULE_OPTION_RETURN_ON_ERROR); + int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR; + if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE; + if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW; + module = NSLinkModule(dyldObjFileImage, nativePath, nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (module) { modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle)); modulePtr->module = module; modulePtr->nextPtr = NULL; @@ -563,10 +574,11 @@ Tcl_DyldLoadHandle *dyldLoadHandle; NSObjectFileImage dyldObjFileImage = NULL; Tcl_DyldModuleHandle *modulePtr; NSModule module; const char *objFileImageErrMsg = NULL; + int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR; /* * Try to create an object file image that we can load from. */ @@ -657,13 +669,13 @@ /* * Extract the module we want from the image of the object file. */ - module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]", - NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_PRIVATE - | NSLINKMODULE_OPTION_RETURN_ON_ERROR); + if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE; + if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW; + module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]", nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (!module) { NSLinkEditErrors editError; int errorNumber; const char *errorName, *errMsg;