diff options
Diffstat (limited to 'tests/error.test')
| -rw-r--r-- | tests/error.test | 513 |
1 files changed, 468 insertions, 45 deletions
diff --git a/tests/error.test b/tests/error.test index 6125dd4..0de644c 100644 --- a/tests/error.test +++ b/tests/error.test @@ -10,15 +10,32 @@ # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: error.test,v 1.18 2009/01/13 20:30:04 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* } +testConstraint memory [llength [info commands memory]] +customMatch pairwise {apply {{a b} { + string equal [lindex $b 0] [lindex $b 1] +}}} namespace eval ::tcl::test::error { +if {[testConstraint memory]} { + proc getbytes {} { + set lines [split [memory info] \n] + return [lindex $lines 3 3] + } + proc leaktest {script {iterations 3}} { + set end [getbytes] + for {set i 0} {$i < $iterations} {incr i} { + uplevel 1 $script + set tmp $end + set end [getbytes] + } + return [expr {$end - $tmp}] + } +} proc foo {} { global errorInfo @@ -124,7 +141,7 @@ test error-3.3 {errors in catch command} { catch {unset a} set a(0) 22 list [catch {catch {format 44} a} msg] $msg -} {1 {couldn't save command result in variable}} +} {1 {can't set "a": variable is array}} catch {unset a} # More tests related to errorInfo and errorCode @@ -153,6 +170,29 @@ test error-4.5 {errorInfo and errorCode variables} { list [catch {error msg1 msg2 {}} msg] $msg $::errorInfo $::errorCode } {1 msg1 msg2 {}} +test error-4.6 {errorstack via info } -body { + proc f x {g $x$x} + proc g x {error G:$x} + catch {f 12} + info errorstack +} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1} +test error-4.7 {errorstack via options dict } -body { + proc f x {g $x$x} + proc g x {error G:$x} + catch {f 12} m d + dict get $d -errorstack +} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1} +test error-4.8 {errorstack from exec traces} -body { + proc foo args {} + proc goo {} foo + trace add execution foo enter {error bar;#} + catch goo m d + dict get $d -errorstack +} -cleanup { + rename goo {}; rename foo {} + unset -nocomplain m d +} -result {INNER {error bar} CALL goo UP 1} + # Errors in error command itself test error-5.1 {errors in error command} { @@ -207,6 +247,15 @@ test error-6.9 {catch must reset error state} { catch foo list $::errorCode } {NONE} +test error-6.10 {catch must reset errorstack} -body { + proc f x {g $x$x} + proc g x {error G:$x} + catch {f 12} + set e1 [info errorstack] + catch {f 13} + set e2 [info errorstack] + list $e1 $e2 +} -match glob -result {{INNER * CALL {g 1212} CALL {f 12} UP 1} {INNER * CALL {g 1313} CALL {f 13} UP 1}} test error-7.1 {Bug 1397843} -body { variable cmds @@ -278,6 +327,12 @@ test error-8.8 {throw syntax checks} -returnCodes error -body { test error-8.9 {throw syntax checks} -returnCodes error -body { throw {} foo } -result {type must be non-empty list} +test error-8.10 {Bug 33b7abb8a2: throw stack usage} -returnCodes error -body { + apply {code {throw $code foo}} {} +} -result {type must be non-empty list} +test error-8.11 {Bug 7174354ecb: throw error message} -returnCodes error -body { + throw {not {}a list} x[]y +} -result {list element in braces followed by "a" instead of space} # simple try tests: body completes with code ok @@ -381,7 +436,7 @@ test error-12.4 {try with result/opts variable assignment in on handler} { } {bar,FOO} test error-12.5 {try with result/opts variable assignment in on handler, vars remain in scope} { try { throw FOO bar } on error {res opts} { list d e f } - set r "$res,[dict get $opts -errorcode]" + set r "$res,[dict get $opts -errorcode]" } {bar,FOO} test error-12.6 {try result is propagated if no matching handler} { try { list a b c } on error {} { list d e f } @@ -396,38 +451,38 @@ test error-13.1 {try with no arguments} -body { # warning: error message may change try } -returnCodes error -match glob -result {wrong # args: *} -test error-13.2 {try with body only (ok) } { +test error-13.2 {try with body only (ok)} { try list } {} -test error-13.3 {try with missing finally body } -body { +test error-13.3 {try with missing finally body} -body { # warning: error message may change try list finally -} -returnCodes error -match glob -result {wrong # args: *} -test error-13.4 {try with bad handler keyword } -body { +} -returnCodes error -match glob -result {wrong # args to finally clause: *} +test error-13.4 {try with bad handler keyword} -body { # warning: error message may change try list then a b c } -returnCodes error -match glob -result {bad handler *} -test error-13.5 {try with partial handler #1 } -body { +test error-13.5 {try with partial handler #1} -body { # warning: error message may change try list on -} -returnCodes error -match glob -result {bad code *} -test error-13.6 {try with partial handler #2 } -body { +} -returnCodes error -match glob -result {wrong # args to on clause: *} +test error-13.6 {try with partial handler #2} -body { # warning: error message may change try list on error -} -returnCodes error -match glob -result {wrong # args: *} -test error-13.7 {try with partial handler #3 } -body { +} -returnCodes error -match glob -result {wrong # args to on clause: *} +test error-13.7 {try with partial handler #3} -body { # warning: error message may change try list on error {em opts} -} -returnCodes error -match glob -result {wrong # args: *} +} -returnCodes error -match glob -result {wrong # args to on clause: *} test error-13.8 {try with multiple handlers and finally (ok)} { try list on error {} {} trap {} {} {} finally {} } {} test error-13.9 {last handler body can't be a fallthrough #1} -body { - try list on error {} {} on break {} - -} -returnCodes error -match glob -result {wrong # args: *} + try list on error {} {} on break {} - +} -returnCodes error -result {last non-finally clause must not have a body of "-"} test error-13.10 {last handler body can't be a fallthrough #2} -body { try list on error {} {} on break {} - finally { list d e f } -} -returnCodes error -match glob -result {wrong # args: *} +} -returnCodes error -result {last non-finally clause must not have a body of "-"} # try tests - multiple handlers (left-to-right matching, only one runs) @@ -435,7 +490,7 @@ test error-14.1 {try with multiple handlers (only one matches) #1} { try { throw FOO bar } on ok {} { list a b c } trap FOO {} { list d e f } } {d e f} test error-14.2 {try with multiple handlers (only one matches) #2} { - try { throw FOO bar } trap FOO {} { list d e f } on ok {} { list a b c } + try { throw FOO bar } trap FOO {} { list d e f } on ok {} { list a b c } } {d e f} test error-14.3 {try with multiple handlers (only one matches) #3} { try { @@ -446,7 +501,7 @@ test error-14.3 {try with multiple handlers (only one matches) #3} { list d e f } on ok {} { list a b c - } + } } {d e f} test error-14.4 {try with multiple matching handlers (only the first in left-to-right order runs) #1} { try { throw FOO bar } on error {} { list a b c } trap FOO {} { list d e f } @@ -491,6 +546,46 @@ test error-15.7 {try with no matching handler (unknown integer result propagates try { return -level 0 -code 123456 } trap {} {} { list a b c } } -returnCodes 123456 -result {} +foreach level {0 1 2 3} { + foreach code {0 1 2 3 4 5} { + + # Following cases have different -errorinfo; avoid false alarms + # TODO: examine whether these difference are as they ought to be. + if {$level == 0 && $code == 1} continue + + foreach extras {{} {-bar soom}} { + +test error-15.8.$level.$code.[llength $extras] {[try] coverage} { + set script {return -level $level -code $code {*}$extras foo} + catch $script m1 o1 + catch {try $script} m2 o2 + set o1 [lsort -stride 2 $o1] + set o2 [lsort -stride 2 $o2] + expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"} +} ok + +test error-15.9.$level.$code.[llength $extras] {[try] coverage} { + set script {return -level $level -code $code {*}$extras foo} + catch $script m1 o1 + catch {try $script finally {}} m2 o2 + set o1 [lsort -stride 2 $o1] + set o2 [lsort -stride 2 $o2] + expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"} +} ok + +test error-15.10.$level.$code.[llength $extras] {[try] coverage} { + set script {return -level $level -code $code {*}$extras foo} + catch $script m1 o1 + catch {try $script on $code {x y} {return -options $y $x}} m2 o2 + set o1 [lsort -stride 2 $o1] + set o2 [lsort -stride 2 $o2] + expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"} +} ok + + } + } +} + # try tests - propagation (exceptions in handlers, exception chaining) test error-16.1 {try with successfully executed handler} { @@ -517,29 +612,29 @@ test error-16.6 {try with variable assignment and propagation #1} { catch { try { throw FOO bar } trap FOO {em} { throw BAR baz } } - set em + set em } {bar} test error-16.7 {try with variable assignment and propagation #2} { catch { try { throw FOO bar } trap FOO {em opts} { throw BAR baz } } - list $em [dict get $opts -errorcode] + list $em [dict get $opts -errorcode] } {bar FOO} -test error-16.8 {exception chaining (try=ok, handler=error)} { - #FIXME is the intent of this test correct? +test error-16.8 {exception chaining (try=ok, handler=error)} -body { + #FIXME is the intent of this test correct? catch { try { list a b c } on ok {em opts} { throw BAR baz } } tryem tryopts - string equal $opts [dict get $tryopts -during] -} {1} -test error-16.9 {exception chaining (try=error, handler=error)} { + list $opts [dict get $tryopts -during] +} -match pairwise -result equal +test error-16.9 {exception chaining (try=error, handler=error)} -body { # The exception off the handler should chain to the exception off the # try-body (using the -during option) catch { try { throw FOO bar } trap {} {em opts} { throw BAR baz } } tryem tryopts - string equal $opts [dict get $tryopts -during] -} {1} + list $opts [dict get $tryopts -during] +} -match pairwise -result equal test error-16.10 {no exception chaining when handler is successful} { catch { try { throw FOO bar } trap {} {em opts} { list d e f } @@ -552,6 +647,131 @@ test error-16.11 {no exception chaining when handler is a non-error exception} { } tryem tryopts dict exists $tryopts -during } {0} +test error-16.12 {compiled try with successfully executed handler} { + apply {{} { + try { throw FOO bar } trap FOO {} { list a b c } + }} +} {a b c} +test error-16.13 {compiled try with exception (error) in handler} -body { + apply {{} { + try { throw FOO bar } trap FOO {} { throw BAR foo } + }} +} -returnCodes error -result {foo} +test error-16.14 {compiled try with exception (return) in handler} -body { + apply {{} { + list [catch { + try { throw FOO bar } trap FOO {} { return BAR } + } msg] $msg + }} +} -result {2 BAR} +test error-16.15 {compiled try with exception (break) in handler} { + apply {{} { + for { set i 5 } { $i < 10 } { incr i } { + try { throw FOO bar } trap FOO {} { break } + } + return $i + }} +} {5} +test error-16.16 {compiled try with exception (continue) in handler} { + apply {{} { + for { set i 5 } { $i < 10 } { incr i } { + try { throw FOO bar } trap FOO {} { continue } + incr i 20 + } + return $i + }} +} {10} +test error-16.17 {compiled try with variable assignment and propagation #1} { + # Ensure that the handler variables preserve the exception off the + # try-body, and are not modified by the exception off the handler + apply {{} { + catch { + try { throw FOO bar } trap FOO {em} { throw BAR baz } + } + return $em + }} +} {bar} +test error-16.18 {compiled try with variable assignment and propagation #2} { + apply {{} { + catch { + try { throw FOO bar } trap FOO {em opts} { throw BAR baz } + } + list $em [dict get $opts -errorcode] + }} +} {bar FOO} +test error-16.19 {compiled try exception chaining (try=ok, handler=error)} -body { + #FIXME is the intent of this test correct? + apply {{} { + catch { + try { list a b c } on ok {em opts} { throw BAR baz } + } tryem tryopts + list $opts [dict get $tryopts -during] + }} +} -match pairwise -result equal +test error-16.20 {compiled try exception chaining (try=error, handler=error)} -body { + # The exception off the handler should chain to the exception off the + # try-body (using the -during option) + apply {{} { + catch { + try { throw FOO bar } trap {} {em opts} { throw BAR baz } + } tryem tryopts + list $opts [dict get $tryopts -during] + }} +} -match pairwise -result equal +test error-16.21 {compiled try exception chaining (try=error, finally=error)} { + # The exception off the handler should chain to the exception off the + # try-body (using the -during option) + apply {{} { + catch { + try { throw FOO bar } finally { throw BAR baz } + } tryem tryopts + dict get $tryopts -during -errorcode + }} +} FOO +test error-16.22 {compiled try: no exception chaining when handler is successful} { + apply {{} { + catch { + try { throw FOO bar } trap {} {em opts} { list d e f } + } tryem tryopts + dict exists $tryopts -during + }} +} {0} +test error-16.23 {compiled try: no exception chaining when handler is a non-error exception} { + apply {{} { + catch { + try { throw FOO bar } trap {} {em opts} { break } + } tryem tryopts + dict exists $tryopts -during + }} +} {0} +test error-16.24 {compiled try exception chaining (try=ok, handler=error, finally=error)} -body { + apply {{} { + catch { + try { + list a b c + } on ok {em opts} { + throw BAR baz + } finally { + throw DING dong + } + } tryem tryopts + list $opts [dict get $tryopts -during -during] + }} +} -match pairwise -result equal +test error-16.25 {compiled try exception chaining (all errors)} -body { + apply {{} { + catch { + try { + throw FOO bar + } on error {em opts} { + throw BAR baz + } finally { + throw DING dong + } + } tryem tryopts + list $opts [dict get $tryopts -during -during] + }} +} -match pairwise -result equal # try tests - finally @@ -610,7 +830,7 @@ test error-17.11 {successful finally doesn't affect variable assignment or propa catch { try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { list d e f } } - list $em [dict get $opts -errorcode] + list $em [dict get $opts -errorcode] } {bar FOO} # try tests - propagation (exceptions in finally, exception chaining) @@ -631,17 +851,17 @@ test error-18.5 {exception in finally doesn't affect variable assignment} { catch { try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { throw BAZ zing } } - list $em [dict get $opts -errorcode] + list $em [dict get $opts -errorcode] } {bar FOO} -test error-18.6 {exception chaining in finally (try=ok)} { +test error-18.6 {exception chaining in finally (try=ok)} -body { catch { - list a b c + list a b c } em expopts catch { try { list a b c } finally { throw BAR foo } } em opts - string equal $expopts [dict get $opts -during] -} {1} + list $expopts [dict get $opts -during] +} -match pairwise -result equal test error-18.7 {exception chaining in finally (try=error)} { catch { try { throw FOO bar } finally { throw BAR baz } @@ -706,14 +926,14 @@ test error-19.1 {try with fallthrough body #1} { } {1} test error-19.2 {try with fallthrough body #2} { set RES {} - try { - throw FOO bar + try { + throw FOO bar } trap BAR {} { } trap FOO {} - trap {} {} { set RES foo } on error {} { set RES err - } + } set RES } {foo} test error-19.3 {try with cascade fallthrough} { @@ -729,24 +949,178 @@ test error-19.4 {multiple unrelated fallthroughs #1} { set RES {} try { throw FOO bar - } trap FOO {} - trap BAR {} { + } trap FOO {} - trap BAR {} { set RES foo } trap {} {} - on error {} { set RES err - } + } set RES } {foo} test error-19.5 {multiple unrelated fallthroughs #2} { set RES {} try { throw BAZ zing - } trap FOO {} - trap BAR {} { + } trap FOO {} - trap BAR {} { set RES foo } trap {} {} - on error {} { set RES err - } + } set RES } {err} +proc addmsg msg { + variable RES + lappend RES $msg +} +test error-19.6 {compiled try executes all clauses} -setup { + set RES {} +} -body { + apply {{} { + try { + addmsg a + throw bar hello + } trap bar {res opt} { + addmsg b + } finally { + addmsg c + } + addmsg d + } ::tcl::test::error} +} -cleanup { + unset RES +} -result {a b c d} +test error-19.7 {compiled try executes all clauses} -setup { + set RES {} +} -body { + apply {{} { + try { + addmsg a + } on error {res opt} { + addmsg b + } on ok {} { + addmsg c + } finally { + addmsg d + } + addmsg e + } ::tcl::test::error} +} -cleanup { + unset RES +} -result {a c d e} +test error-19.8 {compiled try executes all clauses} -setup { + set RES {} +} -body { + apply {{} { + try { + addmsg a + throw bar hello + } trap bar {res opt} { + addmsg b + } + addmsg c + } ::tcl::test::error} +} -cleanup { + unset RES +} -result {a b c} +test error-19.9 {compiled try executes all clauses} -setup { + set RES {} +} -body { + apply {{} { + try { + addmsg a + } on error {res opt} { + addmsg b + } on ok {} { + addmsg c + } + addmsg d + } ::tcl::test::error} +} -cleanup { + unset RES +} -result {a c d} +test error-19.10 {compiled try with chained clauses} -setup { + set RES {} +} -body { + list [apply {{} { + try { + return good + } on return {res} - on ok {res} { + addmsg ok + addmsg $res + return handler + } finally { + addmsg finally + } + } ::tcl::test::error}] $RES +} -cleanup { + unset RES +} -result {handler {ok good finally}} +test error-19.11 {compiled try and errors on variable write} -setup { + set RES {} +} -body { + apply {{} { + array set foo {bar boo} + set bar unset + catch { + try { + addmsg body + return a + } on return {bar foo} { + addmsg handler + return b + } finally { + addmsg finally,$bar + } + } msg + addmsg $msg + } ::tcl::test::error} +} -cleanup { + unset RES +} -result {body finally,a {can't set "foo": variable is array}} +test error-19.12 {interpreted try and errors on variable write} -setup { + set RES {} +} -body { + apply {try { + array set foo {bar boo} + set bar unset + catch { + $try { + addmsg body + return a + } on return {bar foo} { + addmsg handler + return b + } finally { + addmsg finally,$bar + } + } msg + addmsg $msg + } ::tcl::test::error} try +} -cleanup { + unset RES +} -result {body finally,a {can't set "foo": variable is array}} +test error-19.13 {compiled try and errors on variable write} -setup { + set RES {} +} -body { + apply {{} { + array set foo {bar boo} + set bar unset + catch { + try { + addmsg body + return a + } on return {bar foo} - on error {bar foo} { + addmsg handler + return b + } finally { + addmsg finally,$bar + } + } msg + addmsg $msg + } ::tcl::test::error} +} -cleanup { + unset RES +} -result {body finally,a {can't set "foo": variable is array}} +rename addmsg {} # FIXME test what vars get set on fallthough ... what is the correct behavior? # It would seem appropriate to set at least those for the matching handler and @@ -755,11 +1129,60 @@ test error-19.5 {multiple unrelated fallthroughs #2} { # negative case try tests - bad "on" handler test error-20.1 {bad code name in on handler} -body { - try { list a b c } on foo {} {} -} -returnCodes error -match glob -result {bad code *} + try { list a b c } on err {} {} +} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} test error-20.2 {bad code value in on handler} -body { try { list a b c } on 34985723094872345 {} {} -} -returnCodes error -match glob -result {bad code *} +} -returnCodes error -match glob -result {bad completion code "34985723094872345": must be ok, error, return, break, continue*, or an integer} + +test error-21.1 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {string repeat x 10} on ok {} {} + } +} 0 +test error-21.2 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {error [string repeat x 10]} on error {} {} + } +} 0 +test error-21.3 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {throw FOO [string repeat x 10]} trap FOO {} {} + } +} 0 +test error-21.4 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {string repeat x 10} + } +} 0 +test error-21.5 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {string repeat x 10} on ok {} {} finally {string repeat y 10} + } +} 0 +test error-21.6 {memory leaks in try: Bug 2910044} memory { + leaktest { + try { + error [string repeat x 10] + } on error {} {} finally { + string repeat y 10 + } + } +} 0 +test error-21.7 {memory leaks in try: Bug 2910044} memory { + leaktest { + try { + throw FOO [string repeat x 10] + } trap FOO {} {} finally { + string repeat y 10 + } + } +} 0 +test error-21.8 {memory leaks in try: Bug 2910044} memory { + leaktest { + try {string repeat x 10} finally {string repeat y 10} + } +} 0 # negative case try tests - bad "trap" handler # what is the effect if we attempt to trap an errorcode that is not a list? @@ -775,7 +1198,7 @@ namespace delete ::tcl::test::error # cleanup catch {rename p ""} ::tcltest::cleanupTests -return +return # Local Variables: # mode: tcl |