TIP#268 IMPLEMENTATION

	* generic/tclDecls.h:    Regenerated from tcl.decls.
	* generic/tclStubInit.c:

	* doc/PkgRequire.3: Documentation of extended API,
	* doc/package.n:    extended testsuite.
	* tests/pkg.test:

	* generic/tcl.decls: Implementation.
	* generic/tclBasic.c:
	* generic/tclConfig.c:
	* generic/tclInt.h:
	* generic/tclPkg.c:
	* generic/tclTest.c:
	* generic/tclTomMathInterface.c:
	* library/init.tcl:
	* library/package.tcl:
	* library/tm.tcl:

1 files changed, 360 insertions, 23 deletions

diff --git a/tests/pkg.test b/tests/pkg.test
index 31091bb..5f78f2f 100644
--- a/tests/pkg.test
+++ b/tests/pkg.test
@@ -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: pkg.test,v 1.16 2005/12/02 17:34:03 dgp Exp $
+# RCS: @(#) $Id: pkg.test,v 1.17 2006/09/22 18:13:30 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -56,6 +56,23 @@ test pkg-1.5 {Tcl_PkgProvide procedure} {
     package provide t 2.3
 } {}
 
+test pkg-1.6 {Tcl_PkgProvide procedure} {
+    package forget t
+    package provide t 2.3a1
+} {}
+
+set n 0
+foreach v {
+    2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1
+    2b4a1 2b3b2
+} {
+    test pkg-1.7.$n {Tcl_PkgProvide procedure} {
+	package forget t
+	list [catch {package provide t $v} msg] $msg
+    } [list 1 "expected version number but got \"$v\""]
+    incr n
+}
+
 test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} {
     package forget t
     foreach i {1.4 3.4 2.3 2.4 2.2} {
@@ -124,7 +141,7 @@ test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} {
 	package ifneeded t $i "set x $i"
     }
     list [catch {package require -exact t 1.3} msg] $msg
-} {1 {can't find package t 1.3}}
+} {1 {can't find package t 1.3-1.4}}
 test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
     package forget t
     package unknown {}
@@ -155,9 +172,11 @@ test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
 } {1.2}
 test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
     proc pkgUnknown args {
+	# args = name requirement
+	# requirement = v-v (for exact version)
 	global x
 	set x $args
-	package provide [lindex $args 0] [lindex $args 1]
+	package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0]
     }
     package forget t
     foreach i {1.4 3.4 2.3 2.4 2.2} {
@@ -168,7 +187,7 @@ test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
     package require -exact t 1.5
     package unknown {}
     set x
-} {t 1.5 -exact}
+} {t 1.5-1.6}
 test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} {
     proc pkgUnknown args {
 	package ifneeded t 1.2 "set x loaded; package provide t 1.2"
@@ -192,7 +211,7 @@ test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} {
     package require {a b}
     package unknown {}
     set x
-} {{a b} {}}
+} {{a b}}
 test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
     proc pkgUnknown args {
 	error "testing package unknown"
@@ -207,7 +226,7 @@ test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
 "error "testing package unknown""
     (procedure "pkgUnknown" line 2)
     invoked from within
-"pkgUnknown t {}"
+"pkgUnknown t"
     ("package unknown" script)
     invoked from within
 "package require t"}}
@@ -225,7 +244,7 @@ test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package}
     set result [list [catch {package require -exact t 1.5} msg] $msg $x]
     package unknown {}
     set result
-} {1 {can't find package t 1.5} {t 1.5 -exact}}
+} {1 {can't find package t 1.5-1.6} {t 1.5-1.6}}
 test pkg-2.18 {Tcl_PkgRequire procedure, version checks} {
     package forget t
     package provide t 2.3
@@ -260,7 +279,7 @@ test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
     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}}
+} {1 {version conflict for package "t": have 2.3, need 2.2-2.3}}
 test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
     package forget t
     package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
@@ -463,6 +482,40 @@ test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
     package unknown $saveUnknown
 } -returnCodes error -match glob -result {bad return code:*}
 
