summaryrefslogtreecommitdiffstats
path: root/generic/tclLoad.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2016-11-25 15:06:13 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2016-11-25 15:06:13 (GMT)
commit889b8febfba9a5853a367eaf01fa14b4040087d7 (patch)
treeac31caa64067eb47d063456c7a53d6eeadd09f5a /generic/tclLoad.c
parentbd4ade16893719f146b31f467f5b1cbd2d7a393c (diff)
parent7b4af51ed2c67661856796cc6669052b86bda825 (diff)
downloadtcl-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.c27
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);