os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/switch.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/switch.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,218 @@
1.4 +# Commands covered: switch
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1993 The Regents of the University of California.
1.11 +# Copyright (c) 1994 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: switch.test,v 1.7 2001/11/27 13:30:54 dkf Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +test switch-1.1 {simple patterns} {
1.25 + switch a a {format 1} b {format 2} c {format 3} default {format 4}
1.26 +} 1
1.27 +test switch-1.2 {simple patterns} {
1.28 + switch b a {format 1} b {format 2} c {format 3} default {format 4}
1.29 +} 2
1.30 +test switch-1.3 {simple patterns} {
1.31 + switch x a {format 1} b {format 2} c {format 3} default {format 4}
1.32 +} 4
1.33 +test switch-1.4 {simple patterns} {
1.34 + switch x a {format 1} b {format 2} c {format 3}
1.35 +} {}
1.36 +test switch-1.5 {simple pattern matches many times} {
1.37 + switch b a {format 1} b {format 2} b {format 3} b {format 4}
1.38 +} 2
1.39 +test switch-1.6 {simple patterns} {
1.40 + switch default a {format 1} default {format 2} c {format 3} default {format 4}
1.41 +} 2
1.42 +test switch-1.7 {simple patterns} {
1.43 + switch x a {format 1} default {format 2} c {format 3} default {format 4}
1.44 +} 4
1.45 +
1.46 +test switch-2.1 {single-argument form for pattern/command pairs} {
1.47 + switch b {
1.48 + a {format 1}
1.49 + b {format 2}
1.50 + default {format 6}
1.51 + }
1.52 +} {2}
1.53 +test switch-2.2 {single-argument form for pattern/command pairs} {
1.54 + list [catch {switch z {a 2 b}} msg] $msg
1.55 +} {1 {extra switch pattern with no body}}
1.56 +
1.57 +test switch-3.1 {-exact vs. -glob vs. -regexp} {
1.58 + switch -exact aaaab {
1.59 + ^a*b$ {concat regexp}
1.60 + *b {concat glob}
1.61 + aaaab {concat exact}
1.62 + default {concat none}
1.63 + }
1.64 +} exact
1.65 +test switch-3.2 {-exact vs. -glob vs. -regexp} {
1.66 + switch -regexp aaaab {
1.67 + ^a*b$ {concat regexp}
1.68 + *b {concat glob}
1.69 + aaaab {concat exact}
1.70 + default {concat none}
1.71 + }
1.72 +} regexp
1.73 +test switch-3.3 {-exact vs. -glob vs. -regexp} {
1.74 + switch -glob aaaab {
1.75 + ^a*b$ {concat regexp}
1.76 + *b {concat glob}
1.77 + aaaab {concat exact}
1.78 + default {concat none}
1.79 + }
1.80 +} glob
1.81 +test switch-3.4 {-exact vs. -glob vs. -regexp} {
1.82 + switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
1.83 + aaaab {concat exact} default {concat none}
1.84 +} exact
1.85 +test switch-3.5 {-exact vs. -glob vs. -regexp} {
1.86 + switch -- -glob {
1.87 + ^g.*b$ {concat regexp}
1.88 + -* {concat glob}
1.89 + -glob {concat exact}
1.90 + default {concat none}
1.91 + }
1.92 +} exact
1.93 +test switch-3.6 {-exact vs. -glob vs. -regexp} {
1.94 + list [catch {switch -foo a b c} msg] $msg
1.95 +} {1 {bad option "-foo": must be -exact, -glob, -regexp, or --}}
1.96 +
1.97 +test switch-4.1 {error in executed command} {
1.98 + list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
1.99 + $msg $errorInfo
1.100 +} {1 {Just a test} {Just a test
1.101 + while executing
1.102 +"error "Just a test""
1.103 + ("a" arm line 1)
1.104 + invoked from within
1.105 +"switch a a {error "Just a test"} default {format 1}"}}
1.106 +test switch-4.2 {error: not enough args} {
1.107 + list [catch {switch} msg] $msg
1.108 +} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
1.109 +test switch-4.3 {error: pattern with no body} {
1.110 + list [catch {switch a b} msg] $msg
1.111 +} {1 {extra switch pattern with no body}}
1.112 +test switch-4.4 {error: pattern with no body} {
1.113 + list [catch {switch a b {format 1} c} msg] $msg
1.114 +} {1 {extra switch pattern with no body}}
1.115 +test switch-4.5 {error in default command} {
1.116 + list [catch {switch foo a {error switch1} b {error switch 3} \
1.117 + default {error switch2}} msg] $msg $errorInfo
1.118 +} {1 switch2 {switch2
1.119 + while executing
1.120 +"error switch2"
1.121 + ("default" arm line 1)
1.122 + invoked from within
1.123 +"switch foo a {error switch1} b {error switch 3} default {error switch2}"}}
1.124 +
1.125 +test switch-5.1 {errors in -regexp matching} {
1.126 + list [catch {switch -regexp aaaab {
1.127 + *b {concat glob}
1.128 + aaaab {concat exact}
1.129 + default {concat none}
1.130 + }} msg] $msg
1.131 +} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
1.132 +
1.133 +test switch-6.1 {backslashes in patterns} {
1.134 + switch -exact {\a\$\.\[} {
1.135 + \a\$\.\[ {concat first}
1.136 + \a\\$\.\\[ {concat second}
1.137 + \\a\\$\\.\\[ {concat third}
1.138 + {\a\\$\.\\[} {concat fourth}
1.139 + {\\a\\$\\.\\[} {concat fifth}
1.140 + default {concat none}
1.141 + }
1.142 +} third
1.143 +test switch-6.2 {backslashes in patterns} {
1.144 + switch -exact {\a\$\.\[} {
1.145 + \a\$\.\[ {concat first}
1.146 + {\a\$\.\[} {concat second}
1.147 + {{\a\$\.\[}} {concat third}
1.148 + default {concat none}
1.149 + }
1.150 +} second
1.151 +
1.152 +test switch-7.1 {"-" bodies} {
1.153 + switch a {
1.154 + a -
1.155 + b -
1.156 + c {concat 1}
1.157 + default {concat 2}
1.158 + }
1.159 +} 1
1.160 +test switch-7.2 {"-" bodies} {
1.161 + list [catch {
1.162 + switch a {
1.163 + a -
1.164 + b -
1.165 + c -
1.166 + }
1.167 + } msg] $msg
1.168 +} {1 {no body specified for pattern "c"}}
1.169 +test switch-7.3 {"-" bodies} {
1.170 + list [catch {
1.171 + switch a {
1.172 + a -
1.173 + b -foo
1.174 + c -
1.175 + }
1.176 + } msg] $msg
1.177 +} {1 {no body specified for pattern "c"}}
1.178 +
1.179 +test switch-8.1 {empty body} {
1.180 + set msg {}
1.181 + switch {2} {
1.182 + 1 {set msg 1}
1.183 + 2 {}
1.184 + default {set msg 2}
1.185 + }
1.186 +} {}
1.187 +
1.188 +test switch-9.1 {empty pattern/body list} {
1.189 + list [catch {switch x} msg] $msg
1.190 +} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
1.191 +test switch-9.2 {empty pattern/body list} {
1.192 + list [catch {switch -- x} msg] $msg
1.193 +} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
1.194 +test switch-9.3 {empty pattern/body list} {
1.195 + list [catch {switch x {}} msg] $msg
1.196 +} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
1.197 +test switch-9.4 {empty pattern/body list} {
1.198 + list [catch {switch -- x {}} msg] $msg
1.199 +} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
1.200 +test switch-9.5 {unpaired pattern} {
1.201 + list [catch {switch x a {} b} msg] $msg
1.202 +} {1 {extra switch pattern with no body}}
1.203 +test switch-9.6 {unpaired pattern} {
1.204 + list [catch {switch x {a {} b}} msg] $msg
1.205 +} {1 {extra switch pattern with no body}}
1.206 +test switch-9.7 {unpaired pattern} {
1.207 + list [catch {switch x a {} # comment b} msg] $msg
1.208 +} {1 {extra switch pattern with no body}}
1.209 +test switch-9.8 {unpaired pattern} {
1.210 + list [catch {switch x {a {} # comment b}} msg] $msg
1.211 +} {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}}
1.212 +test switch-9.9 {unpaired pattern} {
1.213 + list [catch {switch x a {} x {} # comment b} msg] $msg
1.214 +} {1 {extra switch pattern with no body}}
1.215 +test switch-9.10 {unpaired pattern} {
1.216 + list [catch {switch x {a {} x {} # comment b}} msg] $msg
1.217 +} {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}}
1.218 +
1.219 +# cleanup
1.220 +::tcltest::cleanupTests
1.221 +return