* doc/package.n: Restored the document parallel syntax of the

        * generic/tclPkg.c:     [package present] and [package require]
        * tests/pkg.test:       commands.  [Bug 1723675]

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...?"}}