+
+
+test pkg-2.50 {Tcl_PkgRequire procedure, picking best stable version} {
+    package forget t
+    foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    set x xxx
+    package require t
+    set x
+} {3.4}
+
+test pkg-2.51 {Tcl_PkgRequire procedure, picking best stable version} {
+    package forget t
+    foreach i {1.2b1 1.2 1.3a2 1.3} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    set x xxx
+    package require t
+    set x
+} {1.3}
+
+test pkg-2.52 {Tcl_PkgRequire procedure, picking best stable version} {
+    package forget t
+    foreach i {1.2b1 1.2 1.3 1.3a2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    set x xxx
+    package require t
+    set x
+} {1.3}
+
+
+
 test pkg-3.1 {Tcl_PackageCmd procedure} {
     list [catch {package} msg] $msg
 } {1 {wrong # args: should be "package option ?arg arg ...?"}}
@@ -588,16 +641,14 @@ test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
 } {1 {expected version number but got "a.b"}}
 test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} {
     list [catch {package require} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
-test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require a b c} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
+
 test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} {
     list [catch {package require -exact a b c} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
-test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require -bs a b} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+    # Exact syntax: -exact name version
+    #              name ?requirement...?
+} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
+
 test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
     list [catch {package require x a.b} msg] $msg
 } {1 {expected version number but got "a.b"}}
@@ -606,10 +657,10 @@ test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
 } {1 {expected version number but got "a.b"}}
 test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} {
     list [catch {package require -exact x} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
 test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} {
     list [catch {package require -exact} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
+} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
 test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} {
     package forget t
     package provide t 2.3
@@ -677,10 +728,8 @@ test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
 } {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"}}
+} {1 {wrong # args: should be "package vsatisfies version requirement requirement..."}}
+
 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"}}
@@ -695,7 +744,20 @@ test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
 } {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}}
+} {1 {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}}
+
+test pkg-3.54 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    list [catch {package vsatisfies 2.1 2.1-3.2-4.5} msg] $msg
+} {1 {expected versionMin-versionMax but got "2.1-3.2-4.5"}}
+
+test pkg-3.55 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    list [catch {package vsatisfies 2.1 3.2-x.y} msg] $msg
+} {1 {expected version number but got "x.y"}}
+
+test pkg-3.56 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    list [catch {package vsatisfies 2.1 x.y-3.2} msg] $msg
+} {1 {expected version number but got "x.y"}}
+
 
 # No tests for FindPackage;  can't think up anything detectable
 # errors.
@@ -842,6 +904,281 @@ 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?"}}
 
