diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclPkg.c | 58 | ||||
| -rw-r--r-- | tests/pkg.test | 18 |
3 files changed, 75 insertions, 8 deletions
@@ -1,3 +1,10 @@ +2005-11-18 Don Porter <dgp@users.sourceforge.net> + + * generic/tclPkg.c: Revised Bug 1162286 fix from 2005-11-08 + * tests/pkg.test: to be more forgiving of package version + mismatch errors in [package ifneeded] commands. This reduces the + ***POTENTIAL INCOMPATIBILITY*** noted for that change. + 2005-11-18 Andreas Kupries <andreask@activestate.com> * generic/tclIO.c (TclFinalizeIOSubsystem): Applied Pat Thoyts' diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 0597179..6a46981 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.2.1 2005/11/08 18:28:56 dgp Exp $ + * RCS: @(#) $Id: tclPkg.c,v 1.9.2.2 2005/11/18 19:27:19 dgp Exp $ */ #include "tclInt.h" @@ -331,8 +331,8 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr) Tcl_Release((ClientData) script); pkgPtr = FindPackage(interp, name); if (code == TCL_OK) { - Tcl_ResetResult(interp); if (pkgPtr->version == NULL) { + Tcl_ResetResult(interp); code = TCL_ERROR; Tcl_AppendResult(interp, "attempt to provide package ", name, " ", versionToProvide, @@ -340,11 +340,55 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr) " 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); + /* At this point, it is clear that a prior + * [package ifneeded] command lied to us. It said + * that to get a particular version of a particular + * package, we needed to evaluate a particular script. + * However, we evaluated that script and got a different + * version than we were told. This is an error, and we + * ought to report it. + * + * However, we've been letting this type of error slide + * for a long time, and as a result, a lot of packages + * suffer from them. + * + * It's a bit too harsh to make a large number of + * existing packages start failing by releasing a + * new patch release, so we forgive this type of error + * for the rest of the Tcl 8.4 series, and only report + * a warning. We limit the error reporting to only + * the situation where a broken ifneeded script leads + * to a failure to satisfy the requirement. + */ + if (version) { + result = ComparePkgVersions( + pkgPtr->version, version, &satisfies); + if (result && (exact || !satisfies)) { + Tcl_ResetResult(interp); + code = TCL_ERROR; + Tcl_AppendResult(interp, + "attempt to provide package ", name, " ", + versionToProvide, " failed: package ", + name, " ", pkgPtr->version, + " provided instead", NULL); + } + } + if (code == TCL_OK) { + /* Forgiving the error, report warning instead */ + Tcl_Obj *msg = Tcl_NewStringObj( + "attempt to provide package ", -1); + Tcl_Obj *cmdPtr = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(NULL, cmdPtr, + Tcl_NewStringObj("tclLog", -1)); + Tcl_AppendStringsToObj(msg, name, " ", versionToProvide, + " failed: package ", name, " ", + pkgPtr->version, " provided instead", NULL); + Tcl_ListObjAppendElement(NULL, cmdPtr, msg); + Tcl_IncrRefCount(cmdPtr); + Tcl_GlobalEvalObj(interp, cmdPtr); + Tcl_DecrRefCount(cmdPtr); + Tcl_ResetResult(interp); + } } } else if (code != TCL_ERROR) { Tcl_Obj *codePtr = Tcl_NewIntObj(code); diff --git a/tests/pkg.test b/tests/pkg.test index 74f91be..0a7833f 100644 --- a/tests/pkg.test +++ b/tests/pkg.test @@ -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: pkg.test,v 1.9.12.1 2005/11/08 18:28:56 dgp Exp $ +# RCS: @(#) $Id: pkg.test,v 1.9.12.2 2005/11/18 19:27:19 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -351,6 +351,22 @@ test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package require foo 1 } -cleanup { package forget foo +} -match glob -result 1.1 -errorOutput {attempt to provide package * failed:*} +test pkg-2.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1.1 {package provide foo 1} + package require foo 1 +} -cleanup { + package forget foo +} -match glob -result 1 -errorOutput {attempt to provide package * failed:*} +test pkg-2.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup { + package forget foo +} -body { + package ifneeded foo 1.1 {package provide foo 1} + package require foo 1.1 +} -cleanup { + package forget foo } -returnCodes error -match glob -result {attempt to provide package * failed:*} test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup { package forget foo |