summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/execute.test9
-rw-r--r--tests/expr.test4
-rw-r--r--tests/lreplace.test37
-rw-r--r--tests/msgcat.test417
-rw-r--r--tests/oo.test24
-rw-r--r--tests/registry.test4
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 ...?"}}