diff options
Diffstat (limited to 'tests/switch.test')
-rw-r--r-- | tests/switch.test | 97 |
1 files changed, 95 insertions, 2 deletions
diff --git a/tests/switch.test b/tests/switch.test index cfc80ec..3218e3a 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.9 2003/04/28 10:05:28 dkf Exp $ +# RCS: @(#) $Id: switch.test,v 1.10 2003/12/14 18:32:36 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -89,7 +89,7 @@ test switch-3.5 {-exact vs. -glob vs. -regexp} { } exact test switch-3.6 {-exact vs. -glob vs. -regexp} { list [catch {switch -foo a b c} msg] $msg -} {1 {bad option "-foo": must be -exact, -glob, -regexp, or --}} +} {1 {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -regexp, or --}} test switch-4.1 {error in executed command} { list [catch {switch a a {error "Just a test"} default {format 1}} msg] \ @@ -360,6 +360,99 @@ rename iswtest-exact {} rename cswtest2-exact {} rename iswtest2-exact {} +# Added due to TIP#75 +test switch-11.1 {regexp matching with -matchvar} { + switch -regexp -matchvar x -- abc {.(.). {set x}} +} {abc b} +test switch-11.2 {regexp matching with -matchvar} { + set x GOOD + switch -regexp -matchvar x -- abc {.(.).. {list $x z}} + set x +} GOOD +test switch-11.3 {regexp matching with -matchvar} { + switch -regexp -matchvar x -- "a b c" {.(.). {set x}} +} {{a b} { }} +test switch-11.4 {regexp matching with -matchvar} { + set x BAD + switch -regexp -matchvar x -- "a b c" { + bc {list $x YES} + default {list $x NO} + } +} {{} NO} +test switch-11.5 {-matchvar without -regexp} { + set x {} + list [catch {switch -glob -matchvar x -- abc . {set x}} msg] $x $msg +} {1 {} {-matchvar option requires -regexp option}} +test switch-11.6 {-matchvar unwritable} { + set x {} + list [catch {switch -regexp -matchvar x(x) -- abc . {set x}} msg] $x $msg +} {1 {} {can't set "x(x)": variable isn't array}} + +test switch-12.1 {regexp matching with -indexvar} { + switch -regexp -indexvar x -- abc {.(.). {set x}} +} {{0 3} {1 2}} +test switch-12.2 {regexp matching with -indexvar} { + set x GOOD + switch -regexp -indexvar x -- abc {.(.).. {list $x z}} + set x +} GOOD +test switch-12.3 {regexp matching with -indexvar} { + switch -regexp -indexvar x -- "a b c" {.(.). {set x}} +} {{0 3} {1 2}} +test switch-12.4 {regexp matching with -indexvar} { + set x BAD + switch -regexp -indexvar x -- "a b c" { + bc {list $x YES} + default {list $x NO} + } +} {{} NO} +test switch-12.5 {-indexvar without -regexp} { + set x {} + list [catch {switch -glob -indexvar x -- abc . {set x}} msg] $x $msg +} {1 {} {-indexvar option requires -regexp option}} +test switch-12.6 {-indexvar unwritable} { + set x {} + list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg +} {1 {} {can't set "x(x)": variable isn't array}} + +test switch-13.1 {-indexvar -matchvar combinations} { + switch -regexp -indexvar x -matchvar y abc { + . {list $x $y} + } +} {{{0 1}} a} +test switch-13.2 {-indexvar -matchvar combinations} { + switch -regexp -indexvar x -matchvar y abc { + .$ {list $x $y} + } +} {{{2 3}} c} +test switch-13.3 {-indexvar -matchvar combinations} { + switch -regexp -indexvar x -matchvar y abc { + (.)(.)(.) {list $x $y} + } +} {{{0 3} {0 1} {1 2} {2 3}} {abc a b c}} +test switch-13.4 {-indexvar -matchvar combinations} { + set x - + set y - + switch -regexp -indexvar x -matchvar y abc { + (.)(.)(.). - + default {list $x $y} + } +} {{} {}} +test switch-13.5 {-indexvar -matchvar combinations} { + set x - + set y - + list [catch { + switch -regexp -indexvar x(x) -matchvar y abc {. {list $x $y}} + } msg] $x $y $msg +} {1 - - {can't set "x(x)": variable isn't array}} +test switch-13.6 {-indexvar -matchvar combinations} { + set x - + set y - + list [catch { + switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}} + } msg] $x $y $msg +} {1 {{0 1}} - {can't set "y(y)": variable isn't array}} + # cleanup ::tcltest::cleanupTests return |