[5d6de65036] [package require] with [package prefer stable] was not choosing available stable package.

2 files changed, 81 insertions, 46 deletions

diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index eb4dc9b..ea95320 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -418,7 +418,7 @@ PkgRequireCore(
     Interp *iPtr = (Interp *) interp;
     Package *pkgPtr;
     PkgAvail *availPtr, *bestPtr, *bestStablePtr;
-    char *availVersion, *bestVersion;
+    char *availVersion, *bestVersion, *bestStableVersion;
 				/* Internal rep. of versions */
     int availStable, code, satisfies, pass;
     char *script, *pkgVersionI;
@@ -466,6 +466,7 @@ PkgRequireCore(
 	bestPtr = NULL;
 	bestStablePtr = NULL;
 	bestVersion = NULL;
+	bestStableVersion = NULL;
 
 	for (availPtr = pkgPtr->availPtr; availPtr != NULL;
 		availPtr = availPtr->nextPtr) {
@@ -479,60 +480,82 @@ PkgRequireCore(
 
 		continue;
 	    }
-
+	    
+	    /* Check satisfaction of requirements before considering the current version further. */
+	    if (reqc > 0) {
+		satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
+		if (!satisfies) {
+		    ckfree(availVersion);
+		    availVersion = NULL;
+		    continue;
+		}
+	    }
+	    
 	    if (bestPtr != NULL) {
 		int res = CompareVersions(availVersion, bestVersion, NULL);
 
 		/*
-		 * Note: Use internal reps!
+		 * Note: Used internal reps in the comparison!
 		 */
 
-		if (res <= 0) {
+		if (res > 0) {
 		    /*
-		     * The version of the package sought is not as good as the
-		     * currently selected version. Ignore it.
+		     * The version of the package sought is better than the
+		     * currently selected version.
 		     */
-
-		    ckfree(availVersion);
-		    availVersion = NULL;
-		    continue;
+		    goto newbest;
 		}
-	    }
-
-	    /*
-	     * We have found a version which is better than our max.
-	     */
-
-	    if (reqc > 0) {
-		/* Check satisfaction of requirements. */
+	    } else {
+	    newbest:
+		/* We have found a version which is better than our max. */
 
-		satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
-		if (!satisfies) {
-		    ckfree(availVersion);
-		    availVersion = NULL;
-		    continue;
-		}
+		bestPtr = availPtr;
+		CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
 	    }
 
-	    bestPtr = availPtr;
-
-	    if (bestVersion != NULL) {
-		ckfree(bestVersion);
+	    if (!availStable) {
+		ckfree(availVersion);
+		availVersion = NULL;
+		continue;
 	    }
-	    bestVersion = availVersion;
 
-	    /*
-	     * If this new best version is stable then it also has to be
-	     * better than the max stable version found so far.
-	     */
+	    if (bestStablePtr != NULL) {
+		int res = CompareVersions(availVersion, bestStableVersion, NULL);
+
+		/*
+		 * Note: Used internal reps in the comparison!
+		 */
 
-	    if (availStable) {
+		if (res > 0) {
+		    /*
+		     * This stable version of the package sought is better
+		     * than the currently selected stable version.
+		     */
+		    goto newstable;
+		}
+	    } else {
+	    newstable:
+		/* We have found a stable version which is better than our max stable. */
 		bestStablePtr = availPtr;
+		CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);
 	    }
-	}
 
+	    ckfree(availVersion);
+	    availVersion = NULL;
+	} /* end for */
+
+	/*
+	 * Clean up memorized internal reps, if any.
+	 */
+	
 	if (bestVersion != NULL) {
 	    ckfree(bestVersion);
+	    bestVersion = NULL;
+	}
+
+	if (bestStableVersion != NULL) {
+	    ckfree(bestStableVersion);
+	    bestStableVersion = NULL;
 	}
 
 	/*
diff --git a/tests/package.test b/tests/package.test
index 99f9f06..faa15ec 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -139,7 +139,7 @@ test package-3.1 {Tcl_PkgRequire procedure, picking best version} -setup {
 	package ifneeded t $i "set x $i; package provide t $i"
     }
     package require t
-    return $x
+    set x
 } -result {3.4}
 test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
     package forget t
@@ -149,7 +149,7 @@ test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
 	package ifneeded t $i "set x $i; package provide t $i"
     }
     package require t
-    return $x
+    set x
 } -result {3.5}
 test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
     package forget t
@@ -159,7 +159,7 @@ test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
 	package ifneeded t $i "set x $i; package provide t $i"
     }
     package require t 2.2
-    return $x
+    set x
 } -result {2.3}
 test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
     package forget t
@@ -169,7 +169,7 @@ test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
 	package ifneeded t $i "set x $i; package provide t $i"
     }
     package require -exact t 2.3
-    return $x
+    set x
 } -result {2.3}
 test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
     package forget t
@@ -179,7 +179,7 @@ test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
 	package ifneeded t $i "set x $i; package provide t $i"
     }
     package require t 2.1
-    return $x
+    set x
 } -result {2.4}
 test package-3.6 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
     package forget t
@@ -238,7 +238,7 @@ test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup {
 } -body {
     package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
     package require t 1.2
-    return $x
+    set x
 } -result {1.2}
 test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
     package forget t
@@ -256,7 +256,7 @@ test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
     }
     package unknown pkgUnknown
     package require -exact t 1.5
-    return $x
+    set x
 } -cleanup {
     package unknown {}
 } -result {t 1.5-1.5}
@@ -283,7 +283,7 @@ test package-3.15 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
 	package provide [lindex $args 0] 2.0
     }
     package require {a b}
-    return $x
+    set x
 } -cleanup {
     package unknown {}
 } -result {{a b} 0-}
@@ -583,7 +583,7 @@ test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -const
 	package ifneeded t $i "set x $i; package provide t $i"
     }
     package require t
-    return $x
+    set x
 } -result {3.4}
 test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup {
     package forget t
@@ -593,7 +593,7 @@ test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup
 	package ifneeded t $i "set x $i; package provide t $i"
     }
     package require t
-    return $x
+    set x
 } -result {1.3}
 test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup {
     package forget t
@@ -603,8 +603,20 @@ test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup
 	package ifneeded t $i "set x $i; package provide t $i"
     }
     package require t
-    return $x
+    set x
 } -result {1.3}
+test pkg-3.53 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
+    testpreferstable
+    package forget t
+    set x xxx
+} -body {
+    foreach i {1.2b1 1.1} {
+        package ifneeded t $i "set x $i; package provide t $i"
+    }
+    package require t
+    set x
+} -result {1.1}
+
 
 test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
     package