diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2011-05-07 23:08:43 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2011-05-07 23:08:43 (GMT) |
commit | 8a15407fcc66e89fab893e964d8ad44fd98f55b7 (patch) | |
tree | 9196af59e8bbe589a5f619c14bbd050da1e769ae /generic/tclLoad.c | |
parent | 1b5ae0d580bc997899052269bd9bf5a351ce2254 (diff) | |
download | tcl-8a15407fcc66e89fab893e964d8ad44fd98f55b7.zip tcl-8a15407fcc66e89fab893e964d8ad44fd98f55b7.tar.gz tcl-8a15407fcc66e89fab893e964d8ad44fd98f55b7.tar.bz2 |
Convert TclGetLoadedPackages to use Tcl_Obj API for result generation.
Diffstat (limited to 'generic/tclLoad.c')
-rw-r--r-- | generic/tclLoad.c | 78 |
1 files changed, 40 insertions, 38 deletions
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; } |