Attachment "357.patch" to
ticket [2891616fff]
added by
kennykb
2010-03-17 10:22:27.
? NSK1200002852A
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.172
diff -r1.172 tcl.decls
2307a2308,2321
> # TIP #357 (Export TclLoadFile and TclpFindSymbol) kbk
> declare 627 generic {
> int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
> const char *symv[], int flags, void* procPtrs,
> Tcl_LoadHandle* handlePtr)
> }
> declare 628 generic {
> void* Tcl_FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle handle,
> const char* symbol)
> }
> declare 629 generic {
> int Tcl_FSUnloadFile(Tcl_Interp* interp, Tcl_LoadHandle handlePtr)
> }
>
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.174
diff -r1.174 tclDecls.h
3686a3687,3705
> #ifndef Tcl_LoadFile_TCL_DECLARED
> #define Tcl_LoadFile_TCL_DECLARED
> /* 627 */
> EXTERN int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
> const char *symv[], int flags, void*procPtrs,
> Tcl_LoadHandle*handlePtr);
> #endif
> #ifndef Tcl_FindSymbol_TCL_DECLARED
> #define Tcl_FindSymbol_TCL_DECLARED
> /* 628 */
> EXTERN void* Tcl_FindSymbol(Tcl_Interp*interp,
> Tcl_LoadHandle handle, const char*symbol);
> #endif
> #ifndef Tcl_FSUnloadFile_TCL_DECLARED
> #define Tcl_FSUnloadFile_TCL_DECLARED
> /* 629 */
> EXTERN int Tcl_FSUnloadFile(Tcl_Interp*interp,
> Tcl_LoadHandle handlePtr);
> #endif
4348a4368,4370
> int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *symv[], int flags, void*procPtrs, Tcl_LoadHandle*handlePtr); /* 627 */
> void* (*tcl_FindSymbol) (Tcl_Interp*interp, Tcl_LoadHandle handle, const char*symbol); /* 628 */
> int (*tcl_FSUnloadFile) (Tcl_Interp*interp, Tcl_LoadHandle handlePtr); /* 629 */
6886a6909,6920
> #ifndef Tcl_LoadFile
> #define Tcl_LoadFile \
> (tclStubsPtr->tcl_LoadFile) /* 627 */
> #endif
> #ifndef Tcl_FindSymbol
> #define Tcl_FindSymbol \
> (tclStubsPtr->tcl_FindSymbol) /* 628 */
> #endif
> #ifndef Tcl_FSUnloadFile
> #define Tcl_FSUnloadFile \
> (tclStubsPtr->tcl_FSUnloadFile) /* 629 */
> #endif
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.170
diff -r1.170 tclIOUtil.c
44a45,48
> static void* DivertFindSymbol(Tcl_Interp* interp,
> Tcl_LoadHandle loadHandle,
> const char* symbol);
> static void DivertUnloadFile(Tcl_LoadHandle loadHandle);
2970,2972c2974,2975
< const char *symbols[2];
< Tcl_PackageInitProc **procPtrs[2];
< ClientData clientData;
---
> const char *symbols[3];
> void *procPtrs[2];
2981,2982c2984
< procPtrs[0] = proc1Ptr;
< procPtrs[1] = proc2Ptr;
---
> symbols[2] = NULL;
2988,3000c2990,2996
< res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs, handlePtr,
< &clientData, unloadProcPtr);
<
< /*
< * Due to an unfortunate mis-design in Tcl 8.4 fs, when loading a shared
< * library, we don't keep the loadHandle (for TclpFindSymbol) and the
< * clientData (for the unloadProc) separately. In fact we effectively
< * throw away the loadHandle and only use the clientData. It just so
< * happens, for the native filesystem only, that these two are identical.
< *
< * This also means that the signatures Tcl_FSUnloadFileProc and
< * Tcl_FSLoadFileProc are both misleading.
< */
---
> res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr);
> if (res == TCL_OK) {
> *proc1Ptr = (Tcl_PackageInitProc*) procPtrs[0];
> *proc2Ptr = (Tcl_PackageInitProc*) procPtrs[1];
> } else {
> *proc1Ptr = *proc2Ptr = NULL;
> }
3002d2997
< *handlePtr = clientData;
3009c3004
< * TclLoadFile --
---
> * Tcl_LoadFile --
3023,3028d3017
< * This function is currently private to Tcl. It may be exported in the
< * future and its interface fixed (but we should clean up the
< * loadHandle/clientData confusion at that time -- see the above comments
< * in Tcl_FSLoadFile for details). For a public function, see
< * Tcl_FSLoadFile.
< *
3035c3024
< * passing the clientData to the unloadProc.
---
> * calling TclFS_UnloadFile.
3041c3030
< TclLoadFile(
---
> Tcl_LoadFile(
3045,3046d3033
< int symc, /* Number of symbols/procPtrs in the next two
< * arrays. */
3049,3050c3036,3037
< Tcl_PackageInitProc **procPtrs[],
< /* Where to return the addresses corresponding
---
> int flags, /* Flags (unused) */
> void *procVPtrs, /* Where to return the addresses corresponding
3052c3039
< Tcl_LoadHandle *handlePtr, /* Filled with token for shared library
---
> Tcl_LoadHandle *handlePtr) /* Filled with token for shared library
3055,3061d3041
< ClientData *clientDataPtr, /* Filled with token for dynamically loaded
< * file which will be passed back to
< * (*unloadProcPtr)() to unload the file. */
< Tcl_FSUnloadFileProc **unloadProcPtr)
< /* Filled with address of Tcl_FSUnloadFileProc
< * function which should be used for this
< * file. */
3062a3043
> void** procPtrs = (void**) procVPtrs;
3064a3046
> Tcl_FSUnloadFileProc* unloadProcPtr;
3067c3049
< ClientData newClientData = NULL;
---
> Tcl_LoadHandle divertedLoadHandle = NULL;
3070a3053
> int i;
3079c3062
< unloadProcPtr);
---
> &unloadProcPtr);
3085,3090d3067
<
< /*
< * Copy this across, since both are equal for the native fs.
< */
<
< *clientDataPtr = *handlePtr;
3150c3127
< unloadProcPtr);
---
> &unloadProcPtr);
3166,3171c3143
< copyToPtr = TclpTempFileName();
< if (copyToPtr == NULL) {
< Tcl_AppendResult(interp, "couldn't create temporary file: ",
< Tcl_PosixError(interp), NULL);
< return TCL_ERROR;
< }
---
> copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr);
3226,3227c3198,3199
< retVal = TclLoadFile(interp, copyToPtr, symc, symbols, procPtrs,
< &newLoadHandle, &newClientData, &newUnloadProcPtr);
---
> retVal = Tcl_LoadFile(interp, copyToPtr, symbols, 0, procPtrs,
> &newLoadHandle);
3254,3255d3225
< *clientDataPtr = newClientData;
< *unloadProcPtr = newUnloadProcPtr;
3310,3312c3280,3287
< *handlePtr = newLoadHandle;
< *clientDataPtr = tvdlPtr;
< *unloadProcPtr = TclFSUnloadTempFile;
---
>
>
> divertedLoadHandle = (Tcl_LoadHandle)
> ckalloc(sizeof (struct Tcl_LoadHandle_));
> divertedLoadHandle->clientData = (ClientData) tvdlPtr;
> divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
> divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
> *handlePtr = divertedLoadHandle;
3318,3323c3293,3309
< {
< int i;
<
< for (i=0 ; i<symc ; i++) {
< if (symbols[i] != NULL) {
< *procPtrs[i] = TclpFindSymbol(interp, *handlePtr, symbols[i]);
---
> /*
> * At this point, *handlePtr is already set up to the handle for the
> * loaded library. We now try to resolve the symbols.
> */
> if (symbols != NULL) {
> for (i=0 ; symbols[i] != NULL; i++) {
> procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]);
> if (procPtrs[i] == NULL) {
> /*
> * At least one symbol in the list was not found.
> * Unload the file, and report the problem back to the
> * caller. (Tcl_FindSymbol should already have left an
> * appropriate error message.)
> */
> (*handlePtr)->unloadFileProcPtr(*handlePtr);
> *handlePtr = NULL;
> return TCL_ERROR;
3330a3317,3423
> *-----------------------------------------------------------------------------
> *
> * DivertFindSymbol --
> *
> * Find a symbol in a shared library loaded by copy-from-VFS.
> *
> *-----------------------------------------------------------------------------
> */
>
> static void*
> DivertFindSymbol(Tcl_Interp* interp, /* Tcl interpreter */
> Tcl_LoadHandle loadHandle, /* Handle to the diverted module */
> const char* symbol) /* Symbol to resolve */
> {
> FsDivertLoad* tvdlPtr = (FsDivertLoad*) (loadHandle->clientData);
> Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle;
> return originalHandle->findSymbolProcPtr(interp, originalHandle, symbol);
> }
>
> /*
> *-----------------------------------------------------------------------------
> *
> * DivertUnloadFile --
> *
> * Unloads a file that has been loaded by copying from VFS to the
> * native filesystem.
> *
> * Parameters:
> * loadHandle -- Handle of the file to unload
> *
> *-----------------------------------------------------------------------------
> */
>
> static void
> DivertUnloadFile(Tcl_LoadHandle loadHandle)
> {
> FsDivertLoad* tvdlPtr = (FsDivertLoad*) (loadHandle->clientData);
> Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle;
>
> /*
> * This test should never trigger, since we give the client data in the
> * function above.
> */
>
> if (tvdlPtr == NULL) {
> return;
> }
>
> /*
> * Call the real 'unloadfile' proc we actually used. It is very important
> * that we call this first, so that the shared library is actually
> * unloaded by the OS. Otherwise, the following 'delete' may well fail
> * because the shared library is still in use.
> */
>
> originalHandle->unloadFileProcPtr(originalHandle);
>
> /* What filesystem contains the temp copy of the library? */
>
> if (tvdlPtr->divertedFilesystem == NULL) {
> /*
> * It was the native filesystem, and we have a special function
> * available just for this purpose, which we know works even at this
> * late stage.
> */
>
> TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
> NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
> } else {
> /*
> * Remove the temporary file we created. Note, we may crash here
> * because encodings have been taken down already.
> */
>
> if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
> != TCL_OK) {
> /*
> * The above may have failed because the filesystem, or something
> * it depends upon (e.g. encodings) have been taken down because
> * Tcl is exiting.
> *
> * We may need to work out how to delete this file more robustly
> * (or give the filesystem the information it needs to delete the
> * file more robustly).
> *
> * In particular, one problem might be that the filesystem cannot
> * extract the information it needs from the above path object
> * because Tcl's entire filesystem apparatus (the code in this
> * file) has been finalized, and it refuses to pass the internal
> * representation to the filesystem.
> */
> }
>
> /*
> * And free up the allocations. This will also of course remove a
> * refCount from the Tcl_Filesystem to which this file belongs, which
> * could then free up the filesystem if we are exiting.
> */
>
> Tcl_DecrRefCount(tvdlPtr->divertedFile);
> }
>
> ckfree((void*)tvdlPtr);
> ckfree((void*)loadHandle);
> }
>
> /*
3369,3370c3462,3516
< *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
< *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
---
> *proc1Ptr = Tcl_FindSymbol(interp, handle, sym1);
> *proc2Ptr = Tcl_FindSymbol(interp, handle, sym2);
> return TCL_OK;
> }
>
> /*
> *-----------------------------------------------------------------------------
> *
> * Tcl_FindSymbol --
> *
> * Find a symbol in a loaded library
> *
> * Results:
> * Returns a pointer to the symbol if found. If not found, returns
> * NULL and leaves an error message in the interpreter result.
> *
> * This function was once filesystem-specific, but has been made portable
> * by having TclpDlopen return a structure that includes procedure pointers.
> *
> *-----------------------------------------------------------------------------
> */
>
> void*
> Tcl_FindSymbol(Tcl_Interp* interp, /* Tcl interpreter */
> Tcl_LoadHandle loadHandle, /* Handle to the loaded library */
> const char* symbol) /* Name of the symbol to resolve */
> {
> return (*(loadHandle->findSymbolProcPtr))(interp, loadHandle, symbol);
> }
>
> /*
> *-----------------------------------------------------------------------------
> *
> * Tcl_FSUnloadFile --
> *
> * Unloads a library given its handle. Checks first that the library
> * supports unloading.
> *
> *-----------------------------------------------------------------------------
> */
>
> int
> Tcl_FSUnloadFile(Tcl_Interp* interp, /* Tcl interpreter */
> Tcl_LoadHandle handle) /* Handle of the file to unload */
> {
> if (handle->unloadFileProcPtr == NULL) {
> if (interp != NULL) {
> Tcl_SetObjResult(interp,
> Tcl_NewStringObj("cannot unload: filesystem "
> "does not support unloading",
> -1));
> }
> return TCL_ERROR;
> } else {
> TclpUnloadFile(handle);
3371a3518,3539
> }
> }
>
> /*
> *-----------------------------------------------------------------------------
> *
> * TclpUnloadFile --
> *
> * Unloads a library given its handle
> *
> * This function was once filesystem-specific, but has been made portable
> * by having TclpDlopen return a structure that includes procedure pointers.
> *
> *-----------------------------------------------------------------------------
> */
>
> void
> TclpUnloadFile(Tcl_LoadHandle handle)
> {
> if (handle->unloadFileProcPtr != NULL) {
> (*(handle->unloadFileProcPtr))(handle);
> }
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.464
diff -r1.464 tclInt.h
2774a2775,2793
> /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile
> * and Tcl_FindSymbol. This structure corresponds to an opaque
> * typedef in tcl.h */
>
> typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
> const char* symbol);
> struct Tcl_LoadHandle_ {
> ClientData clientData; /* Client data is the load handle in the
> * native filesystem if a module was loaded
> * there, or an opaque pointer to a structure
> * for further bookkeeping on load-from-VFS
> * and load-from-memory */
> TclFindSymbolProc* findSymbolProcPtr;
> /* Procedure that resolves symbols in a
> * loaded module */
> Tcl_FSUnloadFileProc* unloadFileProcPtr;
> /* Procedure that unloads a loaded module */
> };
>
2923,2928d2941
< MODULE_SCOPE int TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
< int symc, const char *symbols[],
< Tcl_PackageInitProc **procPtrs[],
< Tcl_LoadHandle *handlePtr,
< ClientData *clientDataPtr,
< Tcl_FSUnloadFileProc **unloadProcPtr);
2965a2979
> MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr);
3018d3031
< MODULE_SCOPE void TclpUnloadFile(Tcl_LoadHandle loadHandle);
3059,3060d3071
< MODULE_SCOPE Tcl_PackageInitProc *TclpFindSymbol(Tcl_Interp *interp,
< Tcl_LoadHandle loadHandle, const char *symbol);
Index: generic/tclLoad.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLoad.c,v
retrieving revision 1.24
diff -r1.24 tclLoad.c
60,64d59
< Tcl_FSUnloadFileProc *unLoadProcPtr;
< /* Function to use to unload this package. If
< * NULL, then we do not attempt to unload the
< * package. If fileName is NULL, then this
< * field is irrelevant. */
134d128
< Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc;
137,139c131,132
< const char *symbols[4];
< Tcl_PackageInitProc **procPtrs[4];
< ClientData clientData;
---
> const char *symbols[2];
> void* procPtrs[1];
142d134
< Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
362,368c354
< symbols[1] = Tcl_DStringValue(&safeInitName);
< symbols[2] = Tcl_DStringValue(&unloadName);
< symbols[3] = Tcl_DStringValue(&safeUnloadName);
< procPtrs[0] = &initProc;
< procPtrs[1] = &safeInitProc;
< procPtrs[2] = &unloadProc;
< procPtrs[3] = &safeUnloadProc;
---
> symbols[1] = NULL;
371,372c357
< code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs,
< &loadHandle, &clientData, &unLoadProcPtr);
---
> code = Tcl_LoadFile(interp, objv[1], symbols, 0, procPtrs, &loadHandle);
374d358
< loadHandle = clientData;
379,388d362
< if (*procPtrs[0] /* initProc */ == NULL) {
< Tcl_AppendResult(interp, "couldn't find procedure ",
< Tcl_DStringValue(&initName), NULL);
< if (unLoadProcPtr != NULL) {
< unLoadProcPtr(loadHandle);
< }
< code = TCL_ERROR;
< goto done;
< }
<
401,405c375,382
< pkgPtr->unLoadProcPtr = unLoadProcPtr;
< pkgPtr->initProc = *procPtrs[0];
< pkgPtr->safeInitProc = *procPtrs[1];
< pkgPtr->unloadProc = (Tcl_PackageUnloadProc *) *procPtrs[2];
< pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *) *procPtrs[3];
---
> pkgPtr->initProc = (Tcl_PackageInitProc*) procPtrs[0];
> pkgPtr->safeInitProc = (Tcl_PackageInitProc*)
> Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeInitName));
> pkgPtr->unloadProc = (Tcl_PackageUnloadProc*)
> Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&unloadName));
> pkgPtr->safeUnloadProc = (Tcl_PackageUnloadProc *)
> Tcl_FindSymbol(interp, loadHandle,
> Tcl_DStringValue(&safeUnloadName));
412a390,394
> /*
> * The Tcl_FindSymbol calls may have left a spurious error message
> * in the interpreter result.
> */
> Tcl_ResetResult(interp);
790d771
< Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
792d772
< if (unLoadProcPtr != NULL) {
794,797c774
< if ((pkgPtr->unloadProc != NULL) || (unLoadProcPtr == TclFSUnloadTempFile)) {
< unLoadProcPtr(pkgPtr->loadHandle);
< }
<
---
> if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
842,844d818
< Tcl_AppendResult(interp, "file \"", fullFileName,
< "\" cannot be unloaded: filesystem does not support unloading",
< NULL);
1149,1154c1123
< Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
< if ((unLoadProcPtr != NULL)
< && ((pkgPtr->unloadProc != NULL)
< || (unLoadProcPtr == TclFSUnloadTempFile))) {
< unLoadProcPtr(pkgPtr->loadHandle);
< }
---
> Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
Index: generic/tclLoadNone.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLoadNone.c,v
retrieving revision 1.13
diff -r1.13 tclLoadNone.c
4c4
< * This procedure provides a version of the TclLoadFile for use in
---
> * This procedure provides a version of the TclpDlopen for use in
58,84d57
< * TclpFindSymbol --
< *
< * Looks up a symbol, by name, through a handle associated with a
< * previously loaded piece of code (shared library). This version of this
< * routine should never be called because the associated TclpDlopen()
< * function always returns an error.
< *
< * Results:
< * Returns a pointer to the function associated with 'symbol' if it is
< * found. Otherwise returns NULL and may leave an error message in the
< * interp's result.
< *
< *----------------------------------------------------------------------
< */
<
< Tcl_PackageInitProc *
< TclpFindSymbol(
< Tcl_Interp *interp,
< Tcl_LoadHandle loadHandle,
< const char *symbol)
< {
< return NULL;
< }
<
< /*
< *----------------------------------------------------------------------
< *
113,138d85
< *----------------------------------------------------------------------
< *
< * TclpUnloadFile --
< *
< * This procedure is called to carry out dynamic unloading of binary code;
< * it is intended for use only on systems that don't support dynamic
< * loading (it does nothing).
< *
< * Results:
< * None.
< *
< * Side effects:
< * None.
< *
< *----------------------------------------------------------------------
< */
<
< void
< TclpUnloadFile(
< Tcl_LoadHandle loadHandle) /* loadHandle returned by a previous call to
< * TclpDlopen(). The loadHandle is a token
< * that represents the loaded file. */
< {
< }
<
< /*
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.188
diff -r1.188 tclStubInit.c
1116a1117,1119
> Tcl_LoadFile, /* 627 */
> Tcl_FindSymbol, /* 628 */
> Tcl_FSUnloadFile, /* 629 */
Index: tests/fileSystem.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileSystem.test,v
retrieving revision 1.59
diff -r1.59 fileSystem.test
622c622
< test filesystem-7.1 {load from vfs} -setup {
---
> test filesystem-7.1.1 {load from vfs} -setup {
636a637,652
> test filesystem-7.1.2 {load from vfs, and then unload again} -setup {
> set dir [pwd]
> } -constraints {win testsimplefilesystem} -body {
> # This may cause a crash on exit
> cd [file dirname [info nameof]]
> set reg [lindex [glob tclreg*[info sharedlib]] 0]
> testsimplefilesystem 1
> # This loads reg via a complex copy-to-temp operation
> load simplefs:/$reg Registry
> unload simplefs:/$reg
> testsimplefilesystem 0
> return ok
> # The real result of this test is what happens when Tcl exits.
> } -cleanup {
> cd $dir
> } -result ok
Index: tests/load.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/load.test,v
retrieving revision 1.20
diff -r1.20 load.test
80,81c80,83
< list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg
< } -match glob -result {1 {*couldn't find procedure Foo_Init}}
---
> list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
> } -match glob \
> -result [list 1 {cannot find symbol "Foo_Init"*} \
> {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
Index: tests/unload.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/unload.test,v
retrieving revision 1.8
diff -r1.8 unload.test
42a43,46
> # Certain tests need the 'testsimplefilsystem' in tcltest
> testConstraint testsimplefilesystem \
> [llength [info commands testsimplefilesystem]]
>
215a220,234
> test unload-5.1 {unload a module loaded from vfs} \
> -constraints [list $dll $loaded testsimplefilesystem] \
> -setup {
> set dir [pwd]
> cd $testDir
> testsimplefilesystem 1
> load simplefs:/pkgua$ext pkgua
> } \
> -body {
> list [catch {unload simplefs:/pkgua$ext} msg] $msg
> } \
> -result {0 {}}
>
>
>
221a241,244
>
> # Local Variables:
> # mode: tcl
> # End:
Index: unix/tclLoadDl.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDl.c,v
retrieving revision 1.19
diff -r1.19 tclLoadDl.c
36a37,42
> /* Static procedures defined within this file */
>
> static void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
> const char* symbol);
> static void UnloadFile(Tcl_LoadHandle loadHandle);
>
68a75
> Tcl_LoadHandle newHandle;
105a113,118
> newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
> newHandle->clientData = (ClientData) handle;
> newHandle->findSymbolProcPtr = &FindSymbol;
> newHandle->unloadFileProcPtr = &UnloadFile;
> *unloadProcPtr = &UnloadFile;
> *loadHandle = newHandle;
107,108d119
< *unloadProcPtr = &TclpUnloadFile;
< *loadHandle = (Tcl_LoadHandle) handle;
115c126
< * TclpFindSymbol --
---
> * FindSymbol --
128,129c139,140
< Tcl_PackageInitProc *
< TclpFindSymbol(
---
> static void *
> FindSymbol(
136c147
< void *handle = (void *) loadHandle;
---
> void *handle = (void *)(loadHandle->clientData);
157c168,174
<
---
> if (proc == NULL && interp != NULL) {
> Tcl_ResetResult(interp);
> Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\": ",
> dlerror(), NULL);
> Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
> NULL);
> }
164c181
< * TclpUnloadFile --
---
> * UnloadFile --
179,180c196,197
< void
< TclpUnloadFile(
---
> static void
> UnloadFile(
187c204
< handle = (void *) loadHandle;
---
> handle = (void *)(loadHandle->clientData);
188a206
> ckfree((char*)loadHandle);
Index: unix/tclLoadDyld.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadDyld.c,v
retrieving revision 1.34
diff -r1.34 tclLoadDyld.c
96a97,104
> /* Static functions defined in this file */
>
> static void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
> const char* symbol);
> static void UnloadFile(Tcl_LoadHandle handle);
>
>
>
169a178
> Tcl_LoadHandle* newHandle;
310,311c319,324
< *loadHandle = (Tcl_LoadHandle) dyldLoadHandle;
< *unloadProcPtr = &TclpUnloadFile;
---
> newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
> newHandle->clientData = dyldLoadHandle;
> newHandle->findSymbolProcPtr = &FindSymbol;
> newHandle->unloadProcPtr = &UnloadFile;
> *unloadProcPtr = &UnloadFile;
> *loadHandle = newHandle;
332c345
< * TclpFindSymbol --
---
> * FindSymbol --
345,346c358,359
< MODULE_SCOPE Tcl_PackageInitProc *
< TclpFindSymbol(
---
> static void*
> FindSymbol(
351c364,365
< Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
---
> Tcl_DyldLoadHandle *dyldLoadHandle =
> (Tcl_DyldLoadHandle *) (loadHandle->clientData);
439c453
< if (errMsg) {
---
> if (errMsg && (interp != NULL)) {
440a455
> Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
448c463
< * TclpUnloadFile --
---
> * UnloadFile --
465,466c480,481
< MODULE_SCOPE void
< TclpUnloadFile(
---
> static void
> UnloadFile(
471c486,487
< Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
---
> Tcl_DyldLoadHandle *dyldLoadHandle =
> (Tcl_DyldLoadHandle *) (loadHandle->clientData);
506a523
> ckfree((char*) loadHandle);
615a633
> Tcl_LoadHandle newHandle;
760,761c778,783
< *loadHandle = (Tcl_LoadHandle) dyldLoadHandle;
< *unloadProcPtr = &TclpUnloadFile;
---
> newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
> newHandle->clientData = dyldLoadHandle;
> newHandle->findSymbolProcPtr = &FindSymbol;
> newHandle->unloadFileProcPtr = &UnloadFile;
> *loadHandle = newHandle;
> *unloadProcPtr = &UnloadFile;
Index: unix/tclLoadNext.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadNext.c,v
retrieving revision 1.16
diff -r1.16 tclLoadNext.c
17a18,24
>
> /* Static procedures defined within this file */
>
> static void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
> const char* symbol);
> static void UnloadFile(Tcl_LoadHandle loadHandle);
>
49a57
> Tcl_LoadHandle newHandle;
98,99c106,111
< *loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */
< *unloadProcPtr = &TclpUnloadFile;
---
> newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
> newHandle->clientData = (ClientData) 1;
> newHandle->findSymbolProcPtr = &FindSymbol;
> newHandle->unloadFileProcPtr = &UnloadFile;
> *loadHandle = newHandle;
> *unloadProcPtr = &UnloadFile;
107c119
< * TclpFindSymbol --
---
> * FindSymbol --
120,121c132,133
< Tcl_PackageInitProc *
< TclpFindSymbol(
---
> static void*
> FindSymbol(
134a147,152
> if (proc == NULL && interp != NULL) {
> Tcl_ResetResult(interp);
> Tcl_AppendResult(interp, "cannot find symbol \"", symbol,
> "\"", NULL);
> Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
> }
141c159
< * TclpUnloadFile --
---
> * UnloadFile --
157c175
< TclpUnloadFile(
---
> UnloadFile(
161a180
> ckfree((char*) loadHandle);
Index: unix/tclLoadOSF.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadOSF.c,v
retrieving revision 1.16
diff -r1.16 tclLoadOSF.c
40a41,46
> /* Static functions defined within this file */
>
> static void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
> const char* symbol);
> static void UnloadFile(Tcl_LoadHandle handle);
>
71a78
> Tcl_LoadHandle newHandle;
122,123c129,134
< *loadHandle = pkg;
< *unloadProcPtr = &TclpUnloadFile;
---
> newHandle = (Tcl_LoadHandle*) ckalloc(sizeof(*newHandle));
> newHandle->clientData = pkg;
> newHandle->findSymbolProcPtr = &FindSymbol;
> newHandle->unloadFileProcPtr = &UnloadFile;
> *loadHandle = newHandle;
> *unloadProcPtr = &UnloadFile;
130c141
< * TclpFindSymbol --
---
> * FindSymbol --
143,144c154,155
< Tcl_PackageInitProc *
< TclpFindSymbol(
---
> static void *
> FindSymbol(
149c160,166
< return ldr_lookup_package((char *)loadHandle, symbol);
---
> void* retval = ldr_lookup_package((char *)loadHandle, symbol);
> if (retval == NULL && interp != NULL) {
> Tcl_ResetResult(interp);
> Tcl_AppendResult(interp, "cannot find symbol\"", symbol, "\"", NULL);
> Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
> }
> return retval;
155c172
< * TclpUnloadFile --
---
> * UnloadFile --
170,171c187,188
< void
< TclpUnloadFile(
---
> static void
> UnloadFile(
175a193
> ckfree((char*) loadHandle);
Index: unix/tclLoadShl.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclLoadShl.c,v
retrieving revision 1.19
diff -r1.19 tclLoadShl.c
27a28,35
> /* Static functions defined within this file */
>
> static void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
> const char* symbol);
> static void
> UnloadFile(Tcl_LoadHandle handle);
>
>
59a68
> Tcl_LoadHandle newHandle;
100,101c109,113
< *loadHandle = (Tcl_LoadHandle) handle;
< *unloadProcPtr = &TclpUnloadFile;
---
> newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
> newHandle->clientData = handle;
> newHandle->findSymbolProcPtr = &FindSymbol;
> newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile;
> *loadHandle = newHandle;
108c120
< * TclpFindSymbol --
---
> * Tcl_FindSymbol --
121,122c133,134
< Tcl_PackageInitProc *
< TclpFindSymbol(
---
> static void*
> FindSymbol(
129c141
< shl_t handle = (shl_t)loadHandle;
---
> shl_t handle = (shl_t)(loadHandle->clientData);
146a159,163
> if (proc == NULL && interp != NULL) {
> Tcl_ResetResult(interp);
> Tcl_AppendResult(interp, "cannot find symbol\"", symbol,
> "\": ", Tcl_PosixError(interp), NULL);
> }
153c170
< * TclpUnloadFile --
---
> * UnloadFile --
168,169c185,186
< void
< TclpUnloadFile(
---
> static void
> UnloadFile(
176c193
< handle = (shl_t) loadHandle;
---
> handle = (shl_t) (loadHandle -> clientData);
177a195
> ckfree((char*) loadHandle);
Index: unix/tclUnixPipe.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPipe.c,v
retrieving revision 1.51
diff -r1.51 tclUnixPipe.c
271a272,305
> *-----------------------------------------------------------------------------
> *
> * TclpTempFileNameForLibrary --
> *
> * Constructs a file name in the native file system where a
> * dynamically loaded library may be placed.
> *
> * Results:
> * Returns the constructed file name. If an error occurs,
> * returns NULL and leaves an error message in the interpreter
> * result.
> *
> * On Unix, it works to load a shared object from a file of any
> * name, so this function is merely a thin wrapper around
> * TclpTempFileName().
> *
> *-----------------------------------------------------------------------------
> */
>
> Tcl_Obj*
> TclpTempFileNameForLibrary(Tcl_Interp* interp, /* Tcl interpreter */
> Tcl_Obj* path) /* Path name of the library
> * in the VFS */
> {
> Tcl_Obj* retval;
> retval = TclpTempFileName();
> if (retval == NULL) {
> Tcl_AppendResult(interp, "couldn't create temporary file: ",
> Tcl_PosixError(interp), NULL);
> }
> return retval;
> }
>
> /*
Index: win/tclWinLoad.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinLoad.c,v
retrieving revision 1.26
diff -r1.26 tclWinLoad.c
17a18,23
> /* Static functions defined within this file */
>
> void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
> const char* symbol);
> void UnloadFile(Tcl_LoadHandle loadHandle);
>
50c56
< HINSTANCE handle;
---
> HINSTANCE hInstance;
51a58
> Tcl_LoadHandle handlePtr;
60,61c67,68
< handle = tclWinProcs->loadLibraryProc(nativeName);
< if (handle == NULL) {
---
> hInstance = tclWinProcs->loadLibraryProc(nativeName);
> if (hInstance == NULL) {
72c79
< handle = tclWinProcs->loadLibraryProc(nativeName);
---
> hInstance = tclWinProcs->loadLibraryProc(nativeName);
76,78c83
< *loadHandle = (Tcl_LoadHandle) handle;
<
< if (handle == NULL) {
---
> if (hInstance == NULL) {
133c138,144
< *unloadProcPtr = &TclpUnloadFile;
---
> handlePtr =
> (Tcl_LoadHandle) ckalloc(sizeof(struct Tcl_LoadHandle_));
> handlePtr->clientData = (ClientData) hInstance;
> handlePtr->findSymbolProcPtr = &FindSymbol;
> handlePtr->unloadFileProcPtr = &UnloadFile;
> *loadHandle = (Tcl_LoadHandle) handlePtr;
> *unloadProcPtr = &UnloadFile;
141c152
< * TclpFindSymbol --
---
> * FindSymbol --
154,155c165,166
< Tcl_PackageInitProc *
< TclpFindSymbol(
---
> void *
> FindSymbol(
161c172
< HINSTANCE handle = (HINSTANCE)loadHandle;
---
> HINSTANCE hInstance = (HINSTANCE)(loadHandle->clientData);
168c179
< proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
---
> proc = (void*) GetProcAddress(hInstance, symbol);
171c182
<
---
> const char* sym2;
174,175c185,186
< symbol = Tcl_DStringAppend(&ds, symbol, -1);
< proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
---
> sym2 = Tcl_DStringAppend(&ds, symbol, -1);
> proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
177a189,192
> if (proc == NULL && interp != NULL) {
> Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\"", NULL);
> Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
> }
184c199
< * TclpUnloadFile --
---
> * UnloadFile --
200c215
< TclpUnloadFile(
---
> UnloadFile(
205,208c220,222
< HINSTANCE handle;
<
< handle = (HINSTANCE) loadHandle;
< FreeLibrary(handle);
---
> HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
> FreeLibrary(hInstance);
> ckfree((char*) loadHandle);
Index: win/tclWinPipe.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinPipe.c,v
retrieving revision 1.77
diff -r1.77 tclWinPipe.c
174a175,181
> * Name of the directory in the native filesystem where DLLs used in this
> * process are copied prior to loading.
> */
>
> static WCHAR* dllDirectoryName = NULL;
>
> /*
772a780,874
> *-----------------------------------------------------------------------------
> *
> * TclpTempFileNameForLibrary --
> *
> * Constructs a temporary file name for loading a shared object (DLL).
> *
> * Results:
> * Returns the constructed file name.
> *
> * On Windows, a DLL is identified by the final component of its path name.
> * Cross linking among DLL's (and hence, preloading) will not work unless
> * this name is preserved when copying a DLL from a VFS to a temp file for
> * preloading. For this reason, all DLLs in a given process are copied
> * to a temp directory, and their names are preserved.
> *
> *-----------------------------------------------------------------------------
> */
>
> Tcl_Obj*
> TclpTempFileNameForLibrary(Tcl_Interp* interp, /* Tcl interpreter */
> Tcl_Obj* path) /* Path name of the DLL in
> * the VFS */
> {
> size_t nameLen; /* Length of the temp folder name */
> WCHAR name[MAX_PATH]; /* Path name of the temp folder */
> BOOL status; /* Status from Win32 API calls */
> Tcl_Obj* fileName; /* Name of the temp file */
> Tcl_Obj* tail; /* Tail of the source path */
>
> /*
> * Determine the name of the directory to use, and create it.
> * (Keep trying with new names until an attempt to create the directory
> * succeeds)
> */
>
> nameLen = 0;
> if (dllDirectoryName == NULL) {
> Tcl_MutexLock(&pipeMutex);
> if (dllDirectoryName == NULL) {
> if ((nameLen = GetTempPathW(MAX_PATH, name)) >= 0) {
> if (nameLen >= MAX_PATH-12) {
> Tcl_SetErrno(ENAMETOOLONG);
> nameLen = 0;
> } else {
> wcscpy(name+nameLen, L"TCLXXXXXXXX");
> nameLen += 11;
> }
> }
> status = 1;
> if (nameLen != 0) {
> DWORD id;
> int i = 0;
> id = GetCurrentProcessId();
> for (;;) {
> DWORD lastError;
> wsprintfW(name+nameLen-8, L"%08x", id);
> status = CreateDirectoryW(name, NULL);
> if (status) {
> break;
> }
> if ((lastError = GetLastError()) != ERROR_ALREADY_EXISTS) {
> TclWinConvertError(lastError);
> break;
> } else if (++i > 256) {
> TclWinConvertError(lastError);
> break;
> }
> id *= 16777619;
> }
> }
> if (status != 0) {
> dllDirectoryName = (WCHAR*)
> ckalloc((nameLen+1) * sizeof(WCHAR));
> wcscpy(dllDirectoryName, name);
> }
> }
> Tcl_MutexUnlock(&pipeMutex);
> }
> if (dllDirectoryName == NULL) {
> Tcl_AppendResult(interp, "couldn't create temporary directory: ",
> Tcl_PosixError(interp), NULL);
> }
> fileName = TclpNativeToNormalized((ClientData) dllDirectoryName);
> tail = TclPathPart(interp, path, TCL_PATH_TAIL);
> if (tail == NULL) {
> Tcl_DecrRefCount(fileName);
> return NULL;
> } else {
> Tcl_AppendToObj(fileName, "/", 1);
> Tcl_AppendObjToObj(fileName, tail);
> return fileName;
> }
> }
>
> /*
