summaryrefslogtreecommitdiffstats
path: root/tests/switch.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/switch.test')
-rw-r--r--tests/switch.test97
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