summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2003-03-05 22:31:16 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2003-03-05 22:31:16 (GMT)
commite4cd55ecc463e7976f7d9ef3a54b2fb969751de2 (patch)
tree5d0b3c72d7b244d7ab119815c7ae33c63b7600f8 /tests
parent880c8a7c3f2373e130125a14d03ca020521fea1e (diff)
downloadtcl-e4cd55ecc463e7976f7d9ef3a54b2fb969751de2.zip
tcl-e4cd55ecc463e7976f7d9ef3a54b2fb969751de2.tar.gz
tcl-e4cd55ecc463e7976f7d9ef3a54b2fb969751de2.tar.bz2
The [switch] command is now bytecode compiled, at least in the most common
case. There's room for improvement in the future, of course. [Patch #644819] Also adds another macro to help with jump offset fixups.
Diffstat (limited to 'tests')
-rw-r--r--tests/switch.test130
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