diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2016-11-25 15:06:13 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2016-11-25 15:06:13 (GMT) |
commit | 889b8febfba9a5853a367eaf01fa14b4040087d7 (patch) | |
tree | ac31caa64067eb47d063456c7a53d6eeadd09f5a /generic/tclLoad.c | |
parent | bd4ade16893719f146b31f467f5b1cbd2d7a393c (diff) | |
parent | 7b4af51ed2c67661856796cc6669052b86bda825 (diff) | |
download | tcl-889b8febfba9a5853a367eaf01fa14b4040087d7.zip tcl-889b8febfba9a5853a367eaf01fa14b4040087d7.tar.gz tcl-889b8febfba9a5853a367eaf01fa14b4040087d7.tar.bz2 |
Merge trunk.
Implementation looks complete. Still missing: test-cases and documentation.
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r-- | generic/tclLoad.c | 27 |
1 files changed, 20 insertions, 7 deletions
diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 184c158..2d8ed5f 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -397,12 +397,6 @@ Tcl_LoadObjCmd( goto done; } - if (target == interp) { - /* Only register the file if the load is done in the - * current interpreter */ - TclPkgFileSeen(target, Tcl_GetString(objv[1])); - } - /* * Create a new record to describe this package. */ @@ -1040,10 +1034,13 @@ int TclGetLoadedPackages( Tcl_Interp *interp, /* Interpreter in which to return information * or error message. */ - const char *targetName) /* Name of target interpreter or NULL. If + const char *targetName, /* Name of target interpreter or NULL. If * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ + const char *packageName) /* Package name or NULL. If NULL, return info + * all packages. + */ { Tcl_Interp *target; LoadedPackage *pkgPtr; @@ -1054,6 +1051,22 @@ TclGetLoadedPackages( /* * Return information about all of the available packages. */ + if (packageName) { + resultObj = NULL; + Tcl_MutexLock(&packageMutex); + for (pkgPtr = firstPackagePtr; pkgPtr != NULL; + pkgPtr = pkgPtr->nextPtr) { + if (!strcmp(packageName, pkgPtr->packageName)) { + resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1); + break; + } + } + Tcl_MutexUnlock(&packageMutex); + if (resultObj) { + Tcl_SetObjResult(interp, resultObj); + } + return TCL_OK; + } resultObj = Tcl_NewObj(); Tcl_MutexLock(&packageMutex); |