TIP#75 Implementation

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