diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/switch.test | 130 |
1 files changed, 129 insertions, 1 deletions
diff --git a/tests/switch.test b/tests/switch.test index f1ae7c7..153557f 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.7 2001/11/27 13:30:54 dkf Exp $ +# RCS: @(#) $Id: switch.test,v 1.8 2003/03/05 22:31:24 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -213,6 +213,134 @@ test switch-9.10 {unpaired pattern} { list [catch {switch x {a {} x {} # comment b}} msg] $msg } {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}} +test switch-10.1 {compiled -exact switch} { + if 1 {switch -exact -- a {a {format 1} b {format 2}}} +} 1 +test switch-10.2 {compiled -exact switch} { + if 1 {switch -exact -- b {a {format 1} b {format 2}}} +} 2 +test switch-10.3 {compiled -exact switch} { + if 1 {switch -exact -- c {a {format 1} b {format 2}}} +} {} +test switch-10.4 {compiled -exact switch} { + if 1 { + set x 0 + switch -exact -- c {a {format 1} b {format 2}} + } +} {} +test switch-10.5 {compiled -exact switch} { + if 1 {switch -exact -- a {a - aa {format 1} b {format 2}}} +} 1 +test switch-10.6 {compiled -exact switch} { + if 1 {switch -exact -- b {a { + set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 + set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 + set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 + set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 + set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 + set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 + set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 + set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 + } b {format 2}}} +} 2 + +# Command variants are: +# c* are compiled switches, i* are interpreted +# *-glob use glob matching, *-exact use exact matching +# *2* include a default clause (different results too.) +proc cswtest-glob s { + set x 0; set y 0 + foreach c [split $s {}] { + switch -glob -- $c { + a {incr x} + b {incr y} + } + } + return $x,$y +} +proc iswtest-glob s { + set x 0; set y 0 + foreach c [split $s {}] { + switch -glob -- $c a {incr x} b {incr y} + } + return $x,$y +} +proc cswtest-exact s { + set x 0; set y 0 + foreach c [split $s {}] { + switch -exact -- $c { + a {incr x} + b {incr y} + } + } + return $x,$y +} +proc iswtest-exact s { + set x 0; set y 0 + foreach c [split $s {}] { + switch -exact -- $c a {incr x} b {incr y} + } + return $x,$y +} +proc cswtest2-glob s { + set x 0; set y 0; set z 0 + foreach c [split $s {}] { + switch -glob -- $c { + a {incr x} + b {incr y} + default {incr z} + } + } + return $x,$y,$z +} +proc iswtest2-glob s { + set x 0; set y 0; set z 0 + foreach c [split $s {}] { + switch -glob -- $c a {incr x} b {incr y} default {incr z} + } + return $x,$y,$z +} +proc cswtest2-exact s { + set x 0; set y 0; set z 0 + foreach c [split $s {}] { + switch -exact -- $c { + a {incr x} + b {incr y} + default {incr z} + } + } + return $x,$y,$z +} +proc iswtest2-exact s { + set x 0; set y 0; set z 0 + foreach c [split $s {}] { + switch -exact -- $c a {incr x} b {incr y} default {incr z} + } + return $x,$y,$z +} + +test switch-10.7 {comparison of compiled and interpreted behaviour of switch, exact matching} { + expr {[cswtest-exact abcb] eq [iswtest-exact abcb]} +} 1 +test switch-10.8 {comparison of compiled and interpreted behaviour of switch, glob matching} { + expr {[cswtest-glob abcb] eq [iswtest-glob abcb]} +} 1 +test switch-10.9 {comparison of compiled and interpreted behaviour of switch, exact matching with default} { + expr {[cswtest2-exact abcb] eq [iswtest2-exact abcb]} +} 1 +test switch-10.10 {comparison of compiled and interpreted behaviour of switch, glob matching with default} { + expr {[cswtest2-glob abcb] eq [iswtest2-glob abcb]} +} 1 + +rename cswtest-glob {} +rename iswtest-glob {} +rename cswtest2-glob {} +rename iswtest2-glob {} +rename cswtest-exact {} +rename iswtest-exact {} +rename cswtest2-exact {} +rename iswtest2-exact {} + # cleanup ::tcltest::cleanupTests return |