diff options
author | kennykb <kennykb@noemail.net> | 2010-04-02 21:21:03 (GMT) |
---|---|---|
committer | kennykb <kennykb@noemail.net> | 2010-04-02 21:21:03 (GMT) |
commit | 1d3c15759592c3b5b4bbc852f9c689b957065b7e (patch) | |
tree | fe391271cb3355eb790c38ed7e17ab484df92009 /generic/tclLoad.c | |
parent | d9d94dfaa0cddbe3b4d71eebc5ec645f397c26b9 (diff) | |
download | tcl-1d3c15759592c3b5b4bbc852f9c689b957065b7e.zip tcl-1d3c15759592c3b5b4bbc852f9c689b957065b7e.tar.gz tcl-1d3c15759592c3b5b4bbc852f9c689b957065b7e.tar.bz2 |
* generic/tcl.decls: [TIP #357]: First round of changes
* generic/tclDecls.h: to export Tcl_LoadFile, Tcl_FindSymbol,
* generic/tclIOUtil.c: and Tcl_FSUnloadFile to the public API.
* generic/tclInt.h:
* generic/tclLoad.c:
* generic/tclLoadNone.c:
* generic/tclStubInit.c:
* tests/fileSystem.test:
* tests/load.test:
* tests/unload.test:
* unix/tclLoadDl.c:
* unix/tclLoadDyld.c:
* unix/tclLoadNext.c:
* unix/tclLoadOSF.c:
* unix/tclLoadShl.c:
* unix/tclUnixPipe.c:
* win/Makefile.in:
* win/tclWinLoad.c:
FossilOrigin-Name: 80aa157f455c7e777a532f7a3fd791d38359f31d
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r-- | generic/tclLoad.c | 71 |
1 files changed, 20 insertions, 51 deletions
diff --git a/generic/tclLoad.c b/generic/tclLoad.c index e6e2ba5..8ba90ed 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLoad.c,v 1.24 2010/03/05 14:34:04 dkf Exp $ + * RCS: @(#) $Id: tclLoad.c,v 1.25 2010/04/02 21:21:06 kennykb Exp $ */ #include "tclInt.h" @@ -57,11 +57,6 @@ typedef struct LoadedPackage { * in trusted interpreters. */ int safeInterpRefCount; /* How many times the package has been loaded * in safe interpreters. */ - 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. */ struct LoadedPackage *nextPtr; /* Next in list of all packages loaded into * this application process. NULL means end of @@ -131,15 +126,12 @@ Tcl_LoadObjCmd( LoadedPackage *pkgPtr, *defaultPtr; Tcl_DString pkgName, tmp, initName, safeInitName; Tcl_DString unloadName, safeUnloadName; - Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc; InterpPackage *ipFirstPtr, *ipPtr; int code, namesMatch, filesMatch, offset; - const char *symbols[4]; - Tcl_PackageInitProc **procPtrs[4]; - ClientData clientData; + const char *symbols[2]; + void* procPtrs[1]; const char *p, *fullFileName, *packageName; Tcl_LoadHandle loadHandle; - Tcl_FSUnloadFileProc *unLoadProcPtr = NULL; Tcl_UniChar ch; if ((objc < 2) || (objc > 4)) { @@ -359,33 +351,15 @@ Tcl_LoadObjCmd( */ symbols[0] = Tcl_DStringValue(&initName); - 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; Tcl_MutexLock(&packageMutex); - code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs, - &loadHandle, &clientData, &unLoadProcPtr); + code = Tcl_LoadFile(interp, objv[1], symbols, 0, procPtrs, &loadHandle); Tcl_MutexUnlock(&packageMutex); - loadHandle = clientData; if (code != TCL_OK) { goto done; } - 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; - } - /* * Create a new record to describe this package. */ @@ -398,11 +372,14 @@ Tcl_LoadObjCmd( ckalloc((unsigned) (Tcl_DStringLength(&pkgName) + 1)); strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName)); pkgPtr->loadHandle = loadHandle; - 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)); pkgPtr->interpRefCount = 0; pkgPtr->safeInterpRefCount = 0; @@ -410,6 +387,11 @@ Tcl_LoadObjCmd( pkgPtr->nextPtr = firstPackagePtr; firstPackagePtr = pkgPtr; Tcl_MutexUnlock(&packageMutex); + /* + * The Tcl_FindSymbol calls may have left a spurious error message + * in the interpreter result. + */ + Tcl_ResetResult(interp); } /* @@ -787,14 +769,9 @@ Tcl_UnloadObjCmd( */ if (pkgPtr->fileName[0] != '\0') { - Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr; - if (unLoadProcPtr != NULL) { Tcl_MutexLock(&packageMutex); - if ((pkgPtr->unloadProc != NULL) || (unLoadProcPtr == TclFSUnloadTempFile)) { - unLoadProcPtr(pkgPtr->loadHandle); - } - + if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) { /* * Remove this library from the loaded library cache. */ @@ -839,9 +816,6 @@ Tcl_UnloadObjCmd( ckfree((char *) ipPtr); Tcl_MutexUnlock(&packageMutex); } else { - Tcl_AppendResult(interp, "file \"", fullFileName, - "\" cannot be unloaded: filesystem does not support unloading", - NULL); code = TCL_ERROR; } } @@ -1146,12 +1120,7 @@ TclFinalizeLoad(void) */ if (pkgPtr->fileName[0] != '\0') { - Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr; - if ((unLoadProcPtr != NULL) - && ((pkgPtr->unloadProc != NULL) - || (unLoadProcPtr == TclFSUnloadTempFile))) { - unLoadProcPtr(pkgPtr->loadHandle); - } + Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle); } #endif |