diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/for.test | 53 | ||||
| -rw-r--r-- | tests/switch.test | 57 |
2 files changed, 107 insertions, 3 deletions
diff --git a/tests/for.test b/tests/for.test index 0217f78..7c968f6 100644 --- a/tests/for.test +++ b/tests/for.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: for.test,v 1.11 2005/05/10 18:35:20 kennykb Exp $ +# RCS: @(#) $Id: for.test,v 1.12 2005/06/20 07:49:11 mdejong Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -763,7 +763,56 @@ test for-6.16 {Tcl_ForObjCmd: for command result} { set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}] set a } {} - +test for-6.17 {Tcl_ForObjCmd: for command result} { + list \ + [catch {for {break} {1} {} {}} err] $err \ + [catch {for {continue} {1} {} {}} err] $err \ + [catch {for {} {[break]} {} {}} err] $err \ + [catch {for {} {[continue]} {} {}} err] $err \ + [catch {for {} {1} {break} {}} err] $err \ + [catch {for {} {1} {continue} {}} err] $err \ +} [list \ + 3 {} \ + 4 {} \ + 3 {} \ + 4 {} \ + 0 {} \ + 4 {} \ + ] +test for-6.18 {Tcl_ForObjCmd: for command result} { + proc p6181 {} { + for {break} {1} {} {} + } + proc p6182 {} { + for {continue} {1} {} {} + } + proc p6183 {} { + for {} {[break]} {} {} + } + proc p6184 {} { + for {} {[continue]} {} {} + } + proc p6185 {} { + for {} {1} {break} {} + } + proc p6186 {} { + for {} {1} {continue} {} + } + list \ + [catch {p6181} err] $err \ + [catch {p6182} err] $err \ + [catch {p6183} err] $err \ + [catch {p6184} err] $err \ + [catch {p6185} err] $err \ + [catch {p6186} err] $err +} [list \ + 1 {invoked "break" outside of a loop} \ + 1 {invoked "continue" outside of a loop} \ + 1 {invoked "break" outside of a loop} \ + 1 {invoked "continue" outside of a loop} \ + 0 {} \ + 1 {invoked "continue" outside of a loop} \ + ] # cleanup diff --git a/tests/switch.test b/tests/switch.test index e05f2ca..ed1d38a 100644 --- a/tests/switch.test +++ b/tests/switch.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: switch.test,v 1.13 2005/06/01 11:00:35 dkf Exp $ +# RCS: @(#) $Id: switch.test,v 1.14 2005/06/20 07:49:12 mdejong Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -139,6 +139,34 @@ test switch-3.11 {-exact vs. -glob vs. -regexp with -nocase} { } } exact +test switch-3.7 {-exact vs. -glob vs. -regexp} { + list [catch {switch -exa Foo Foo {set result OK}} msg] $msg +} {0 OK} + +test switch-3.8 {-exact vs. -glob vs. -regexp} { + list [catch {switch -gl Foo Fo? {set result OK}} msg] $msg +} {0 OK} + +test switch-3.9 {-exact vs. -glob vs. -regexp} { + list [catch {switch -re Foo Fo. {set result OK}} msg] $msg +} {0 OK} + +test switch-3.10 {-exact vs. -glob vs. -regexp} { + list [catch {switch -exact -exact Foo Foo {set result OK}} msg] $msg +} {1 {bad option "-exact": -exact option already found}} + +test switch-3.11 {-exact vs. -glob vs. -regexp} { + list [catch {switch -exact -glob Foo Foo {set result OK}} msg] $msg +} {1 {bad option "-glob": -exact option already found}} + +test switch-3.12 {-exact vs. -glob vs. -regexp} { + list [catch {switch -glob -regexp Foo Foo {set result OK}} msg] $msg +} {1 {bad option "-regexp": -glob option already found}} + +test switch-3.13 {-exact vs. -glob vs. -regexp} { + list [catch {switch -regexp -glob Foo Foo {set result OK}} msg] $msg +} {1 {bad option "-glob": -regexp option already found}} + test switch-4.1 {error in executed command} { list [catch {switch a a {error "Just a test"} default {format 1}} msg] \ $msg $errorInfo @@ -220,6 +248,15 @@ test switch-7.3 {"-" bodies} { } } msg] $msg } {1 {no body specified for pattern "c"}} +test switch-7.4 {"-" bodies} { + list [catch { + switch a { + a - + b -foo + c {} + } + } msg] $msg +} {1 {invalid command name "-foo"}} test switch-8.1 {empty body} { set msg {} @@ -230,6 +267,24 @@ test switch-8.1 {empty body} { } } {} +proc test_switch_body {} { + return "INVOKED" +} + +test switch-8.2 {weird body text, variable} { + set cmd {test_switch_body} + switch Foo { + Foo $cmd + } +} {INVOKED} + +test switch-8.3 {weird body text, variable} { + set cmd {test_switch_body} + switch Foo { + Foo {$cmd} + } +} {INVOKED} + test switch-9.1 {empty pattern/body list} { list [catch {switch x} msg] $msg } {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}} |