merge trunk

6 files changed, 490 insertions, 5 deletions

diff --git a/tests/execute.test b/tests/execute.test
index aaf4bc0..9a2ffbd 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -1057,6 +1057,15 @@ test execute-11.2 {Bug 268b23df11} -setup {
     rename crash {}
     rename zero {}
 } -result 0
+test execute-11.3 {Bug a0ece9d6d4} -setup {
+    proc crash {} {expr {rand()}}
+    trace add execution crash enterstep {apply {args {info frame -2}}}
+} -body {
+    string is double [crash]
+} -cleanup {
+    trace remove execution crash enterstep {apply {args {info frame -2}}}
+    rename crash {}
+} -result 1
 
 # cleanup
 if {[info commands testobj] != {}} {
diff --git a/tests/expr.test b/tests/expr.test
index 6ad7208..4c03262 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -7174,6 +7174,10 @@ test expr-50.1 {test sqrt() of bignums with non-Inf answer} {
     expr {sqrt("1[string repeat 0 616]") == 1e308}
 } 1
 
+test expr-51.1 {test round-to-even on input} {
+    expr 6.9294956446009195e15
+} 6929495644600920.0
+
 
 
 # cleanup
diff --git a/tests/lreplace.test b/tests/lreplace.test
index d1319c6..e66a331 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -133,7 +133,6 @@ test lreplace-3.1 {lreplace won't modify shared argument objects} {
 test lreplace-4.1 {Bug ccc2c2cc98: lreplace edge case} {
     lreplace {} 1 1
 } {}
-# Note that this test will fail in 8.5
 test lreplace-4.2 {Bug ccc2c2cc98: lreplace edge case} {
     lreplace { } 1 1
 } {}
@@ -146,6 +145,42 @@ test lreplace-4.4 {lreplace edge case} {
 test lreplace-4.5 {lreplace edge case} {
     lreplace {1 2 3 4 5} 3 0 _
 } {1 2 3 _ 4 5}
+test lreplace-4.6 {lreplace end-x: bug a4cb3f06c4} {
+    lreplace {0 1 2 3 4} 0 end-2
+} {3 4}
+test lreplace-4.6.1 {lreplace end-x: bug a4cb3f06c4} {
+    lreplace {0 1 2 3 4} 0 end-2 a b c
+} {a b c 3 4}
+test lreplace-4.7 {lreplace with two end-indexes: increasing} {
+    lreplace {0 1 2 3 4} end-2 end-1
+} {0 1 4}
+test lreplace-4.7.1 {lreplace with two end-indexes: increasing} {
+    lreplace {0 1 2 3 4} end-2 end-1 a b c
+} {0 1 a b c 4}
+test lreplace-4.8 {lreplace with two end-indexes: equal} {
+    lreplace {0 1 2 3 4} end-2 end-2
+} {0 1 3 4}
+test lreplace-4.8.1 {lreplace with two end-indexes: equal} {
+    lreplace {0 1 2 3 4} end-2 end-2 a b c
+} {0 1 a b c 3 4}
+test lreplace-4.9 {lreplace with two end-indexes: decreasing} {
+    lreplace {0 1 2 3 4} end-2 end-3
+} {0 1 2 3 4}
+test lreplace-4.9.1 {lreplace with two end-indexes: decreasing} {
+    lreplace {0 1 2 3 4} end-2 end-3 a b c
+} {0 1 a b c 2 3 4}
+test lreplace-4.10 {lreplace with two equal indexes} {
+    lreplace {0 1 2 3 4} 2 2
+} {0 1 3 4}
+test lreplace-4.10.1 {lreplace with two equal indexes} {
+    lreplace {0 1 2 3 4} 2 2 a b c
+} {0 1 a b c 3 4}
+test lreplace-4.11 {lreplace end index first} {
+    lreplace {0 1 2 3 4} end-2 1 a b c
+} {0 1 a b c 2 3 4}
+test lreplace-4.12 {lreplace end index first} {
+    lreplace {0 1 2 3 4} end-2 2 a b c
+} {0 1 a b c 3 4}
 
 # cleanup
 catch {unset foo}
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 050b592..6b965d1 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -17,8 +17,8 @@ if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
     return
 }
-if {[catch {package require msgcat 1.5}]} {
-    puts stderr "Skipping tests in [info script].  No msgcat 1.5 found to test."
+if {[catch {package require msgcat 1.6}]} {
+    puts stderr "Skipping tests in [info script].  No msgcat 1.6 found to test."
     return
 }
 
@@ -32,6 +32,8 @@ namespace eval ::msgcat::test {
 
     # Tests msgcat-0.*: locale initialization
 
+    # Calculate set of all permutations of a list
+    # PowerSet {1 2 3} -> {1 2 3} {2 3} {1 3} 3 {1 2} 2 1 {}
     proc PowerSet {l} {
 	if {[llength $l] == 0} {return [list [list]]}
 	set element [lindex $l 0]
@@ -412,9 +414,14 @@ namespace eval ::msgcat::test {
     foreach loc {foo foo_BAR foo_BAR_baz} {
 	test msgcat-5.$count {mcload} -setup {
 	    variable locale [mclocale]
+	    ::msgcat::mclocale ""
+	    ::msgcat::mcloadedlocales clear
+	    ::msgcat::mcpackageconfig unset mcfolder 
 	    mclocale $loc
 	} -cleanup {
 	    mclocale $locale
+	    ::msgcat::mcloadedlocales clear
+	    ::msgcat::mcpackageconfig unset mcfolder 
 	} -body {
 	    mcload $msgdir
 	} -result [expr { $count+1 }]
@@ -428,6 +435,8 @@ namespace eval ::msgcat::test {
 	    mclocale foo_BAR_notexist
 	} -cleanup {
 	    mclocale $locale
+	    mcloadedlocales clear
+	    mcpackageconfig unset mcfolder 
 	} -body {
 	    mcload $msgdir
 	} -result 3
@@ -437,6 +446,8 @@ namespace eval ::msgcat::test {
 	    mclocale no_FI_notexist
 	} -cleanup {
 	    mclocale $locale
+	    mcloadedlocales clear
+	    mcpackageconfig unset mcfolder 
 	} -body {
 	    mcload $msgdir
 	} -result 1
@@ -497,6 +508,20 @@ namespace eval ::msgcat::test {
 	    mc def
 	} -result unknown:no_fi_notexist:def
 
+	test msgcat-5.11 {mcpackageconfig mcfolder} -setup {
+	    variable locale [mclocale]
+	    mclocale ""
+	    mcloadedlocales clear
+	    mcpackageconfig unset mcfolder
+	} -cleanup {
+	    mclocale $locale
+	    mcloadedlocales clear
+	    mcpackageconfig unset mcfolder 
+	} -body {
+	    mclocale foo
+	    mcpackageconfig set mcfolder $msgdir
+	} -result 2
+
     foreach loc $locales {
 	if { $loc eq {} } {
 	    set msg ROOT
@@ -657,6 +682,394 @@ namespace eval ::msgcat::test {
     removeDirectory msgdir2
     removeDirectory msgdir3
 
+    # Tests msgcat-9.*: [mcexists]
+
+	test msgcat-9.1 {mcexists no parameter} -body {
+	    mcexists
+	} -returnCodes 1\
+	-result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? src"}
+    
+	test msgcat-9.2 {mcexists unknown option} -body {
+	    mcexists -unknown src 
+	} -returnCodes 1\
+	-result {unknown option "-unknown"}
+    
+	test msgcat-9.3 {mcexists} -setup {
+	    mcforgetpackage
+	    variable locale [mclocale]
+	    mclocale foo
+	    mcset foo k1 v1
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    list [mcexists k1] [mcexists k2]
+	} -result {1 0}
+
+	test msgcat-9.4 {mcexists descendent preference} -setup {
+	    mcforgetpackage
+	    variable locale [mclocale]
+	    mclocale foo_bar
+	    mcset foo k1 v1
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    list [mcexists k1] [mcexists -exactlocale k1]
+	} -result {1 0}
+    
+	test msgcat-9.5 {mcexists parent namespace} -setup {
+	    mcforgetpackage
+	    variable locale [mclocale]
+	    mclocale foo_bar
+	    mcset foo k1 v1
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    namespace eval ::msgcat::test::sub {
+		list [::msgcat::mcexists k1]\
+			[::msgcat::mcexists -exactnamespace k1]
+	    }
+	} -result {1 0}
+    
+    # Tests msgcat-10.*: [mcloadedlocales]
+
+	test msgcat-10.1 {mcloadedlocales no arg} -body {
+	    mcloadedlocales
+	} -returnCodes 1\
+	-result {wrong # args: should be "mcloadedlocales subcommand"}
+    
+	test msgcat-10.2 {mcloadedlocales wrong subcommand} -body {
+	    mcloadedlocales junk
+	} -returnCodes 1\
+	-result {unknown subcommand "junk": must be clear, or loaded}
+    
+	test msgcat-10.3 {mcloadedlocales loaded} -setup {
+	    mcforgetpackage
+	    variable locale [mclocale]
+	    mclocale {}
+	    mcloadedlocales clear
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    mclocale foo_bar
+	    # The result is position independent so sort
+	    set resultlist [lsort [mcloadedlocales loaded]]
+	} -result {{} foo foo_bar}
+    
+	test msgcat-10.4 {mcloadedlocales clear} -setup {
+	    mcforgetpackage
+	    variable locale [mclocale]
+	    mclocale {}
+	    mcloadedlocales clear
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    mclocale foo
+	    mcset foo k1 v1
+	    set res [mcexists k1]
+	    mclocale ""
+	    mcloadedlocales clear
+	    mclocale foo
+	    lappend res [mcexists k1]
+	} -result {1 0}
+
+    # Tests msgcat-11.*: [mcforgetpackage]
+
+	test msgcat-11.1 {mcforgetpackage translation} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    mclocale foo
+	    mcset foo k1 v1
+	    set res [mcexists k1]
+	    mcforgetpackage
+	    lappend res [mcexists k1]
+	} -result {1 0}
+
+	test msgcat-11.2 {mcforgetpackage locale} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    mclocale foo
+	    mcpackagelocale set bar
+	    set res [mcpackagelocale get]
+	    mcforgetpackage
+	    lappend res [mcpackagelocale get]
+	} -result {bar foo}
+
+	test msgcat-11.3 {mcforgetpackage options} -body {
+	    mcpackageconfig set loadcmd ""
+	    set res [mcpackageconfig isset loadcmd]
+	    mcforgetpackage
+	    lappend res [mcpackageconfig isset loadcmd]
+	} -result {1 0}
+
+    # Tests msgcat-12.*: [mcpackagelocale]
+
+	test msgcat-12.1 {mcpackagelocale no subcommand} -body {
+	    mcpackagelocale
+	} -returnCodes 1\
+	-result {wrong # args: should be "mcpackagelocale subcommand ?locale?"}
+
+	test msgcat-12.2 {mclpackagelocale wrong subcommand} -body {
+	    mcpackagelocale junk
+	} -returnCodes 1\
+	-result {unknown subcommand "junk": must be clear, get, isset, loaded, present, set, or unset}
+
+	test msgcat-12.3 {mcpackagelocale set} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	    mcforgetpackage
+	} -body {
+	    mclocale foo
+	    mcpackagelocale set bar
+	    list [mcpackagelocale get] [mclocale]
+	} -result {bar foo}
+
+	test msgcat-12.4 {mcpackagelocale get} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	    mcforgetpackage
+	} -body {
+	    mclocale foo
+	    set res [mcpackagelocale get]
+	    mcpackagelocale set bar
+	    lappend res [mcpackagelocale get]
+	} -result {foo bar}
+
+	test msgcat-12.5 {mcpackagelocale preferences} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	    mcforgetpackage
+	} -body {
+	    mclocale foo
+	    set res [list [mcpackagelocale preferences]]
+	    mcpackagelocale set bar
+	    lappend res [mcpackagelocale preferences]
+	} -result {{foo {}} {bar {}}}
+
+	test msgcat-12.6 {mcpackagelocale loaded} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	    mcforgetpackage
+	} -body {
+	    mclocale ""
+	    mcloadedlocales clear
+	    mclocale foo
+	    # The result is position independent so sort
+	    set res [list [lsort [mcpackagelocale loaded]]]
+	    mcpackagelocale set bar
+	    lappend res [lsort [mcpackagelocale loaded]]
+	} -result {{{} foo} {{} bar foo}}
+
+	test msgcat-12.7 {mcpackagelocale isset} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	    mcforgetpackage
+	} -body {
+	    mclocale foo
+	    set res [mcpackagelocale isset]
+	    mcpackagelocale set bar
+	    lappend res [mcpackagelocale isset]
+	} -result {0 1}
+
+	test msgcat-12.8 {mcpackagelocale unset} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	    mcforgetpackage
+	} -body {
+	    mcpackagelocale set bar
+	    set res [mcpackagelocale isset]
+	    mcpackagelocale unset
+	    lappend res [mcpackagelocale isset]
+	} -result {1 0}
+
+	test msgcat-12.9 {mcpackagelocale present} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	    mcforgetpackage
+	} -body {
+	    mclocale ""
+	    mcloadedlocales clear
+	    mclocale foo
+	    set res [mcpackagelocale present foo]
+	    lappend res [mcpackagelocale present bar]
+	    mcpackagelocale set bar
+	    lappend res [mcpackagelocale present foo]\
+		    [mcpackagelocale present bar]
+	} -result {1 0 1 1}
+
+	test msgcat-12.10 {mcpackagelocale clear} -setup {
+	    variable locale [mclocale]
+	} -cleanup {
+	    mclocale $locale
+	    mcforgetpackage
+	} -body {
+	    mclocale ""
+	    mcloadedlocales clear
+	    mclocale foo
+	    mcpackagelocale set bar
+	    mcpackagelocale clear
+	    list [mcpackagelocale present foo] [mcpackagelocale present bar]
+	} -result {0 1}
+
+    # Tests msgcat-13.*: [mcpackageconfig subcmds]
+
+	test msgcat-13.1 {mcpackageconfig no subcommand} -body {
+	    mcpackageconfig
+	} -returnCodes 1\
+	-result {wrong # args: should be "mcpackageconfig subcommand option ?value?"}
+
+	test msgcat-13.2 {mclpackageconfig wrong subcommand} -body {
+	    mcpackageconfig junk mcfolder
+	} -returnCodes 1\
+	-result {unknown subcommand "junk": must be get, isset, set, or unset}
+
+	test msgcat-13.3 {mclpackageconfig wrong option} -body {
+	    mcpackageconfig get junk
+	} -returnCodes 1\
+	-result {bad option "junk": must be mcfolder, loadcmd, changecmd, or unknowncmd}
+
+	test msgcat-13.4 {mcpackageconfig get} -setup {
+	    mcforgetpackage
+	} -cleanup {
+	    mcforgetpackage
+	} -body {
+	    mcpackageconfig set loadcmd ""
+	    mcpackageconfig get loadcmd
+	} -result {}
+
+	test msgcat-13.5 {mcpackageconfig (is/un)set} -setup {
+	    mcforgetpackage
+	} -cleanup {
+	    mcforgetpackage
+	} -body {
+	    set res [mcpackageconfig isset loadcmd]
+	    lappend res [mcpackageconfig set loadcmd ""]
+	    lappend res [mcpackageconfig isset loadcmd]
+	    mcpackageconfig unset loadcmd
+	    lappend res [mcpackageconfig isset loadcmd]
+	} -result {0 0 1 0}
+
+    # option mcfolder is already tested with 5.11
+    
+    # Tests msgcat-14.*: callbacks: loadcmd, changecmd, unknowncmd
+    
+    # This routine is used as bgerror and by direct callback invocation
+    proc callbackproc args {
+	variable resultvariable
+	set resultvariable $args
+    }
+    proc callbackfailproc args {
+	return -code error fail
+    }
+    set bgerrorsaved [interp bgerror {}]
+    interp bgerror {} [namespace code callbackproc]
+    
+	test msgcat-14.1 {invokation loadcmd} -setup {
+	    mcforgetpackage
+    	    mclocale $locale
+	    mclocale ""
+	    mcloadedlocales clear
+	    set resultvariable ""
+	} -cleanup {
+	    mcforgetpackage
+	} -body {
+	    mcpackageconfig set loadcmd [namespace code callbackproc]
+	    mclocale foo_bar
+	    lsort $resultvariable
+	} -result {foo foo_bar}
+
+	test msgcat-14.2 {invokation failed in loadcmd} -setup {
+	    mcforgetpackage
+    	    mclocale $locale
+	    mclocale ""
+	    mcloadedlocales clear
+	} -cleanup {
+	    mcforgetpackage
+	} -body {
+	    mcpackageconfig set loadcmd [namespace code callbackfailproc]
+	    mclocale foo_bar
+	    # let the bgerror run
+	    after 100 set [namespace current]::resultvariable timeout
+	    vwait [namespace current]::resultvariable
+	    lassign $resultvariable err errdict
+	    list $err [dict get $errdict -code]
+	} -result {fail 1}
+
+	test msgcat-14.3 {invokation changecmd} -setup {
+	    mcforgetpackage
+    	    mclocale $locale
+	    mclocale ""
+	    set resultvariable ""
+	} -cleanup {
+	    mcforgetpackage
+	} -body {
+	    mcpackageconfig set changecmd [namespace code callbackproc]
+	    mclocale foo_bar
+	    set resultvariable
+	} -result {foo_bar foo {}}
+
+	test msgcat-14.4 {invokation unknowncmd} -setup {
+	    mcforgetpackage
+    	    mclocale $locale
+	    mclocale ""
+	    mcloadedlocales clear
+	    set resultvariable ""
+	} -cleanup {
+	    mcforgetpackage
+	} -body {
+	    mcpackageconfig set unknowncmd [namespace code callbackproc]
+	    mclocale foo_bar
+	    mc k1 p1
+	    set resultvariable
+	} -result {foo_bar k1 p1}
+
+	test msgcat-14.5 {disable global unknowncmd} -setup {
+	    mcforgetpackage
+    	    mclocale $locale
+	    mclocale ""
+	    mcloadedlocales clear
+	    set resultvariable ""
+	    rename ::msgcat::mcunknown SavedMcunknown
+	    proc ::msgcat::mcunknown {dom s} {
+		return unknown:$dom:$s
+	    }
+	} -cleanup {
+	    mcforgetpackage
+	    rename ::msgcat::mcunknown {}
+	    rename SavedMcunknown ::msgcat::mcunknown
+	} -body {
+	    mcpackageconfig set unknowncmd ""
+	    mclocale foo_bar
+	    mc k1%s p1
+	} -result {k1p1}
+
+	test msgcat-14.6 {unknowncmd failing} -setup {
+	    mcforgetpackage
+    	    mclocale $locale
+	    mclocale ""
+	    mcloadedlocales clear
+	    set resultvariable ""
+	} -cleanup {
+	    mcforgetpackage
+	} -body {
+	    mcpackageconfig set unknowncmd [namespace code callbackfailproc]
+	    mclocale foo_bar
+	    mc k1
+	} -returnCodes 1\
+	-result {fail}
+
+    interp bgerror {} $bgerrorsaved
+
     cleanupTests
 }
 namespace delete ::msgcat::test
diff --git a/tests/oo.test b/tests/oo.test
index f35b70a..c83e015 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -2077,6 +2077,30 @@ test oo-16.13 {OO: object introspection} -setup {
     oo::objdefine foo method Bar {} {return "ok in foo"}
     [info object namespace foo]::my Bar
 } -result "ok in foo"
+test oo-16.14 {OO: object introspection: TIP #436} -setup {
+    oo::class create meta { superclass oo::class }
+    [meta create instance1] create instance2
+} -body {
+    list class [list [info object isa class NOTANOBJECT] \
+		    [info object isa class list]] \
+	meta [list [info object isa metaclass NOTANOBJECT] \
+		  [info object isa metaclass list] \
+		  [info object isa metaclass oo::object]] \
+	type [list [info object isa typeof oo::object NOTANOBJECT] \
+		  [info object isa typeof NOTANOBJECT oo::object] \
+		  [info object isa typeof list NOTANOBJECT] \
+		  [info object isa typeof NOTANOBJECT list] \
+		  [info object isa typeof oo::object list] \
+		  [info object isa typeof list oo::object]] \
+	mix [list [info object isa mixin oo::object NOTANOBJECT] \
+		 [info object isa mixin NOTANOBJECT oo::object] \
+		 [info object isa mixin list NOTANOBJECT] \
+		 [info object isa mixin NOTANOBJECT list] \
+		 [info object isa mixin oo::object list] \
+		 [info object isa mixin list oo::object]]
+} -cleanup {
+    meta destroy
+} -result {class {0 0} meta {0 0 0} type {0 0 0 0 0 0} mix {0 0 0 0 0 0}}
 
 test oo-17.1 {OO: class introspection} -body {
     info class
diff --git a/tests/registry.test b/tests/registry.test
index 77588e3..0f78212 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -19,7 +19,7 @@ testConstraint reg 0
 if {[testConstraint win]} {
     if {![catch {
 	    ::tcltest::loadTestedCommands
-	    set ::regver [package require registry 1.3.0]
+	    set ::regver [package require registry 1.3.1]
 	}]} {
 	testConstraint reg 1
     }
@@ -33,7 +33,7 @@ testConstraint english [expr {
 
 test registry-1.0 {check if we are testing the right dll} {win reg} {
     set ::regver
-} {1.3.0}
+} {1.3.1}
 test registry-1.1 {argument parsing for registry command} {win reg} {
     list [catch {registry} msg] $msg
 } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}