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);
 	}