summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-05-07 23:08:43 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-05-07 23:08:43 (GMT)
commit8a15407fcc66e89fab893e964d8ad44fd98f55b7 (patch)
tree9196af59e8bbe589a5f619c14bbd050da1e769ae
parent1b5ae0d580bc997899052269bd9bf5a351ce2254 (diff)
downloadtcl-8a15407fcc66e89fab893e964d8ad44fd98f55b7.zip
tcl-8a15407fcc66e89fab893e964d8ad44fd98f55b7.tar.gz
tcl-8a15407fcc66e89fab893e964d8ad44fd98f55b7.tar.bz2
Convert TclGetLoadedPackages to use Tcl_Obj API for result generation.
-rw-r--r--ChangeLog9
-rw-r--r--generic/tclLoad.c78
2 files changed, 47 insertions, 40 deletions
diff --git a/ChangeLog b/ChangeLog
index 5e143a3..beb227c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2011-05-07 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclLoad.c (TclGetLoadedPackages): Convert to use Tcl_Obj API
+ for result generation.
+
2011-05-07 Miguel Sofer <msofer@users.sf.net>
* generic/tclInt.h: fix USE_TCLALLOC so that it can be enabled
@@ -23,7 +28,7 @@
* generic/tclListObj.c: of a boolean var, where the caller can be told
* generic/tclParse.c: whether or not the parsed list element was
* generic/tclUtil.c: enclosed in braces. In practice, no callers
- really care about that. What the callers really want to know is
+ really care about that. What the callers really want to know is
whether the list element value exists as a literal substring of the
string being parsed, or whether a call to TclCopyAndCollpase() is
needed to produce the list element value. Now the final argument
@@ -61,7 +66,7 @@
* generic/tclStrToD.c:
* generic/tclUtf.c:
* unix/tclUnixFile.c:
-
+
* generic/tclStringObj.c: Improved reaction to out of memory.
2011-04-27 Don Porter <dgp@users.sourceforge.net>
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 707d6ec..820707e 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -435,36 +435,40 @@ Tcl_LoadObjCmd(
}
/*
- * Record the fact that the package has been loaded in the target
- * interpreter.
+ * Test for whether the initialization failed. If so, transfer the error
+ * from the target interpreter to the originating one.
*/
- if (code == TCL_OK) {
- /*
- * Update the proper reference count.
- */
-
- Tcl_MutexLock(&packageMutex);
- if (Tcl_IsSafe(target)) {
- pkgPtr->safeInterpRefCount++;
- } else {
- pkgPtr->interpRefCount++;
- }
- Tcl_MutexUnlock(&packageMutex);
+ if (code != TCL_OK) {
+ Tcl_TransferResult(target, code, interp);
+ goto done;
+ }
- /*
- * Refetch ipFirstPtr: loading the package may have introduced
- * additional static packages at the head of the linked list!
- */
+ /*
+ * Record the fact that the package has been loaded in the target
+ * interpreter.
+ *
+ * Update the proper reference count.
+ */
- ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
- ipPtr = ckalloc(sizeof(InterpPackage));
- ipPtr->pkgPtr = pkgPtr;
- ipPtr->nextPtr = ipFirstPtr;
- Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
+ Tcl_MutexLock(&packageMutex);
+ if (Tcl_IsSafe(target)) {
+ pkgPtr->safeInterpRefCount++;
} else {
- Tcl_TransferResult(target, code, interp);
+ pkgPtr->interpRefCount++;
}
+ Tcl_MutexUnlock(&packageMutex);
+
+ /*
+ * Refetch ipFirstPtr: loading the package may have introduced additional
+ * static packages at the head of the linked list!
+ */
+
+ ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
+ ipPtr = ckalloc(sizeof(InterpPackage));
+ ipPtr->pkgPtr = pkgPtr;
+ ipPtr->nextPtr = ipFirstPtr;
+ Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
done:
Tcl_DStringFree(&pkgName);
@@ -1031,28 +1035,27 @@ TclGetLoadedPackages(
* otherwise, just return info about this
* interpreter. */
{
- /* TODO: Use Tcl_Obj APIs to generate this info for cleanliness. */
Tcl_Interp *target;
LoadedPackage *pkgPtr;
InterpPackage *ipPtr;
- const char *prefix;
+ Tcl_Obj *resultObj, *pkgDesc[2];
if (targetName == NULL) {
/*
* Return information about all of the available packages.
*/
- prefix = "{";
+ resultObj = Tcl_NewObj();
Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
pkgPtr = pkgPtr->nextPtr) {
- Tcl_AppendResult(interp, prefix, NULL);
- Tcl_AppendElement(interp, pkgPtr->fileName);
- Tcl_AppendElement(interp, pkgPtr->packageName);
- Tcl_AppendResult(interp, "}", NULL);
- prefix = " {";
+ pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewListObj(2, pkgDesc));
}
Tcl_MutexUnlock(&packageMutex);
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
@@ -1066,15 +1069,14 @@ TclGetLoadedPackages(
return TCL_ERROR;
}
ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
- prefix = "{";
+ resultObj = Tcl_NewObj();
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
pkgPtr = ipPtr->pkgPtr;
- Tcl_AppendResult(interp, prefix, NULL);
- Tcl_AppendElement(interp, pkgPtr->fileName);
- Tcl_AppendElement(interp, pkgPtr->packageName);
- Tcl_AppendResult(interp, "}", NULL);
- prefix = " {";
+ pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
+ pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
+ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));
}
+ Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}