Allow unstable Tcl releases to use unstable packages by default (this makes "package require Tk" find the expected 8.7a0 version in stead of 8.6). Make many "package" test-cases work even when the environment variable TCL_PKG_PREFER_LATEST is set.

4 files changed, 68 insertions, 14 deletions

diff --git a/doc/package.n b/doc/package.n
index a6a972f..47b2aa6 100644
--- a/doc/package.n
+++ b/doc/package.n
@@ -283,8 +283,8 @@ error.
 .PP
 When an interpreter is created, its initial selection mode value is set to
 .QW stable
-unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR
-is set.  If that environment variable is defined (with any value) then
+unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR is set
+(to any value) or the Tcl package itself is unstable. Otherwise
 the initial (and permanent) selection mode value is set to
 .QW latest .
 .RE
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e5d7406..505f6c2 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -580,11 +580,12 @@ Tcl_CreateInterp(void)
     iPtr->packageUnknown = NULL;
 
     /* TIP #268 */
+#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
     if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
 	iPtr->packagePrefer = PKG_PREFER_STABLE;
-    } else {
+    } else
+#endif
 	iPtr->packagePrefer = PKG_PREFER_LATEST;
-    }
 
     iPtr->cmdCount = 0;
     TclInitLiteralTable(&iPtr->literalTable);
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 4695ab5..7c30d36 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -323,6 +323,9 @@ static int		TestparsevarObjCmd(ClientData dummy,
 static int		TestparsevarnameObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+static int		TestpreferstableObjCmd(ClientData dummy,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
 static int		TestregexpObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -653,6 +656,8 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
 	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
+	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
@@ -3794,6 +3799,36 @@ TestparsevarnameObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TestpreferstableObjCmd --
+ *
+ *	This procedure implements the "testpreferstable" command.  It is
+ *	used for being able to test the "package" command even when the
+ *  environment variable TCL_PKG_PREFER_LATEST is set in your environment.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestpreferstableObjCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* The argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    iPtr->packagePrefer = PKG_PREFER_STABLE;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestregexpObjCmd --
  *
  *	This procedure implements the "testregexp" command. It is used to give
diff --git a/tests/package.test b/tests/package.test
index da778f1..49346d8 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -17,6 +17,11 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testpreferstable [llength [info commands testpreferstable]]
+
 # Do all this in a slave interp to avoid garbaging the package list
 set i [interp create]
 tcltest::loadIntoSlaveInterpreter $i {*}$argv
@@ -569,7 +574,8 @@ test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
 } -returnCodes error -cleanup {
     package forget demo
 } -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
-test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -setup {
+test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
+    testpreferstable
     package forget t
     set x xxx
 } -body {
@@ -1233,9 +1239,11 @@ proc prefer {args} {
     }
 }
 
-test package-13.0 {package prefer defaults} {
+test package-13.0 {package prefer defaults} -constraints testpreferstable -setup {
+    testpreferstable
+} -body {
     prefer
-} stable
+} -result stable
 test package-13.1 {package prefer defaults} -body {
     set ::env(TCL_PKG_PREFER_LATEST) stable	;# value not relevant!
     prefer
@@ -1250,15 +1258,25 @@ test package-14.1 {bogus argument} -returnCodes error -body {
     package prefer foo
 } -result {bad preference "foo": must be latest or stable}
 
-test package-15.0 {set, keep} {package prefer stable} stable
-test package-15.1 {set stable, keep} {prefer stable} {stable stable}
-test package-15.2 {set latest, change} {prefer latest} {stable latest}
-test package-15.3 {set latest, keep} {
+test package-15.0 {set, keep} -constraints testpreferstable -setup {
+    testpreferstable
+} -body {package prefer stable} -result stable
+test package-15.1 {set stable, keep} -constraints testpreferstable -setup {
+    testpreferstable
+} -body {prefer stable} -result {stable stable}
+test package-15.2 {set latest, change} -constraints testpreferstable -setup {
+    testpreferstable
+} -body {prefer latest} -result {stable latest}
+test package-15.3 {set latest, keep} -constraints testpreferstable -setup {
+    testpreferstable
+} -body {
     prefer latest latest
-} {stable latest latest}
-test package-15.4 {set stable, rejected} {
+} -result {stable latest latest}
+test package-15.4 {set stable, rejected} -constraints testpreferstable -setup {
+    testpreferstable
+} -body {
     prefer latest stable
-} {stable latest latest}
+} -result {stable latest latest}
 
 rename prefer {}