diff options
| -rw-r--r-- | doc/package.n | 4 | ||||
| -rw-r--r-- | generic/tclBasic.c | 5 | ||||
| -rw-r--r-- | generic/tclTest.c | 35 | ||||
| -rw-r--r-- | tests/package.test | 38 |
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 {} |