summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog6
-rw-r--r--doc/package.n4
-rw-r--r--generic/tclPkg.c90
-rw-r--r--tests/pkg.test16
4 files changed, 51 insertions, 65 deletions
diff --git a/ChangeLog b/ChangeLog
index 8c31dc9..3494d82 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2007-09-10 Don Porter <dgp@users.sourceforge.net>
+
+ * doc/package.n: Restored the document parallel syntax of the
+ * generic/tclPkg.c: [package present] and [package require]
+ * tests/pkg.test: commands. [Bug 1723675]
+
2007-09-09 Don Porter <dgp@users.sourceforge.net>
* generic/tclInt.h: Removed the "nsName" Tcl_ObjType from the
diff --git a/doc/package.n b/doc/package.n
index 9d2d3af..6231a1f 100644
--- a/doc/package.n
+++ b/doc/package.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: package.n,v 1.15 2006/10/05 05:13:13 hobbs Exp $
+'\" RCS: @(#) $Id: package.n,v 1.16 2007/09/10 14:59:55 dgp Exp $
'\"
.so man.macros
.TH package n 7.5 Tcl "Tcl Built-In Commands"
@@ -17,7 +17,7 @@ package \- Facilities for package loading and version control
\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?
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index dff6090..a534021 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclPkg.c,v 1.27 2007/04/20 06:10:58 kennykb Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.28 2007/09/10 14:59:56 dgp Exp $
*
* TIP #268.
* Heavily rewritten to handle the extend version numbers, and extended
@@ -693,53 +693,20 @@ Tcl_PkgPresentEx(
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 @@ Tcl_PackageObjCmd(
}
}
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 @@ Tcl_PackageObjCmd(
}
return Tcl_PkgProvide(interp, argv2, argv3);
case PKG_REQUIRE:
+ require:
if (objc < 3) {
requireSyntax:
Tcl_WrongNumArgs(interp, 2, objv,
diff --git a/tests/pkg.test b/tests/pkg.test
index caeeeb6..f52cdad 100644
--- a/tests/pkg.test
+++ b/tests/pkg.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: pkg.test,v 1.26 2007/02/22 20:25:40 andreas_kupries Exp $
+# RCS: @(#) $Id: pkg.test,v 1.27 2007/09/10 14:59:56 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -867,7 +867,7 @@ test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} {
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 @@ test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} {
} {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 @@ test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} {
} {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...?"}}