+
+
+
+set n 0
+foreach {r p vs vc} {
+    8.5a0    8.5a5    1          -1
+    8.5a0    8.5b1    1          -1
+    8.5a0    8.5.1    1          -1
+    8.5a0    8.6a0    1          -1
+    8.5a0    8.6b0    1          -1
+    8.5a0    8.6.0    1          -1
+    8.5a6    8.5a5    0          1
+    8.5a6    8.5b1    1          -1
+    8.5a6    8.5.1    1          -1
+    8.5a6    8.6a0    1          -1
+    8.5a6    8.6b0    1          -1
+    8.5a6    8.6.0    1          -1
+    8.5b0    8.5a5    0          1
+    8.5b0    8.5b1    1          -1
+    8.5b0    8.5.1    1          -1
+    8.5b0    8.6a0    1          -1
+    8.5b0    8.6b0    1          -1
+    8.5b0    8.6.0    1          -1
+    8.5b2    8.5a5    0          1
+    8.5b2    8.5b1    0          1
+    8.5b2    8.5.1    1          -1
+    8.5b2    8.6a0    1          -1
+    8.5b2    8.6b0    1          -1
+    8.5b2    8.6.0    1          -1
+    8.5      8.5a5    1          1
+    8.5      8.5b1    1          1
+    8.5      8.5.1    1          -1
+    8.5      8.6a0    1          -1
+    8.5      8.6b0    1          -1
+    8.5      8.6.0    1          -1
+    8.5.0    8.5a5    0          1
+    8.5.0    8.5b1    0          1
+    8.5.0    8.5.1    1          -1
+    8.5.0    8.6a0    1          -1
+    8.5.0    8.6b0    1          -1
+    8.5.0    8.6.0    1          -1
+} {
+    test package-vsatisfies-1.$n {package vsatisfies} {
+	package vsatisfies $p $r
+    } $vs
+
+    test package-vcompare-1.$n {package vcompare} {
+	package vcompare $r $p
+    } $vc
+
+    incr n
+}
+
+set n 0
+foreach {required provided satisfied} {
+    8.5a0-   8.5a5    1
+    8.5a0-   8.5b1    1
+    8.5a0-   8.5.1    1
+    8.5a0-   8.6a0    1
+    8.5a0-   8.6b0    1
+    8.5a0-   8.6.0    1
+    8.5a6-   8.5a5    0
+    8.5a6-   8.5b1    1
+    8.5a6-   8.5.1    1
+    8.5a6-   8.6a0    1
+    8.5a6-   8.6b0    1
+    8.5a6-   8.6.0    1
+    8.5b0-   8.5a5    0
+    8.5b0-   8.5b1    1
+    8.5b0-   8.5.1    1
+    8.5b0-   8.6a0    1
+    8.5b0-   8.6b0    1
+    8.5b0-   8.6.0    1
+    8.5b2-   8.5a5    0
+    8.5b2-   8.5b1    0
+    8.5b2-   8.5.1    1
+    8.5b2-   8.6a0    1
+    8.5b2-   8.6b0    1
+    8.5b2-   8.6.0    1
+    8.5-     8.5a5    1
+    8.5-     8.5b1    1
+    8.5-     8.5.1    1
+    8.5-     8.6a0    1
+    8.5-     8.6b0    1
+    8.5-     8.6.0    1
+    8.5.0-   8.5a5    0
+    8.5.0-   8.5b1    0
+    8.5.0-   8.5.1    1
+    8.5.0-   8.6a0    1
+    8.5.0-   8.6b0    1
+    8.5.0-   8.6.0    1
+    8.5a0-7  8.5a5    0
+    8.5a0-7  8.5b1    0
+    8.5a0-7  8.5.1    0
+    8.5a0-7  8.6a0    0
+    8.5a0-7  8.6b0    0
+    8.5a0-7  8.6.0    0
+    8.5a6-7  8.5a5    0
+    8.5a6-7  8.5b1    0
+    8.5a6-7  8.5.1    0
+    8.5a6-7  8.6a0    0
+    8.5a6-7  8.6b0    0
+    8.5a6-7  8.6.0    0
+    8.5b0-7  8.5a5    0
+    8.5b0-7  8.5b1    0
+    8.5b0-7  8.5.1    0
+    8.5b0-7  8.6a0    0
+    8.5b0-7  8.6b0    0
+    8.5b0-7  8.6.0    0
+    8.5b2-7  8.5a5    0
+    8.5b2-7  8.5b1    0
+    8.5b2-7  8.5.1    0
+    8.5b2-7  8.6a0    0
+    8.5b2-7  8.6b0    0
+    8.5b2-7  8.6.0    0
+    8.5-7    8.5a5    0
+    8.5-7    8.5b1    0
+    8.5-7    8.5.1    0
+    8.5-7    8.6a0    0
+    8.5-7    8.6b0    0
+    8.5-7    8.6.0    0
+    8.5.0-7  8.5a5    0
+    8.5.0-7  8.5b1    0
+    8.5.0-7  8.5.1    0
+    8.5.0-7  8.6a0    0
+    8.5.0-7  8.6b0    0
+    8.5.0-7  8.6.0    0
+    8.5a0-8.6.1 8.5a5    1
+    8.5a0-8.6.1 8.5b1    1
+    8.5a0-8.6.1 8.5.1    1
+    8.5a0-8.6.1 8.6a0    1
+    8.5a0-8.6.1 8.6b0    1
+    8.5a0-8.6.1 8.6.0    1
+    8.5a6-8.6.1 8.5a5    0
+    8.5a6-8.6.1 8.5b1    1
+    8.5a6-8.6.1 8.5.1    1
+    8.5a6-8.6.1 8.6a0    1
+    8.5a6-8.6.1 8.6b0    1
+    8.5a6-8.6.1 8.6.0    1
+    8.5b0-8.6.1 8.5a5    0
+    8.5b0-8.6.1 8.5b1    1
+    8.5b0-8.6.1 8.5.1    1
+    8.5b0-8.6.1 8.6a0    1
+    8.5b0-8.6.1 8.6b0    1
+    8.5b0-8.6.1 8.6.0    1
+    8.5b2-8.6.1 8.5a5    0
+    8.5b2-8.6.1 8.5b1    0
+    8.5b2-8.6.1 8.5.1    1
+    8.5b2-8.6.1 8.6a0    1
+    8.5b2-8.6.1 8.6b0    1
+    8.5b2-8.6.1 8.6.0    1
+    8.5-8.6.1 8.5a5    1
+    8.5-8.6.1 8.5b1    1
+    8.5-8.6.1 8.5.1    1
+    8.5-8.6.1 8.6a0    1
+    8.5-8.6.1 8.6b0    1
+    8.5-8.6.1 8.6.0    1
+    8.5.0-8.6.1 8.5a5    0
+    8.5.0-8.6.1 8.5b1    0
+    8.5.0-8.6.1 8.5.1    1
+    8.5.0-8.6.1 8.6a0    1
+    8.5.0-8.6.1 8.6b0    1
+    8.5.0-8.6.1 8.6.0    1
+    8.5a0-8.5a0 8.5a0    1
+    8.5a0-8.5a0 8.5b1    0
+    8.5a0-8.5a0 8.4      0
+    8.5b0-8.5b0 8.5a5    0
+    8.5b0-8.5b0 8.5b0    1
+    8.5b0-8.5b0 8.5.1    0
+    8.5-8.5  8.5a5    0
+    8.5-8.5  8.5b1    0
+    8.5-8.5  8.5      1
+    8.5-8.5  8.5.1    0
+    8.5.0-8.5.0 8.5a5    0
+    8.5.0-8.5.0 8.5b1    0
+    8.5.0-8.5.0 8.5.0    1
+    8.5.0-8.5.0 8.5.1    0
+    8.5.0-8.5.0 8.6a0    0
+    8.5.0-8.5.0 8.6b0    0
+    8.5.0-8.5.0 8.6.0    0
+    8.2      9        0
+    8.2-     9        1
+    8.2-8.5  9        0
+    8.2-9.1  9        1
+
+    8.5-8.5     8.5b1 0
+    8.5a0-8.5   8.5b1 0
+    8.5a0-8.5.1 8.5b1 1
+
+    8.5-8.5     8.5 1
+    8.5.0-8.5.0 8.5 1
+    8.5a0-8.5.0 8.5 0
+
+} {
+    test package-vsatisfies-2.$n "package vsatisfies $provided $required" {
+	package vsatisfies $provided $required
+    } $satisfied
+    incr n
+}
+
+test package-vsatisfies-3.0 "package vsatisfies multiple" {
+    #                      yes no
+    package vsatisfies 8.4 8.4 7.3
+} 1
+
+test package-vsatisfies-3.1 "package vsatisfies multiple" {
+    #                      no  yes
+    package vsatisfies 8.4 7.3 8.4
+} 1
+
+test package-vsatisfies-3.2 "package vsatisfies multiple" {
+    #                        yes  yes
+    package vsatisfies 8.4.2 8.4  8.4.1
+} 1
+
+test package-vsatisfies-3.3 "package vsatisfies multiple" {
+    #                      no  no
+    package vsatisfies 8.4 7.3 6.1
+} 0
+
+
+proc prefer {args} {
+    set ip [interp create]
+    lappend res [$ip eval {package prefer}]
+    foreach mode $args {
+	lappend res [$ip eval [list package prefer $mode]]
+    }
+    interp delete $ip
+    return $res
+}
+
+test package-prefer-1.0 {default} {
+    prefer
+} stable
+
+test package-prefer-1.1 {default} {
+    set   ::env(TCL_PKG_PREFER_LATEST) stable ; # value not relevant!
+    set res [prefer]
+    unset ::env(TCL_PKG_PREFER_LATEST)
+    set res
+} latest
+
+test package-prefer-2.0 {wrong\#args} {
+    catch {package prefer foo bar} msg
+    set msg
+} {wrong # args: should be "package prefer ?latest|stable?"}
+
+test package-prefer-2.1 {bogus argument} {
+    catch {package prefer foo} msg
+    set msg
+} {bad preference "foo": must be latest or stable}
+
+test package-prefer-3.0 {set, keep} {
+    package prefer stable
+} stable
+
+test package-prefer-3.1 {set stable, keep} {
+    prefer stable
+} {stable stable}
+
+test package-prefer-3.2 {set latest, change} {
+    prefer latest
+} {stable latest}
+
+test package-prefer-3.3 {set latest, keep} {
+    prefer  latest latest
+} {stable latest latest}
+
+test package-prefer-3.3 {set stable, rejected} {
+    prefer latest stable
+} {stable latest latest}
+
+rename prefer {}
+
+
 set auto_path $oldPath
 package unknown $oldPkgUnknown
 concat