Attachment "1723675.patch" to
ticket [1723675fff]
added by
dgp
2007-09-10 21:59:58.
Index: doc/package.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/package.n,v
retrieving revision 1.15
diff -u -r1.15 package.n
--- doc/package.n 5 Oct 2006 05:13:13 -0000 1.15
+++ doc/package.n 10 Sep 2007 14:50:39 -0000
@@ -17,7 +17,7 @@
\fBpackage forget ?\fIpackage package ...\fR?
\fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR?
\fBpackage names\fR
-\fBpackage present \fR?\fB\-exact\fR? \fIpackage \fR?\fIversion\fR?
+\fBpackage present \fR?\fB\-exact\fR? \fIpackage \fR?\fIrequirement...\fR?
\fBpackage provide \fIpackage \fR?\fIversion\fR?
\fBpackage require \fR?\fB\-exact\fR? \fIpackage \fR?\fIrequirement...\fR?
\fBpackage unknown \fR?\fIcommand\fR?
Index: generic/tclPkg.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclPkg.c,v
retrieving revision 1.27
diff -u -r1.27 tclPkg.c
--- generic/tclPkg.c 20 Apr 2007 06:10:58 -0000 1.27
+++ generic/tclPkg.c 10 Sep 2007 14:50:39 -0000
@@ -693,53 +693,20 @@
Interp *iPtr = (Interp *) interp;
Tcl_HashEntry *hPtr;
Package *pkgPtr;
- int satisfies, result;
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
if (hPtr) {
pkgPtr = Tcl_GetHashValue(hPtr);
if (pkgPtr->version != NULL) {
- char *pvi, *vi;
- int thisIsMajor;
/*
* At this point we know that the package is present. Make sure
- * that the provided version meets the current requirement.
+ * that the provided version meets the current requirement by
+ * calling Tcl_PkgRequireEx() to check for us.
*/
- if (version == NULL) {
- if (clientDataPtr) {
- *clientDataPtr = pkgPtr->clientData;
- }
-
- return pkgPtr->version;
- }
-
- if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
- NULL) != TCL_OK) {
- return NULL;
- } else if (CheckVersionAndConvert(interp, version, &vi,
- NULL) != TCL_OK) {
- ckfree(pvi);
- return NULL;
- }
-
- result = CompareVersions(pvi, vi, &thisIsMajor);
- ckfree(pvi);
- ckfree(vi);
-
- satisfies = (result == 0) || ((result == 1) && !thisIsMajor);
-
- 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, NULL);
- return NULL;
+ return Tcl_PkgRequireEx(interp, name, version, exact,
+ clientDataPtr);
}
}
@@ -914,39 +881,51 @@
}
}
break;
- case PKG_PRESENT:
+ case PKG_PRESENT: {
+ const char *name;
if (objc < 3) {
- presentSyntax:
- Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
- return TCL_ERROR;
+ goto require;
}
argv2 = TclGetString(objv[2]);
if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
+ if (objc != 5) {
+ goto requireSyntax;
+ }
exact = 1;
+ name = TclGetString(objv[3]);
} else {
exact = 0;
+ name = argv2;
}
+
+ hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
+ if (hPtr != NULL) {
+ pkgPtr = Tcl_GetHashValue(hPtr);
+ if (pkgPtr->version != NULL) {
+ goto require;
+ }
+ }
+
version = NULL;
- if (objc == (4 + exact)) {
- version = TclGetString(objv[3 + exact]);
+ if (exact) {
+ version = TclGetString(objv[4]);
if (CheckVersionAndConvert(interp, version, NULL,
NULL) != TCL_OK) {
return TCL_ERROR;
}
- } else if ((objc != 3) || exact) {
- goto presentSyntax;
- }
- if (exact) {
- argv3 = TclGetString(objv[3]);
- version = Tcl_PkgPresent(interp, argv3, version, exact);
} else {
- version = Tcl_PkgPresent(interp, argv2, version, exact);
- }
- if (version == NULL) {
- return TCL_ERROR;
+ if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((objc > 3) && (CheckVersionAndConvert(interp,
+ TclGetString(objv[3]), NULL, NULL) == TCL_OK)) {
+ version = TclGetString(objv[3]);
+ }
}
- Tcl_SetObjResult(interp, Tcl_NewStringObj(version, -1));
+ Tcl_PkgPresent(interp, name, version, exact);
+ return TCL_ERROR;
break;
+ }
case PKG_PROVIDE:
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
@@ -969,6 +948,7 @@
}
return Tcl_PkgProvide(interp, argv2, argv3);
case PKG_REQUIRE:
+ require:
if (objc < 3) {
requireSyntax:
Tcl_WrongNumArgs(interp, 2, objv,
Index: tests/pkg.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/pkg.test,v
retrieving revision 1.26
diff -u -r1.26 pkg.test
--- tests/pkg.test 22 Feb 2007 20:25:40 -0000 1.26
+++ tests/pkg.test 10 Sep 2007 14:50:40 -0000
@@ -867,7 +867,7 @@
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}}
+} {1 {version conflict for package "t": have 2.4, need 2.3-2.4}}
test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} {
package forget t
list [catch {package present t} msg] $msg
@@ -882,16 +882,16 @@
} {1 {package t 2.4 is not present}}
test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} {
list [catch {package present} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}}
test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} {
list [catch {package present a b c} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+} {1 {expected version number but got "b"}}
test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} {
list [catch {package present -exact a b c} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}}
test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} {
list [catch {package present -bs a b} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+} {1 {expected version number but got "a"}}
test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} {
list [catch {package present x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
@@ -900,10 +900,10 @@
} {1 {expected version number but got "a.b"}}
test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} {
list [catch {package present -exact x} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
+} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}}
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?"}}
+} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}}
