diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | doc/package.n | 4 | ||||
| -rw-r--r-- | generic/tclPkg.c | 90 | ||||
| -rw-r--r-- | tests/pkg.test | 16 |
4 files changed, 51 insertions, 65 deletions
@@ -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...?"}} |