Index: doc/PkgRequire.3 =================================================================== RCS file: /cvsroot/tcl/doc/PkgRequire.3,v retrieving revision 1.3 diff -c -r1.3 PkgRequire.3 *** PkgRequire.3 1999/03/10 05:52:45 1.3 --- PkgRequire.3 1999/08/20 01:25:39 *************** *** 7,16 **** '\" RCS: @(#) $Id: PkgRequire.3,v 1.3 1999/03/10 05:52:45 stanton Exp $ '\" .so man.macros ! .TH Tcl_PkgRequire 3 7.5 Tcl "Tcl Library Procedures" .BS .SH NAME ! Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvide, Tcl_PkgProvideEx \- package version control .SH SYNOPSIS .nf \fB#include \fR --- 7,16 ---- '\" RCS: @(#) $Id: PkgRequire.3,v 1.3 1999/03/10 05:52:45 stanton Exp $ '\" .so man.macros ! .TH Tcl_PkgRequire 3 8.3 Tcl "Tcl Library Procedures" .BS .SH NAME ! Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvide, Tcl_PkgProvideEx, Tcl_PkgGetThreshold, Tcl_PkgSetThreshold \- package version control .SH SYNOPSIS .nf \fB#include \fR *************** *** 32,37 **** --- 32,45 ---- .sp int \fBTcl_PkgProvideEx\fR(\fIinterp, name, version, clientData\fR) + .sp + .VS 8.3 + int + \fBTcl_PkgGetThreshold\fR(\fIinterp, name\fR) + .sp + int + \fBTcl_PkgSetThreshold\fR(\fIinterp, name, threshold\fR) + .VE .SH ARGUMENTS .AS Tcl_FreeProc clientDataPtr .AP Tcl_Interp *interp in *************** *** 53,58 **** --- 61,71 ---- Pointer to place to store the value associated with the matching package. It is only changed if the pointer is not NULL and the function completed successfully. + .VS 8.3 + .AP int threshold in + Threshold value, one of TCL_ALPHA_RELEASE, TCL_BETA_RELEASE, or + TCL_FINAL_RELEASE. + .VE .BE .SH DESCRIPTION *************** *** 63,70 **** \fBTcl_PkgRequire\fR is equivalent to the \fBpackage require\fR command, \fBTcl_PkgPresent\fR is equivalent to the \fBpackage present\fR command, and \fBTcl_PkgProvide\fR is equivalent to the ! \fBpackage provide\fR command. .PP See the documentation for the Tcl commands for details on what these procedures do. .PP --- 76,88 ---- \fBTcl_PkgRequire\fR is equivalent to the \fBpackage require\fR command, \fBTcl_PkgPresent\fR is equivalent to the \fBpackage present\fR command, and \fBTcl_PkgProvide\fR is equivalent to the ! \fBpackage provide\fR command. ! .VS 8.3 ! \fBTcl_PkgGetThreshold\fR and ! \fBTcl_PkgSetThreshold\fR are equivalent to the \fBpackage threshold\fR ! command. .PP + .VE See the documentation for the Tcl commands for details on what these procedures do. .PP *************** *** 82,87 **** allow the setting and retrieving of the client data associated with the package. In all other respects they are equivalent to the matching functions. .SH KEYWORDS ! package, present, provide, require, version --- 100,112 ---- allow the setting and retrieving of the client data associated with the package. In all other respects they are equivalent to the matching functions. + .PP + .VS 8.3 + \fBTcl_PkgGetThreshold\fR returns the threshold value associated with + a package. \fBTcl_PkgSetThreshold\fR sets the threshold value + associated with a package. Valid threshold values are TCL_ALPHA_RELEASE, + TCL_BETA_RELEASE, and TCL_FINAL_RELEASE. + .VE .SH KEYWORDS ! package, present, provide, require, version, threshold Index: doc/package.n =================================================================== RCS file: /cvsroot/tcl/doc/package.n,v retrieving revision 1.3 diff -c -r1.3 package.n *** package.n 1999/03/10 05:52:45 1.3 --- package.n 1999/08/20 01:25:39 *************** *** 7,13 **** '\" RCS: @(#) $Id: package.n,v 1.3 1999/03/10 05:52:45 stanton Exp $ '\" .so man.macros ! .TH package n 7.5 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME --- 7,13 ---- '\" RCS: @(#) $Id: package.n,v 1.3 1999/03/10 05:52:45 stanton Exp $ '\" .so man.macros ! .TH package n 8.3 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME *************** *** 20,29 **** \fBpackage present \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR? \fBpackage provide \fIpackage \fR?\fIversion\fR? \fBpackage require \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR? \fBpackage unknown \fR?\fIcommand\fR? \fBpackage vcompare \fIversion1 version2\fR \fBpackage versions \fIpackage\fR ! \fBpackage vsatisfies \fIversion1 version2\fR .fi .BE --- 20,34 ---- \fBpackage present \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR? \fBpackage provide \fIpackage \fR?\fIversion\fR? \fBpackage require \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR? + .VS 8.3 + \fBpackage threshold \fIpackage \fR?\fIthreshold\fR? + .VE \fBpackage unknown \fR?\fIcommand\fR? \fBpackage vcompare \fIversion1 version2\fR \fBpackage versions \fIpackage\fR ! .VS 8.3 ! \fBpackage vsatisfies \fIversion1 version2 \fR?\fIthreshold\fR? ! .VE .fi .BE *************** *** 99,117 **** a suitable version of the package is loaded into the interpreter. If the command succeeds, it returns the version number that is loaded; otherwise it generates an error. ! If both the \fB\-exact\fR ! switch and the \fIversion\fR argument are specified then only the ! given version is acceptable. If \fB\-exact\fR is omitted but ! \fIversion\fR is specified, then versions later than \fIversion\fR ! are also acceptable as long as they have the same major version ! number as \fIversion\fR. ! If both \fB\-exact\fR and \fIversion\fR are omitted then any ! version whatsoever is acceptable. ! If a version of \fIpackage\fR has already been provided (by invoking ! the \fBpackage provide\fR command), then its version number must ! satisfy the criteria given by \fB\-exact\fR and \fIversion\fR and ! the command returns immediately. ! Otherwise, the command searches the database of information provided by previous \fBpackage ifneeded\fR commands to see if an acceptable version of the package is available. If so, the script for the highest acceptable version number is invoked; --- 104,151 ---- a suitable version of the package is loaded into the interpreter. If the command succeeds, it returns the version number that is loaded; otherwise it generates an error. ! ! .VS 8.3 ! If the \fB\-exact\fR ! switch is specified then the \fIversion\fR argument must also ! be specified and only a release of the given version is acceptable. ! ! If \fB\-exact\fR is omitted then the set of acceptable releases ! is determined by the threshold associated with \fIpackage\fR ! (see \fBpackage threshold\fR) and the value of \fIversion\fR, ! if any. The threshold is used to rule out some releases as ! unacceptable. ! The threshold value is one of \fBstable\fR, \fBbeta\fR, ! or \fBalpha\fR. If the threshold associated with ! \fIpackage\fR is \fBstable\fR, both alpha and beta releases ! are deemed unacceptable (see VERSION NUMBERS). That is the default. ! If the threshold associated with ! \fIpackage\fR has been set to \fBbeta\fR ! (by a previous call to \fBpackage threshold\fR), then ! only alpha releases are deemed unacceptable. ! If the threshold associated with ! \fIpackage\fR has been set to \fBalpha\fR, then no releases ! are deemed unacceptable by the threshold. ! The value of \fIversion\fR is used to determine ! which of the remaining releases are acceptable. ! If no value of \fIversion\fR is specified, all remaining ! releases are acceptable. If ! \fIversion\fR is specified, then those remaining releases with ! versions later than \fIversion\fR are acceptable as long as they ! have the same major version number as \fIversion\fR. ! ! If a release of \fIpackage\fR has already been provided (by invoking ! the \fBpackage provide\fR command), then it must be acceptable by ! the criteria determined by \fB\-exact\fR, \fIversion\fR, and ! the threshold for the package. If ! so, the command returns immediately. If not, the command ! returns an error with a message noting the incompatibility ! of the release which has already been provided with the needs ! expressed by this \fBpackage require\fR command. ! ! If no release of \fIpackage\fR has been provided yet, ! the command searches the database of information provided by ! .VE previous \fBpackage ifneeded\fR commands to see if an acceptable version of the package is available. If so, the script for the highest acceptable version number is invoked; *************** *** 124,129 **** --- 158,176 ---- or if there is a \fBpackage ifneeded\fR script for it. If all of these steps fail to provide an acceptable version of the package, then the command returns an error. + .VS 8.3 br + .TP + \fBpackage threshold \fIpackage\fR ?\fIthreshold\fR? + This command is used to set the threshold value + associated with \fIpackage\fR. If the \fIthreshold\fR + argument is supplied, it must be one of + \fBstable\fR, \fBbeta\fR, or \fBalpha\fR. The threshold + value will influence future invocations of + \fBpackage require \fIpackage\fR as discussed above. + If the \fIthreshold\fR argument is omitted, the command + returns the current threshold value associated with + \fIpackage\fR. + .VE .TP \fBpackage unknown \fR?\fIcommand\fR? This command supplies a ``last resort'' command to invoke during *************** *** 153,184 **** Returns a list of all the version numbers of \fIpackage\fR for which information has been provided by \fBpackage ifneeded\fR commands. .TP ! \fBpackage vsatisfies \fIversion1 version2\fR ! Returns 1 if scripts written for \fIversion2\fR will work unchanged ! with \fIversion1\fR (i.e. \fIversion1\fR is equal to or greater ! than \fIversion2\fR and they both have the same major version ! number), 0 otherwise. .SH "VERSION NUMBERS" .PP ! Version numbers consist of one or more decimal numbers separated ! by dots, such as 2 or 1.162 or 3.1.13.1. The first number is called the major version number. ! Larger numbers correspond to later versions of a package, with ! leftmost numbers having greater significance. For example, version 2.1 is later than 1.3 and version 3.4.6 is later than 3.3.5. Missing fields are equivalent to zeroes: version 1.3 is the same as version 1.3.0 and 1.3.0.0, so it is earlier than 1.3.1 or 1.3.0.2. ! A later version number is assumed to be upwards compatible with ! an earlier version number as long as both versions have the same major version number. For example, Tcl scripts written for version 2.3 of a package should work unchanged under versions 2.3.2, 2.4, and 2.5.1. Changes in the major version number signify incompatible changes: if code is written to use version 2.1 of a package, it is not guaranteed to work unmodified with either version 1.7.3 or version 3.1. .SH "PACKAGE INDICES" .PP --- 200,291 ---- Returns a list of all the version numbers of \fIpackage\fR for which information has been provided by \fBpackage ifneeded\fR commands. + .VS 8.3 br .TP ! \fBpackage vsatisfies \fIversion1 version2\fR ?\fIthreshold\fR? ! This command performs the same tests as \fBpackage require\fR ! to determine whether a release with version number \fIversion1\fR ! would be acceptable given a requirement of \fIversion2\fR and ! a threshold value of \fIthreshold\fR. If the \fIthreshold\fR ! argument is omitted, a value of \fBstable\fR is assumed. ! This command returns 1 if a release of version \fIversion1\fR ! is acceptable, 0 otherwise. ! .VE .SH "VERSION NUMBERS" .PP ! .VS 8.3 ! Each release of a package should be labeled with a unique ! version number. ! Version numbers are strings made up of ! one or more decimal numbers joined together by the ! the characters ".", "a", or "b". Examples of version numbers ! are 2 or 1.162 or 3.1.13.1 or 8.3a1 or 1a35b7. ! Version numbers must begin and end with a decimal number. The first number is called the major version number. ! Version numbers may not have two or more non-digits adjacent ! to one another. The strings ".1", "1.0.3.", "1.a3", and "1ab6" ! are not valid version numbers. ! .PP ! Package releases may be divided into exactly three classes ! on the basis of their version numbers. Stable releases ! are those releases labeled with a version number which does ! not contain the characters "a" or "b". Beta releases are those ! releases labeled with a version number which does contain the ! character "b", but does not contain the character "a". Alpha ! releases are labeled with a version number which contains the ! character "a". ! .PP ! Version numbers are ordered. Given two version numbers, the first ! is either less than (earlier than), equal to, or greater than ! (later than) the second. The version numbers of stable releases ! are compared one decimal number at a time, from left to right. For example, version 2.1 is later than 1.3 and version 3.4.6 is later than 3.3.5. Missing fields are equivalent to zeroes: version 1.3 is the same as version 1.3.0 and 1.3.0.0, so it is earlier than 1.3.1 or 1.3.0.2. ! The version numbers of alpha and beta releases are compared by ! substituting ".-1." for each "b" and ".-2." for each "a" and ! following the same rules as for stable releases. ! For example, 1.0a2 is earlier than 1.0b1 which is earlier than 1.0. ! The command \fBpackage vcompare\fR compares two version numbers. ! .PP ! Version numbers are not arbitrary labels. They are meant to ! serve as an indicator of compatibility among different releases ! of a package. ! A later version number is assumed to be upwards compatible with an ! earlier version number as long as both versions have the same major version number. For example, Tcl scripts written for version 2.3 of a package should work unchanged under versions 2.3.2, 2.4, and 2.5.1. Changes in the major version number signify incompatible changes: if code is written to use version 2.1 of a package, it is not guaranteed to work unmodified with either version 1.7.3 or version 3.1. + .PP + It is useful at times to be able to make releases which might break + compatibility without incrementing the major number. That is + where alpha and beta releases enter the picture. Strictly + following the compatibility rules, for example, releases 1.1a1 + and 1.2b3 should both be upwards compatible with release 1.0. + Also, release 1.2b3 should be compatible with 1.1a1. + When developing new code, however, unintended incompatibilities + can arise which are not detected until after the package is released + and subjected to widespread testing. Also, new features might be + tried and then abandoned. + Unless the compatibility rules can be suspended, later + releases would have to provide compatibility for abandoned features. + Alpha and beta releases of + a package are ignored by \fBpackage require\fR by default. + They are only deemed acceptable by \fBpackage require\fR if a + previous call to \fBpackage threshold\fR has explicitly + declared alpha and/or beta releases of a particular package to + be acceptable for loading. Releasing an alpha or beta release + of a package allows alpha and beta testers to voluntarily try + out non-stable releases by inserting \fBpackage threshold\fR + commands in their scripts. Meanwhile, by default other scripts + will ignore the non-stable releases, and accept only those + release labeled with stable version numbers. + .VE .SH "PACKAGE INDICES" .PP *************** *** 191,193 **** --- 298,301 ---- .SH KEYWORDS package, version + Index: generic/tcl.decls =================================================================== RCS file: /cvsroot/tcl/generic/tcl.decls,v retrieving revision 1.27 diff -c -r1.27 tcl.decls *** tcl.decls 1999/08/10 22:45:10 1.27 --- tcl.decls 1999/08/20 01:25:40 *************** *** 1340,1345 **** --- 1340,1351 ---- declare 388 generic { int Tcl_GetChannelNames(Tcl_Interp *interp) } + declare 390 generic { + int Tcl_PkgGetThreshold(Tcl_Interp *interp, char *name) + } + declare 391 generic { + void Tcl_PkgSetThreshold(Tcl_Interp *interp, char *name, int threshold) + } Index: generic/tclPkg.c =================================================================== RCS file: /cvsroot/tcl/generic/tclPkg.c,v retrieving revision 1.4 diff -c -r1.4 tclPkg.c *** tclPkg.c 1999/04/16 00:46:51 1.4 --- tclPkg.c 1999/08/20 01:25:40 *************** *** 43,48 **** --- 43,53 ---- * exist in this interpreter yet. */ PkgAvail *availPtr; /* First in list of all available versions * of this package. */ + int threshold; /* Threshold value used by "package require" + * when selecting which available version + * of a package to load. Must be one of + * the values TCL_ALPHA_RELEASE, + * TCL_BETA_RELEASE, or TCL_FINAL_RELEASE. */ ClientData clientData; /* Client data. */ } Package; *************** *** 53,61 **** static int CheckVersion _ANSI_ARGS_((Tcl_Interp *interp, char *string)); static int ComparePkgVersions _ANSI_ARGS_((char *v1, char *v2, ! int *satPtr)); static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp, char *name)); /* *---------------------------------------------------------------------- --- 58,70 ---- static int CheckVersion _ANSI_ARGS_((Tcl_Interp *interp, char *string)); static int ComparePkgVersions _ANSI_ARGS_((char *v1, char *v2, ! int threshold, int *satPtr)); static Package * FindPackage _ANSI_ARGS_((Tcl_Interp *interp, char *name)); + static char * ParseVersionNumberElement _ANSI_ARGS_((char *v, + int *elemPtr)); + static int GetThresholdFromObj _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr, int *thresholdPtr)); /* *---------------------------------------------------------------------- *************** *** 108,114 **** pkgPtr->clientData = clientData; return TCL_OK; } ! if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) { if (clientData != NULL) { pkgPtr->clientData = clientData; } --- 117,124 ---- pkgPtr->clientData = clientData; return TCL_OK; } ! if (ComparePkgVersions(pkgPtr->version, version, TCL_FINAL_RELEASE, ! (int *) NULL) == 0) { if (clientData != NULL) { pkgPtr->clientData = clientData; } *************** *** 182,188 **** Package *pkgPtr; PkgAvail *availPtr, *bestPtr; char *script; ! int code, satisfies, result, pass; Tcl_DString command; /* --- 192,199 ---- Package *pkgPtr; PkgAvail *availPtr, *bestPtr; char *script; ! char buffer[TCL_INTEGER_SPACE]; ! int code, satisfies, result, pass, major; Tcl_DString command; /* *************** *** 223,240 **** for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version, ! bestPtr->version, (int *) NULL) <= 0)) { continue; } if (version != NULL) { result = ComparePkgVersions(availPtr->version, version, ! &satisfies); ! if ((result != 0) && exact) { ! continue; ! } ! if (!satisfies) { ! continue; ! } } bestPtr = availPtr; } --- 234,256 ---- for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { if ((bestPtr != NULL) && (ComparePkgVersions(availPtr->version, ! bestPtr->version, TCL_FINAL_RELEASE, (int *) NULL) <= 0)) { continue; } if (version != NULL) { result = ComparePkgVersions(availPtr->version, version, ! pkgPtr->threshold, &satisfies); ! } else { ! ParseVersionNumberElement(availPtr->version, &major); ! sprintf(buffer,"%d",major); ! result = ComparePkgVersions(availPtr->version, buffer, ! pkgPtr->threshold, &satisfies); ! } ! if ((result != 0) && exact) { ! continue; ! } ! if (!satisfies && !exact) { ! continue; } bestPtr = availPtr; } *************** *** 315,330 **** } return pkgPtr->version; } ! result = ComparePkgVersions(pkgPtr->version, version, &satisfies); ! if ((satisfies && !exact) || (result == 0)) { if (clientDataPtr) { *clientDataPtr = pkgPtr->clientData; } return pkgPtr->version; } Tcl_AppendResult(interp, "version conflict for package \"", ! name, "\": have ", pkgPtr->version, ", need ", version, ! (char *) NULL); return NULL; } --- 331,359 ---- } return pkgPtr->version; } ! result = ComparePkgVersions(pkgPtr->version, version, pkgPtr->threshold, ! &satisfies); ! if ((satisfies && !exact) || (exact && result == 0)) { if (clientDataPtr) { *clientDataPtr = pkgPtr->clientData; } return pkgPtr->version; } Tcl_AppendResult(interp, "version conflict for package \"", ! name, "\": have ", pkgPtr->version, ", need ", (exact ? ! "exactly " : ""), version, (char *) NULL); ! if (!exact) { ! switch (pkgPtr->threshold) { ! case TCL_BETA_RELEASE: { ! Tcl_AppendResult(interp, " and at least beta", (char *) NULL); ! break; ! } ! case TCL_FINAL_RELEASE: { ! Tcl_AppendResult(interp, " and stable", (char *) NULL); ! break; ! } ! } ! } return NULL; } *************** *** 419,426 **** return pkgPtr->version; } ! result = ComparePkgVersions(pkgPtr->version, version, &satisfies); ! if ((satisfies && !exact) || (result == 0)) { if (clientDataPtr) { *clientDataPtr = pkgPtr->clientData; } --- 448,456 ---- return pkgPtr->version; } ! result = ComparePkgVersions(pkgPtr->version, version, ! pkgPtr->threshold, &satisfies); ! if ((satisfies && !exact) || (exact && result == 0)) { if (clientDataPtr) { *clientDataPtr = pkgPtr->clientData; } *************** *** 428,435 **** return pkgPtr->version; } Tcl_AppendResult(interp, "version conflict for package \"", ! name, "\": have ", pkgPtr->version, ! ", need ", version, (char *) NULL); return NULL; } } --- 458,478 ---- return pkgPtr->version; } Tcl_AppendResult(interp, "version conflict for package \"", ! name, "\": have ", pkgPtr->version, ", need ", ! (exact ? "exactly " : ""), version, (char *) NULL); ! if (!exact) { ! switch (pkgPtr->threshold) { ! case TCL_BETA_RELEASE: { ! Tcl_AppendResult(interp, " and at least beta", ! (char *) NULL); ! break; ! } ! case TCL_FINAL_RELEASE: { ! Tcl_AppendResult(interp, " and stable", (char *) NULL); ! break; ! } ! } ! } return NULL; } } *************** *** 447,452 **** --- 490,569 ---- /* *---------------------------------------------------------------------- * + * Tcl_PkgGetThreshold -- + * + * This procedure is invoked to get the threshold value associated + * with a package in the interpreter. + * + * Results: + * Returns the threshold value associated with the package as + * one of three values: TCL_ALPHA_RELEASE, TCL_BETA_RELEASE, + * or TCL_FINAL_RELEASE. + * + * Side effects: + * A Package structure may be allocated. + * + *---------------------------------------------------------------------- + */ + + int + Tcl_PkgGetThreshold(interp, name) + Tcl_Interp *interp; /* Interpreter in which to examine package */ + char *name; /* Name of package. */ + { + Package *pkgPtr; + + pkgPtr = FindPackage(interp, name); + return pkgPtr->threshold; + } + + /* + *---------------------------------------------------------------------- + * + * Tcl_PkgSetThreshold -- + * + * This procedure is invoked to set the threshold associated with + * a package in the interpreter. + * + * Results: + * None. + * + * Side effects: + * Changing the threshold value of a package will change the + * way Tcl_PkgRequire acts on that package. See the user + * documentation for the "package" command for details. + * + *---------------------------------------------------------------------- + */ + + void + Tcl_PkgSetThreshold(interp, name, threshold) + Tcl_Interp *interp; /* Interpreter in which to set a + * package threshold */ + char *name; /* Name of package. */ + int threshold; /* New threshold value. Must be one + * of TCL_ALPHA_RELEASE, TCL_BETA_RELEASE, + * or TCL_FINAL_RELEASE */ + { + Package *pkgPtr; + + pkgPtr = FindPackage(interp, name); + switch (threshold) { + case TCL_ALPHA_RELEASE: + case TCL_BETA_RELEASE: + case TCL_FINAL_RELEASE: { + pkgPtr->threshold = threshold; + break; + } + default: { + panic("Tcl_PkgSetThreshold: bad threshold value %d", threshold); + } + } + } + + /* + *---------------------------------------------------------------------- + * * Tcl_PackageObjCmd -- * * This procedure is invoked to process the "package" Tcl command. *************** *** 471,485 **** { static char *pkgOptions[] = { "forget", "ifneeded", "names", "present", "provide", "require", ! "unknown", "vcompare", "versions", "vsatisfies", (char *) NULL }; enum pkgOptions { PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PRESENT, ! PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, ! PKG_VERSIONS, PKG_VSATISFIES }; Interp *iPtr = (Interp *) interp; ! int optionIndex, exact, i, satisfies; PkgAvail *availPtr, *prevPtr; Package *pkgPtr; Tcl_HashEntry *hPtr; --- 588,603 ---- { static char *pkgOptions[] = { "forget", "ifneeded", "names", "present", "provide", "require", ! "threshold", "unknown", "vcompare", "versions", "vsatisfies", ! (char *) NULL }; enum pkgOptions { PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PRESENT, ! PKG_PROVIDE, PKG_REQUIRE, PKG_THRESHOLD, PKG_UNKNOWN, ! PKG_VCOMPARE, PKG_VERSIONS, PKG_VSATISFIES }; Interp *iPtr = (Interp *) interp; ! int optionIndex, exact, i, satisfies, threshold; PkgAvail *availPtr, *prevPtr; Package *pkgPtr; Tcl_HashEntry *hPtr; *************** *** 544,550 **** argv3 = Tcl_GetStringFromObj(objv[3], &length); for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; prevPtr = availPtr, availPtr = availPtr->nextPtr) { ! if (ComparePkgVersions(availPtr->version, argv3, (int *) NULL) == 0) { if (objc == 4) { Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE); --- 662,668 ---- argv3 = Tcl_GetStringFromObj(objv[3], &length); for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL; prevPtr = availPtr, availPtr = availPtr->nextPtr) { ! if (ComparePkgVersions(availPtr->version, argv3, 0, (int *) NULL) == 0) { if (objc == 4) { Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE); *************** *** 677,682 **** --- 795,829 ---- Tcl_SetResult(interp, version, TCL_VOLATILE); break; } + case PKG_THRESHOLD: { + if ((objc != 3) && (objc != 4)) { + Tcl_WrongNumArgs(interp, 2, objv, "package ?threshold?"); + return TCL_ERROR; + } + argv2 = Tcl_GetString(objv[2]); + if (objc == 3) { + switch (Tcl_PkgGetThreshold(interp, argv2)) { + case TCL_ALPHA_RELEASE: { + Tcl_SetResult(interp, "alpha", TCL_STATIC); + return TCL_OK; + } + case TCL_BETA_RELEASE: { + Tcl_SetResult(interp, "beta", TCL_STATIC); + return TCL_OK; + } + case TCL_FINAL_RELEASE: { + Tcl_SetResult(interp, "stable", TCL_STATIC); + return TCL_OK; + } + } + } + if (GetThresholdFromObj(interp, objv[3], &threshold) != TCL_OK) { + return TCL_ERROR; + } + Tcl_PkgSetThreshold(interp, argv2, threshold); + Tcl_SetObjResult(interp, objv[3]); + break; + } case PKG_UNKNOWN: { int length; if (objc == 2) { *************** *** 713,719 **** return TCL_ERROR; } Tcl_SetIntObj(Tcl_GetObjResult(interp), ! ComparePkgVersions(argv2, argv3, (int *) NULL)); break; } case PKG_VERSIONS: { --- 860,866 ---- return TCL_ERROR; } Tcl_SetIntObj(Tcl_GetObjResult(interp), ! ComparePkgVersions(argv2, argv3, 0, (int *) NULL)); break; } case PKG_VERSIONS: { *************** *** 733,740 **** break; } case PKG_VSATISFIES: { ! if (objc != 4) { ! Tcl_WrongNumArgs(interp, 2, objv, "version1 version2"); return TCL_ERROR; } argv3 = Tcl_GetString(objv[3]); --- 880,888 ---- break; } case PKG_VSATISFIES: { ! if ((objc != 4) && (objc != 5)) { ! Tcl_WrongNumArgs(interp, 2, objv, ! "version1 version2 ?threshold?"); return TCL_ERROR; } argv3 = Tcl_GetString(objv[3]); *************** *** 743,749 **** || (CheckVersion(interp, argv3) != TCL_OK)) { return TCL_ERROR; } ! ComparePkgVersions(argv2, argv3, &satisfies); Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies); break; } --- 891,905 ---- || (CheckVersion(interp, argv3) != TCL_OK)) { return TCL_ERROR; } ! if (objc == 5) { ! if (GetThresholdFromObj(interp, objv[4], &threshold) ! != TCL_OK) { ! return TCL_ERROR; ! } ! } else { ! threshold = TCL_FINAL_RELEASE; ! } ! ComparePkgVersions(argv2, argv3, threshold, &satisfies); Tcl_SetIntObj(Tcl_GetObjResult(interp), satisfies); break; } *************** *** 776,782 **** static Package * FindPackage(interp, name) Tcl_Interp *interp; /* Interpreter to use for package lookup. */ ! char *name; /* Name of package to fine. */ { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; --- 932,938 ---- static Package * FindPackage(interp, name) Tcl_Interp *interp; /* Interpreter to use for package lookup. */ ! char *name; /* Name of package to fine. */ { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; *************** *** 788,793 **** --- 944,950 ---- pkgPtr = (Package *) ckalloc(sizeof(Package)); pkgPtr->version = NULL; pkgPtr->availPtr = NULL; + pkgPtr->threshold = TCL_FINAL_RELEASE; pkgPtr->clientData = NULL; Tcl_SetHashValue(hPtr, pkgPtr); } else { *************** *** 867,887 **** CheckVersion(interp, string) Tcl_Interp *interp; /* Used for error reporting. */ char *string; /* Supposedly a version number, which is ! * groups of decimal digits separated ! * by dots. */ { char *p = string; ! if (!isdigit(UCHAR(*p))) { /* INTL: digit */ ! goto error; ! } ! for (p++; *p != 0; p++) { ! if (!isdigit(UCHAR(*p)) && (*p != '.')) { /* INTL: digit */ ! goto error; } ! } ! if (p[-1] != '.') { ! return TCL_OK; } error: --- 1024,1078 ---- CheckVersion(interp, string) Tcl_Interp *interp; /* Used for error reporting. */ char *string; /* Supposedly a version number, which is ! * tested for valid syntax, detailed in ! * the user documentation for the ! * "package" command. */ { char *p = string; + enum State { + PKG_ANY, PKG_DIGIT + }; + enum State state = PKG_DIGIT; ! /* ! * Simple state machine for checking syntax. ! * PKG_DIGIT : Next character must be a digit. ! * PKG_ANY : Next character can be any of digit, dot, 'a', ! * 'b', or '\0'. ! */ ! ! while (1) { ! switch (*p) { ! case '.': ! case 'a': ! case 'b': { ! switch (state) { ! case PKG_ANY: { ! state = PKG_DIGIT; ! break; ! } ! case PKG_DIGIT: goto error; ! } ! break; ! } ! case '\0': { ! if (state != PKG_ANY) { ! goto error; ! } ! return TCL_OK; ! } ! default: { ! if (!isdigit(UCHAR(*p))) { /* INTL: digit */ ! goto error; ! } ! switch (state) { ! case PKG_DIGIT: { ! state = PKG_ANY; ! } ! } ! } } ! p++; } error: *************** *** 901,908 **** * The return value is -1 if v1 is less than v2, 0 if the two * version numbers are the same, and 1 if v1 is greater than v2. * If *satPtr is non-NULL, the word it points to is filled in ! * with 1 if v2 >= v1 and both numbers have the same major number ! * or 0 otherwise. * * Side effects: * None. --- 1092,1103 ---- * The return value is -1 if v1 is less than v2, 0 if the two * version numbers are the same, and 1 if v1 is greater than v2. * If *satPtr is non-NULL, the word it points to is filled in ! * with 1 if version v1 satisfies requirement v2 according to ! * threshold. See user documentation for "package" for details ! * on how the threshold value controls when a particular version ! * satisfies a particular requirement. The valid values for ! * threshold are TCL_ALPHA_RELEASE, TCL_BETA_RELEASE, and ! * TCL_FINAL_RELEASE. * * Side effects: * None. *************** *** 911,970 **** */ static int ! ComparePkgVersions(v1, v2, satPtr) ! char *v1, *v2; /* Versions strings, of form 2.1.3 (any ! * number of version numbers). */ ! int *satPtr; /* If non-null, the word pointed to is * filled in with a 0/1 value. 1 means ! * v1 "satisfies" v2: v1 is greater than ! * or equal to v2 and both version numbers ! * have the same major number. */ { ! int thisIsMajor, n1, n2; /* ! * Each iteration of the following loop processes one number from ! * each string, terminated by a ".". If those numbers don't match * then the comparison is over; otherwise, we loop back for the ! * next number. */ thisIsMajor = 1; while (1) { ! /* ! * Parse one decimal number from the front of each string. ! */ ! ! n1 = n2 = 0; ! while ((*v1 != 0) && (*v1 != '.')) { ! n1 = 10*n1 + (*v1 - '0'); ! v1++; ! } ! while ((*v2 != 0) && (*v2 != '.')) { ! n2 = 10*n2 + (*v2 - '0'); ! v2++; ! } ! /* ! * Compare and go on to the next version number if the ! * current numbers match. ! */ ! ! if (n1 != n2) { break; } ! if (*v1 != 0) { ! v1++; ! } else if (*v2 == 0) { break; } - if (*v2 != 0) { - v2++; - } thisIsMajor = 0; } if (satPtr != NULL) { ! *satPtr = (n1 == n2) || ((n1 > n2) && !thisIsMajor); } if (n1 > n2) { return 1; --- 1106,1164 ---- */ static int ! ComparePkgVersions(v1, v2, threshold, satPtr) ! char *v1, *v2; /* Version strings */ ! int threshold; /* Threshold value used to control ! * testing whether v1 "satisfies" v2. */ ! int *satPtr; /* If non-null, the integer pointed to is * filled in with a 0/1 value. 1 means ! * v1 "satisfies" v2. */ { ! int thisIsMajor, n, n1, n2; ! char *first; /* ! * Each iteration of the following loop processes one element from ! * each version number string. If those elements don't match * then the comparison is over; otherwise, we loop back for the ! * next element. */ + first = v1; thisIsMajor = 1; while (1) { ! v1 = ParseVersionNumberElement(v1, &n1); ! v2 = ParseVersionNumberElement(v2, &n2); ! if ((*v1 == 0) && (*v2 == 0)) { break; } ! if (n1 != n2) { break; } thisIsMajor = 0; } if (satPtr != NULL) { ! if ((n1 == n2) || ((n1 > n2) && !thisIsMajor)) { ! ! /* ! * v1 appears to satisfy v2. Check against threshold. ! */ ! ! *satPtr = 1; ! while (1) { ! first = ParseVersionNumberElement(first, &n); ! if (n < threshold - TCL_FINAL_RELEASE) { ! *satPtr = 0; ! break; ! } ! if (*first == 0) { ! break; ! } ! } ! } else { ! *satPtr = 0; ! } } if (n1 > n2) { return 1; *************** *** 973,976 **** --- 1167,1288 ---- } else { return -1; } + } + + /* + *---------------------------------------------------------------------- + * + * ParseVersionNumberElement -- + * + * This procedure parses an elemnt from a version number string. + * + * Results: + * Reads characters starting at v and interprets them as an element + * in a version number string. The integer (*elemPtr) is filled + * with the numeric value of the element and a pointer to the + * next element in the version number string is returned. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + char * + ParseVersionNumberElement(v, elemPtr) + char *v; /* suffix of a version string */ + int *elemPtr; /* The integer pointed to is + * filled with the numeric value of the + * first element of the version number + * suffix pointed to by v. */ + { + int n = 0; + + /* + * Shift all threshold values so that "stable" corresponds to 0. + */ + + switch (*v) { + case '\0': { + *elemPtr = TCL_FINAL_RELEASE - TCL_FINAL_RELEASE; + return v; + } + case 'a': { + *elemPtr = TCL_ALPHA_RELEASE - TCL_FINAL_RELEASE; + return ++v; + } + case 'b': { + *elemPtr = TCL_BETA_RELEASE - TCL_FINAL_RELEASE; + return ++v; + } + default: { + while (isdigit(UCHAR(*v))) { /* INTL: digit */ + n = 10*n + (*v - '0'); + v++; + } + *elemPtr = n; + if (*v == '.') { + return ++v; + } else { + return v; + } + } + } + } + + /* + *---------------------------------------------------------------------- + * + * GetThresholdFromObj -- + * + * Determines the integral threshold value indicated by the + * value of an object. + * + * Results: + * The string value of the object is compared to a table of + * strings and the corresponding integral threshold value is + * stored at *thresholdPtr. The value stored at *thresholdPtr + * is one of TCL_ALPHA_RELEASE, TCL_BETA_RELEASE, or + * TCL_FINAL_RELEASE. If there isn't a proper match, TCL_ERROR + * is returned and an error message is left in interp's result + * (unless interp is NULL). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + int + GetThresholdFromObj(interp, objPtr, thresholdPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr; /* Object containing the string to lookup. */ + int *thresholdPtr; /* Place to store resulting threshold value. */ + { + static char *pkgThresholdValues[] = { + "alpha", "beta", "stable", (char *) NULL + }; + enum thresholdValue { + PKG_ALPHA, PKG_BETA, PKG_STABLE + }; + int index; + + if (Tcl_GetIndexFromObj(interp, objPtr, pkgThresholdValues, + "threshold value", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum thresholdValue) index) { + case PKG_ALPHA: { + *thresholdPtr = TCL_ALPHA_RELEASE; + break; + } + case PKG_BETA: { + *thresholdPtr = TCL_BETA_RELEASE; + break; + } + case PKG_STABLE: { + *thresholdPtr = TCL_FINAL_RELEASE; + break; + } + } + return TCL_OK; } Index: tests/pkg.test =================================================================== RCS file: /cvsroot/tcl/tests/pkg.test,v retrieving revision 1.6 diff -c -r1.6 pkg.test *** pkg.test 1999/06/26 20:55:09 1.6 --- pkg.test 1999/08/20 01:25:42 *************** *** 245,256 **** package forget t package provide t 2.3 list [catch {package require t 2.4} msg] $msg ! } {1 {version conflict for package "t": have 2.3, need 2.4}} test pkg-2.22 {Tcl_PkgRequire procedure, version checks} { package forget t package provide t 2.3 list [catch {package require t 1.2} msg] $msg ! } {1 {version conflict for package "t": have 2.3, need 1.2}} test pkg-2.23 {Tcl_PkgRequire procedure, version checks} { package forget t package provide t 2.3 --- 245,256 ---- package forget t package provide t 2.3 list [catch {package require t 2.4} msg] $msg ! } {1 {version conflict for package "t": have 2.3, need 2.4 and stable}} test pkg-2.22 {Tcl_PkgRequire procedure, version checks} { package forget t package provide t 2.3 list [catch {package require t 1.2} msg] $msg ! } {1 {version conflict for package "t": have 2.3, need 1.2 and stable}} test pkg-2.23 {Tcl_PkgRequire procedure, version checks} { package forget t package provide t 2.3 *************** *** 260,266 **** package forget t package provide t 2.3 list [catch {package require -exact t 2.2} msg] $msg ! } {1 {version conflict for package "t": have 2.3, need 2.2}} test pkg-3.1 {Tcl_PackageCmd procedure} { list [catch {package} msg] $msg --- 260,266 ---- package forget t package provide t 2.3 list [catch {package require -exact t 2.2} msg] $msg ! } {1 {version conflict for package "t": have 2.3, need exactly 2.2}} test pkg-3.1 {Tcl_PackageCmd procedure} { list [catch {package} msg] $msg *************** *** 468,477 **** } {2.3 2.4} test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} { list [catch {package vsatisfies a} msg] $msg ! } {1 {wrong # args: should be "package vsatisfies version1 version2"}} test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} { list [catch {package vsatisfies a b c} msg] $msg ! } {1 {wrong # args: should be "package vsatisfies version1 version2"}} test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} { list [catch {package vsatisfies x.y 3.4} msg] $msg } {1 {expected version number but got "x.y"}} --- 468,477 ---- } {2.3 2.4} test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} { list [catch {package vsatisfies a} msg] $msg ! } {1 {wrong # args: should be "package vsatisfies version1 version2 ?threshold?"}} test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} { list [catch {package vsatisfies a b c} msg] $msg ! } {1 {expected version number but got "a"}} test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} { list [catch {package vsatisfies x.y 3.4} msg] $msg } {1 {expected version number but got "x.y"}} *************** *** 486,492 **** } {0} test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} { list [catch {package foo} msg] $msg ! } {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, unknown, vcompare, versions, or vsatisfies}} # No tests for FindPackage; can't think up anything detectable # errors. --- 486,492 ---- } {0} test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} { list [catch {package foo} msg] $msg ! } {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, threshold, unknown, vcompare, versions, or vsatisfies}} # No tests for FindPackage; can't think up anything detectable # errors. *************** *** 529,534 **** --- 529,582 ---- test pkg-5.4 {CheckVersion procedure} { list [catch {package vcompare 1.2.3. 2.1} msg] $msg } {1 {expected version number but got "1.2.3."}} + test pkg-5.5 {CheckVersion procedure} { + list [catch {package vcompare 1a0 2.1} msg] $msg + } {0 -1} + test pkg-5.6 {CheckVersion procedure} { + list [catch {package vcompare 1b0 2.1} msg] $msg + } {0 -1} + test pkg-5.7 {CheckVersion procedure} { + list [catch {package vcompare 1.0a5 2.1} msg] $msg + } {0 -1} + test pkg-5.8 {CheckVersion procedure} { + list [catch {package vcompare 1.0.0b5 2.1} msg] $msg + } {0 -1} + test pkg-5.9 {CheckVersion procedure} { + list [catch {package vcompare 1a0.0b5 2.1} msg] $msg + } {0 -1} + test pkg-5.10 {CheckVersion procedure} { + list [catch {package vcompare 1a3b5 2.1} msg] $msg + } {0 -1} + test pkg-5.11 {CheckVersion procedure} { + list [catch {package vcompare x 2.1} msg] $msg + } {1 {expected version number but got "x"}} + test pkg-5.12 {CheckVersion procedure} { + list [catch {package vcompare a1 2.1} msg] $msg + } {1 {expected version number but got "a1"}} + test pkg-5.13 {CheckVersion procedure} { + list [catch {package vcompare b1 2.1} msg] $msg + } {1 {expected version number but got "b1"}} + test pkg-5.14 {CheckVersion procedure} { + list [catch {package vcompare 1x 2.1} msg] $msg + } {1 {expected version number but got "1x"}} + test pkg-5.15 {CheckVersion procedure} { + list [catch {package vcompare 1a 2.1} msg] $msg + } {1 {expected version number but got "1a"}} + test pkg-5.16 {CheckVersion procedure} { + list [catch {package vcompare 1b 2.1} msg] $msg + } {1 {expected version number but got "1b"}} + test pkg-5.17 {CheckVersion procedure} { + list [catch {package vcompare 1..0 2.1} msg] $msg + } {1 {expected version number but got "1..0"}} + test pkg-5.18 {CheckVersion procedure} { + list [catch {package vcompare 1a.0 2.1} msg] $msg + } {1 {expected version number but got "1a.0"}} + test pkg-5.19 {CheckVersion procedure} { + list [catch {package vcompare 1.b0 2.1} msg] $msg + } {1 {expected version number but got "1.b0"}} + test pkg-5.20 {CheckVersion procedure} { + list [catch {package vcompare 1ab0 2.1} msg] $msg + } {1 {expected version number but got "1ab0"}} test pkg-6.1 {ComparePkgVersions procedure} { package vcompare 1.23 1.22 *************** *** 557,562 **** --- 605,682 ---- test pkg-6.9 {ComparePkgVersions procedure} { package vsatisfies 2 1 } {0} + test pkg-6.10 {ComparePkgVersions procedure, beta before stable} { + package vcompare 1.0b1 1.0 + } {-1} + test pkg-6.11 {ComparePkgVersions procedure, alpha before stable} { + package vcompare 1.0a1 1.0 + } {-1} + test pkg-6.12 {ComparePkgVersions procedure, alpha before beta} { + package vcompare 1.0a2 1.0b1 + } {-1} + test pkg-6.13 {ComparePkgVersions procedure} { + package vcompare 1.0.1b1 1.0 + } {1} + test pkg-6.14 {ComparePkgVersions procedure} { + package vcompare 1.0.1a1 1.0 + } {1} + test pkg-6.15 {ComparePkgVersions procedure} { + package vcompare 1.0.1a2 1.0b1 + } {1} + test pkg-6.16 {ComparePkgVersions procedure} { + package vcompare 1.0b1 1.0b1 + } {0} + test pkg-6.17 {ComparePkgVersions procedure} { + package vcompare 1.0a1 1.0a1 + } {0} + test pkg-6.18 {ComparePkgVersions procedure} { + package vsatisfies 1.0 1.0a0 + } {1} + test pkg-6.19 {ComparePkgVersions procedure} { + package vsatisfies 1.0 1.0b0 + } {1} + test pkg-6.20 {ComparePkgVersions procedure} { + package vsatisfies 1.0a0 1.0 + } {0} + test pkg-6.21 {ComparePkgVersions procedure} { + package vsatisfies 1.0b0 1.0 + } {0} + test pkg-6.22 {ComparePkgVersions procedure} { + package vsatisfies 1.1b0 1.0 + } {0} + test pkg-6.23 {ComparePkgVersions procedure} { + package vsatisfies 1.1a0 1.0 + } {0} + test pkg-6.24 {ComparePkgVersions procedure} { + package vsatisfies 1.1 1.0 stable + } {1} + test pkg-6.25 {ComparePkgVersions procedure} { + package vsatisfies 1.1b0 1.0 stable + } {0} + test pkg-6.26 {ComparePkgVersions procedure} { + package vsatisfies 1.1a0 1.0 stable + } {0} + test pkg-6.27 {ComparePkgVersions procedure} { + package vsatisfies 1.1 1.0 beta + } {1} + test pkg-6.28 {ComparePkgVersions procedure} { + package vsatisfies 1.1b0 1.0 beta + } {1} + test pkg-6.29 {ComparePkgVersions procedure} { + package vsatisfies 1.1a0 1.0 beta + } {0} + test pkg-6.30 {ComparePkgVersions procedure} { + package vsatisfies 1.1 1.0 alpha + } {1} + test pkg-6.31 {ComparePkgVersions procedure} { + package vsatisfies 1.1b0 1.0 alpha + } {1} + test pkg-6.32 {ComparePkgVersions procedure} { + package vsatisfies 1.1a0 1.0 alpha + } {1} + test pkg-6.33 {ComparePkgVersions procedure} { + list [catch {package vsatisfies 1.1a0 1.0 foo} msg] $msg + } {1 {bad threshold value "foo": must be alpha, beta, or stable}} test pkg-7.1 {Tcl_PkgPresent procedure, any version} { package forget t *************** *** 577,588 **** package forget t package provide t 2.4 list [catch {package present t 2.6} msg] $msg ! } {1 {version conflict for package "t": have 2.4, need 2.6}} test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} { package forget t package provide t 2.4 list [catch {package present t 1.0} msg] $msg ! } {1 {version conflict for package "t": have 2.4, need 1.0}} test pkg-7.6 {Tcl_PkgPresent procedure, exact version} { package forget t package provide t 2.4 --- 697,708 ---- package forget t package provide t 2.4 list [catch {package present t 2.6} msg] $msg ! } {1 {version conflict for package "t": have 2.4, need 2.6 and stable}} test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} { package forget t package provide t 2.4 list [catch {package present t 1.0} msg] $msg ! } {1 {version conflict for package "t": have 2.4, need 1.0 and stable}} test pkg-7.6 {Tcl_PkgPresent procedure, exact version} { package forget t package provide t 2.4 *************** *** 592,598 **** package forget t package provide t 2.4 list [catch {package present -exact t 2.3} msg] $msg ! } {1 {version conflict for package "t": have 2.4, need 2.3}} test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} { package forget t list [catch {package present t} msg] $msg --- 712,718 ---- package forget t package provide t 2.4 list [catch {package present -exact t 2.3} msg] $msg ! } {1 {version conflict for package "t": have 2.4, need exactly 2.3}} test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} { package forget t list [catch {package present t} msg] $msg *************** *** 629,634 **** --- 749,1041 ---- test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} { list [catch {package present -exact} msg] $msg } {1 {wrong # args: should be "package present ?-exact? package ?version?"}} + + test pkg-8.1 {Tcl_PackageCmd procedure, "threshold" option} { + list [catch {package threshold} msg] $msg + } {1 {wrong # args: should be "package threshold package ?threshold?"}} + test pkg-8.2 {Tcl_PackageCmd procedure, "threshold" option} { + list [catch {package threshold a b c} msg] $msg + } {1 {wrong # args: should be "package threshold package ?threshold?"}} + test pkg-8.3 {Tcl_PackageCmd procedure, "threshold" option} { + list [catch {package threshold t x} msg] $msg + } {1 {bad threshold value "x": must be alpha, beta, or stable}} + test pkg-8.4 {Tcl_PackageCmd procedure, "threshold" option} { + package threshold t alpha + } {alpha} + test pkg-8.5 {Tcl_PackageCmd procedure, "threshold" option} { + package threshold t beta + package threshold t + } {beta} + test pkg-8.6 {Tcl_PackageCmd procedure, "threshold" option} { + foreach i [package names] { + package forget $i + } + package threshold t stable + package names + } {} + test pkg-8.7 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.1b1 + package threshold t stable + list [catch {package present t 1.0} msg] $msg + } {1 {version conflict for package "t": have 1.1b1, need 1.0 and stable}} + test pkg-8.8 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.1b1 + package threshold t beta + package present t 1.0 + } {1.1b1} + test pkg-8.9 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.2a1 + package threshold t beta + list [catch {package present t 1.0} msg] $msg + } {1 {version conflict for package "t": have 1.2a1, need 1.0 and at least beta}} + test pkg-8.10 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.2a1 + package threshold t alpha + package present t 1.0 + } {1.2a1} + test pkg-8.11 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package threshold t alpha + package forget t + package provide t 1.2a1 + list [catch {package present t 1.0} msg] $msg + } {1 {version conflict for package "t": have 1.2a1, need 1.0 and stable}} + test pkg-8.12 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0 + package threshold t stable + package present t 1.0a0 + } {1.0} + test pkg-8.13 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0b0 + package threshold t stable + list [catch {package present t 1.0a0} msg] $msg + } {1 {version conflict for package "t": have 1.0b0, need 1.0a0 and stable}} + test pkg-8.14 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0b0 + package threshold t beta + package present t 1.0a0 + } {1.0b0} + test pkg-8.15 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0a0 + package threshold t beta + list [catch {package present t 1.0a0} msg] $msg + } {1 {version conflict for package "t": have 1.0a0, need 1.0a0 and at least beta}} + test pkg-8.16 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0a1 + package threshold t alpha + package present t 1.0a0 + } {1.0a1} + test pkg-8.17 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0 + package threshold t stable + list [catch {package present -exact t 1.0b0} msg] $msg + } {1 {version conflict for package "t": have 1.0, need exactly 1.0b0}} + test pkg-8.18 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0b0 + package threshold t stable + package present -exact t 1.0b0 + } {1.0b0} + test pkg-8.19 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.1b1 + package threshold t stable + list [catch {package require t 1.0} msg] $msg + } {1 {version conflict for package "t": have 1.1b1, need 1.0 and stable}} + test pkg-8.20 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.1b1 + package threshold t beta + package require t 1.0 + } {1.1b1} + test pkg-8.21 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.2a1 + package threshold t beta + list [catch {package require t 1.0} msg] $msg + } {1 {version conflict for package "t": have 1.2a1, need 1.0 and at least beta}} + test pkg-8.22 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.2a1 + package threshold t alpha + package require t 1.0 + } {1.2a1} + test pkg-8.23 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package threshold t alpha + package forget t + package provide t 1.2a1 + list [catch {package require t 1.0} msg] $msg + } {1 {version conflict for package "t": have 1.2a1, need 1.0 and stable}} + test pkg-8.24 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0 + package threshold t stable + package require t 1.0a0 + } {1.0} + test pkg-8.25 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0b0 + package threshold t stable + list [catch {package require t 1.0a0} msg] $msg + } {1 {version conflict for package "t": have 1.0b0, need 1.0a0 and stable}} + test pkg-8.26 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0b0 + package threshold t beta + package require t 1.0a0 + } {1.0b0} + test pkg-8.27 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0a0 + package threshold t beta + list [catch {package require t 1.0a0} msg] $msg + } {1 {version conflict for package "t": have 1.0a0, need 1.0a0 and at least beta}} + test pkg-8.28 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0a1 + package threshold t alpha + package require t 1.0a0 + } {1.0a1} + test pkg-8.29 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0 + package threshold t stable + list [catch {package require -exact t 1.0b0} msg] $msg + } {1 {version conflict for package "t": have 1.0, need exactly 1.0b0}} + test pkg-8.30 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package provide t 1.0b0 + package threshold t stable + package require -exact t 1.0b0 + } {1.0b0} + test pkg-8.31 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t stable + package require t + } {1.0} + test pkg-8.32 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t stable + package require t 1.0 + } {1.0} + test pkg-8.33 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t stable + list [catch {package require t 1.1} msg] $msg + } {1 {can't find package t 1.1}} + test pkg-8.34 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t beta + package require t + } {1.1b1} + test pkg-8.35 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t beta + package require t 1.0 + } {1.1b1} + test pkg-8.36 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t stable + list [catch {package require t 1.1} msg] $msg + } {1 {can't find package t 1.1}} + test pkg-8.37 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t alpha + package require t + } {1.2a1} + test pkg-8.38 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t alpha + package require t 1.0 + } {1.2a1} + test pkg-8.39 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t alpha + package require t 1.1 + } {1.2a1} + test pkg-8.40 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t alpha + list [catch {package require t 1.2} msg] $msg + } {1 {can't find package t 1.2}} + test pkg-8.41 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t stable + package require -exact t 1.1b1 + } {1.1b1} + test pkg-8.42 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t stable + package require -exact t 1.2a1 + } {1.2a1} + test pkg-8.43 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t beta + package require -exact t 1.2a1 + } {1.2a1} + test pkg-8.44 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package ifneeded t 1.2a1 {package provide t 1.2a1} + package ifneeded t 1.1b1 {package provide t 1.1b1} + package ifneeded t 1.0 {package provide t 1.0} + package threshold t alpha + package require -exact t 1.0 + } {1.0} + test pkg-8.45 {Tcl_PackageCmd procedure, "threshold" option} { + package forget t + package threshold t stable + package versions t + } {} set auto_path $oldPath package unknown $oldPkgUnknown