summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-11-08 18:28:56 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-11-08 18:28:56 (GMT)
commit50aa9cf6430fa3273369544087dea5fdf761e7a4 (patch)
tree0ec2a14e4ecc1b7e7511316b20a49da68dd4f7fe /generic
parentb896a6e4fe8cb265e2149fddf237aaec9f9c9c80 (diff)
downloadtcl-50aa9cf6430fa3273369544087dea5fdf761e7a4.zip
tcl-50aa9cf6430fa3273369544087dea5fdf761e7a4.tar.gz
tcl-50aa9cf6430fa3273369544087dea5fdf761e7a4.tar.bz2
* generic/tclPkg.c: Corrected inconsistencies in the value returned
* tests/pkg.test: by Tcl_PkgRequire(Ex) so that the returned values will always agree with what is stored in the package database. This way repeated calls to Tcl_PkgRequire(Ex) have the same results. Thanks to Hemang Lavana. [Bug 1162286]. * tests/namespace.test (25.7,8): Backport test of knownBug.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclPkg.c90
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);
}