diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclPkg.c | 90 |
1 files changed, 76 insertions, 14 deletions
diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 43d859b..0597179 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.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: tclPkg.c,v 1.9 2002/02/22 22:36:09 dgp Exp $ + * RCS: @(#) $Id: tclPkg.c,v 1.9.2.1 2005/11/08 18:28:56 dgp Exp $ */ #include "tclInt.h" @@ -275,6 +275,21 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr) break; } + /* + * Check whether we're already attempting to load some version + * of this package (circular dependency detection). + */ + + if (pkgPtr->clientData != NULL) { + Tcl_AppendResult(interp, "circular package dependency: ", + "attempt to provide ", name, " ", + (char *)(pkgPtr->clientData), " requires ", name, NULL); + if (version != NULL) { + Tcl_AppendResult(interp, " ", version, NULL); + } + return NULL; + } + /* * The package isn't yet present. Search the list of available * versions and invoke the script for the best available version. @@ -306,20 +321,62 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr) * script itself from deletion and (b) don't assume that bestPtr * will still exist when the script completes. */ - + + CONST char *versionToProvide = bestPtr->version; script = bestPtr->script; + pkgPtr->clientData = (ClientData) versionToProvide; Tcl_Preserve((ClientData) script); + Tcl_Preserve((ClientData) versionToProvide); code = Tcl_GlobalEval(interp, script); Tcl_Release((ClientData) script); + pkgPtr = FindPackage(interp, name); + if (code == TCL_OK) { + Tcl_ResetResult(interp); + if (pkgPtr->version == NULL) { + code = TCL_ERROR; + Tcl_AppendResult(interp, "attempt to provide package ", + name, " ", versionToProvide, + " failed: no version of package ", name, + " provided", NULL); + } else if (0 != ComparePkgVersions( + pkgPtr->version, versionToProvide, NULL)) { + code = TCL_ERROR; + Tcl_AppendResult(interp, "attempt to provide package ", + name, " ", versionToProvide, " failed: package ", + name, " ", pkgPtr->version, " provided instead", + NULL); + } + } else if (code != TCL_ERROR) { + Tcl_Obj *codePtr = Tcl_NewIntObj(code); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "attempt to provide package ", + name, " ", versionToProvide, " failed: ", + "bad return code: ", Tcl_GetString(codePtr), NULL); + Tcl_DecrRefCount(codePtr); + code = TCL_ERROR; + } + Tcl_Release((ClientData) versionToProvide); + if (code != TCL_OK) { - if (code == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (\"package ifneeded\" script)"); + /* + * Take a non-TCL_OK code from the script as an + * indication the package wasn't loaded properly, + * so the package system should not remember an + * improper load. + * + * This is consistent with our returning NULL. + * If we're not willing to tell our caller we + * got a particular version, we shouldn't store + * that version for telling future callers either. + */ + Tcl_AddErrorInfo(interp, "\n (\"package ifneeded\" script)"); + if (pkgPtr->version != NULL) { + ckfree(pkgPtr->version); + pkgPtr->version = NULL; } + pkgPtr->clientData = NULL; return NULL; } - Tcl_ResetResult(interp); - pkgPtr = FindPackage(interp, name); break; } @@ -345,11 +402,16 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr) } code = Tcl_GlobalEval(interp, Tcl_DStringValue(&command)); Tcl_DStringFree(&command); - if (code != TCL_OK) { - if (code == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (\"package unknown\" script)"); - } + if ((code != TCL_OK) && (code != TCL_ERROR)) { + Tcl_Obj *codePtr = Tcl_NewIntObj(code); + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad return code: ", + Tcl_GetString(codePtr), NULL); + Tcl_DecrRefCount(codePtr); + code = TCL_ERROR; + } + if (code == TCL_ERROR) { + Tcl_AddErrorInfo(interp, "\n (\"package unknown\" script)"); return NULL; } Tcl_ResetResult(interp); @@ -559,7 +621,7 @@ Tcl_PackageObjCmd(dummy, interp, objc, objv) while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr->nextPtr; - ckfree(availPtr->version); + Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); ckfree((char *) availPtr); } @@ -878,7 +940,7 @@ TclFreePackageInfo(iPtr) while (pkgPtr->availPtr != NULL) { availPtr = pkgPtr->availPtr; pkgPtr->availPtr = availPtr->nextPtr; - ckfree(availPtr->version); + Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC); Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC); ckfree((char *) availPtr); } |