A little more errorCode goodness

2 files changed, 15 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index 1c74f54..81a3205 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2007-10-21  Donal K. Fellows  <donal.k.fellows@manchester.ac.uk>
+
+	* generic/various: Start to return more useful Error codes, currently
+	mainly on assorted lookup failures.
+
 2007-11-20  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclDictObj.c: Changed the underlying implementation of the
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index abc0070..8431eca 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -10,7 +10,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.32 2007/11/18 22:30:10 dkf Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.33 2007/11/21 11:22:01 dkf Exp $
  *
  * TIP #268.
  * Heavily rewritten to handle the extend version numbers, and extended
@@ -690,15 +690,20 @@ Tcl_PkgPresentEx(
     if (hPtr) {
 	pkgPtr = Tcl_GetHashValue(hPtr);
 	if (pkgPtr->version != NULL) {
-
 	    /*
 	     * At this point we know that the package is present. Make sure
 	     * that the provided version meets the current requirement by
 	     * calling Tcl_PkgRequireEx() to check for us.
 	     */
 
-	    return Tcl_PkgRequireEx(interp, name, version, exact,
-		    clientDataPtr);
+	    const char *foundVersion = Tcl_PkgRequireEx(interp, name, version,
+		    exact, clientDataPtr);
+
+	    if (foundVersion == NULL) {
+		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name,
+			NULL);
+	    }
+	    return foundVersion;
 	}
     }
 
@@ -708,6 +713,7 @@ Tcl_PkgPresentEx(
     } else {
 	Tcl_AppendResult(interp, "package ", name, " is not present", NULL);
     }
+    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
     return NULL;
 }