diff options
author | vincentdarley <vincentdarley@noemail.net> | 2001-07-31 19:12:04 (GMT) |
---|---|---|
committer | vincentdarley <vincentdarley@noemail.net> | 2001-07-31 19:12:04 (GMT) |
commit | 16cc527b43d56661fd8dc1535abb41bd62961dd7 (patch) | |
tree | 1ec44ca71eb2e561881490f7766175daa65dc9eb /generic/tclLoad.c | |
parent | da1c0e8f3adf4497ec80603daba3679e7e2196a1 (diff) | |
download | tcl-16cc527b43d56661fd8dc1535abb41bd62961dd7.zip tcl-16cc527b43d56661fd8dc1535abb41bd62961dd7.tar.gz tcl-16cc527b43d56661fd8dc1535abb41bd62961dd7.tar.bz2 |
Changes from TIP#17 "Redo Tcl's filesystem"
The following files were impacted.
* doc/Access.3:
* doc/FileSystem.3:
* doc/OpenFileChnl.3:
* doc/file.n:
* doc/glob.n:
* generic/tcl.decls:
* generic/tcl.h:
* generic/tclCmdAH.c:
* generic/tclCmdIL.c:
* generic/tclCmdMZ.c:
* generic/tclDate.c:
* generic/tclDecls.h:
* generic/tclEncoding.c:
* generic/tclFCmd.c:
* generic/tclFileName.c:
* generic/tclGetDate.y:
* generic/tclIO.c:
* generic/tclIOCmd.c:
* generic/tclIOUtil.c:
* generic/tclInt.decls:
* generic/tclInt.h:
* generic/tclIntDecls.h:
* generic/tclLoad.c:
* generic/tclStubInit.c:
* generic/tclTest.c:
* generic/tclUtil.c:
* library/init.tcl:
* mac/tclMacFCmd.c:
* mac/tclMacFile.c:
* mac/tclMacInit.c:
* mac/tclMacPort.h:
* mac/tclMacResource.c:
* mac/tclMacTime.c:
* tests/cmdAH.test:
* tests/event.test:
* tests/fCmd.test:
* tests/fileName.test:
* tests/io.test:
* tests/ioCmd.test:
* tests/proc-old.test:
* tests/registry.test:
* tests/unixFCmd.test:
* tests/winDde.test:
* tests/winFCmd.test:
* unix/mkLinks:
* unix/tclUnixFCmd.c:
* unix/tclUnixFile.c:
* unix/tclUnixInit.c:
* unix/tclUnixPipe.c:
* win/tclWinFCmd.c:
* win/tclWinFile.c:
* win/tclWinInit.c:
* win/tclWinPipe.c
FossilOrigin-Name: 9461aca54800a289624dfe39d333e41e20168ac3
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r-- | generic/tclLoad.c | 38 |
1 files changed, 25 insertions, 13 deletions
diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 3b36b9c..9dd9975 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.4 1999/12/01 00:08:28 hobbs Exp $ + * RCS: @(#) $Id: tclLoad.c,v 1.5 2001/07/31 19:12:06 vincentdarley Exp $ */ #include "tclInt.h" @@ -19,7 +19,8 @@ * either dynamically (with the "load" command) or statically (as * indicated by a call to TclGetLoadedPackages). All such packages * are linked together into a single list for the process. Packages - * are never unloaded, so these structures are never freed. + * are never unloaded, until the application exits, when + * TclFinalizeLoad is called, and these structures are freed. */ typedef struct LoadedPackage { @@ -32,7 +33,7 @@ typedef struct LoadedPackage { * others LC), no "_", as in "Net". * Malloc-ed. */ ClientData clientData; /* Token for the loaded file which should be - * passed to TclpUnloadFile() when the file + * passed to (*unLoadProcPtr)() when the file * is no longer needed. If fileName is NULL, * then this field is irrelevant. */ Tcl_PackageInitProc *initProc; @@ -46,6 +47,11 @@ typedef struct LoadedPackage { * untrusted scripts). NULL means the * package can't be used in unsafe * interpreters. */ + Tcl_FSUnloadFileProc *unLoadProcPtr; + /* Procedure 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 @@ -113,12 +119,13 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) { Tcl_Interp *target; LoadedPackage *pkgPtr, *defaultPtr; - Tcl_DString pkgName, tmp, initName, safeInitName, fileName; + Tcl_DString pkgName, tmp, initName, safeInitName; Tcl_PackageInitProc *initProc, *safeInitProc; InterpPackage *ipFirstPtr, *ipPtr; int code, namesMatch, filesMatch; - char *p, *tempString, *fullFileName, *packageName; + char *p, *fullFileName, *packageName; ClientData clientData; + Tcl_FSUnloadFileProc *unLoadProcPtr = NULL; Tcl_UniChar ch; int offset; @@ -126,11 +133,11 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?"); return TCL_ERROR; } - tempString = Tcl_GetString(objv[1]); - fullFileName = Tcl_TranslateFileName(interp, tempString, &fileName); - if (fullFileName == NULL) { + if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } + fullFileName = Tcl_GetString(objv[1]); + Tcl_DStringInit(&pkgName); Tcl_DStringInit(&initName); Tcl_DStringInit(&safeInitName); @@ -328,9 +335,9 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) */ Tcl_MutexLock(&packageMutex); - code = TclpLoadFile(interp, fullFileName, Tcl_DStringValue(&initName), + code = Tcl_FSLoadFile(interp, objv[1], Tcl_DStringValue(&initName), Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc, - &clientData); + &clientData,&unLoadProcPtr); Tcl_MutexUnlock(&packageMutex); if (code != TCL_OK) { goto done; @@ -338,7 +345,9 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) if (initProc == NULL) { Tcl_AppendResult(interp, "couldn't find procedure ", Tcl_DStringValue(&initName), (char *) NULL); - TclpUnloadFile(clientData); + if (unLoadProcPtr != NULL) { + (*unLoadProcPtr)(clientData); + } code = TCL_ERROR; goto done; } @@ -355,6 +364,7 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) (Tcl_DStringLength(&pkgName) + 1)); strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName)); pkgPtr->clientData = clientData; + pkgPtr->unLoadProcPtr = unLoadProcPtr; pkgPtr->initProc = initProc; pkgPtr->safeInitProc = safeInitProc; Tcl_MutexLock(&packageMutex); @@ -410,7 +420,6 @@ Tcl_LoadObjCmd(dummy, interp, objc, objv) Tcl_DStringFree(&pkgName); Tcl_DStringFree(&initName); Tcl_DStringFree(&safeInitName); - Tcl_DStringFree(&fileName); Tcl_DStringFree(&tmp); return code; } @@ -653,7 +662,10 @@ TclFinalizeLoad() * call a function in the dll after it's been unloaded. */ if (pkgPtr->fileName[0] != '\0') { - TclpUnloadFile(pkgPtr->clientData); + Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr; + if (unLoadProcPtr != NULL) { + (*unLoadProcPtr)(pkgPtr->clientData); + } } #endif ckfree(pkgPtr->fileName); |