1# Commands covered: switch 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright (c) 1993 The Regents of the University of California. 8# Copyright (c) 1994 Sun Microsystems, Inc. 9# Copyright (c) 1998-1999 by Scriptics Corporation. 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13# 14# RCS: @(#) $Id: switch.test,v 1.7 2001/11/27 13:30:54 dkf Exp $ 15 16if {[lsearch [namespace children] ::tcltest] == -1} { 17 package require tcltest 18 namespace import -force ::tcltest::* 19} 20 21test switch-1.1 {simple patterns} { 22 switch a a {format 1} b {format 2} c {format 3} default {format 4} 23} 1 24test switch-1.2 {simple patterns} { 25 switch b a {format 1} b {format 2} c {format 3} default {format 4} 26} 2 27test switch-1.3 {simple patterns} { 28 switch x a {format 1} b {format 2} c {format 3} default {format 4} 29} 4 30test switch-1.4 {simple patterns} { 31 switch x a {format 1} b {format 2} c {format 3} 32} {} 33test switch-1.5 {simple pattern matches many times} { 34 switch b a {format 1} b {format 2} b {format 3} b {format 4} 35} 2 36test switch-1.6 {simple patterns} { 37 switch default a {format 1} default {format 2} c {format 3} default {format 4} 38} 2 39test switch-1.7 {simple patterns} { 40 switch x a {format 1} default {format 2} c {format 3} default {format 4} 41} 4 42 43test switch-2.1 {single-argument form for pattern/command pairs} { 44 switch b { 45 a {format 1} 46 b {format 2} 47 default {format 6} 48 } 49} {2} 50test switch-2.2 {single-argument form for pattern/command pairs} { 51 list [catch {switch z {a 2 b}} msg] $msg 52} {1 {extra switch pattern with no body}} 53 54test switch-3.1 {-exact vs. -glob vs. -regexp} { 55 switch -exact aaaab { 56 ^a*b$ {concat regexp} 57 *b {concat glob} 58 aaaab {concat exact} 59 default {concat none} 60 } 61} exact 62test switch-3.2 {-exact vs. -glob vs. -regexp} { 63 switch -regexp aaaab { 64 ^a*b$ {concat regexp} 65 *b {concat glob} 66 aaaab {concat exact} 67 default {concat none} 68 } 69} regexp 70test switch-3.3 {-exact vs. -glob vs. -regexp} { 71 switch -glob aaaab { 72 ^a*b$ {concat regexp} 73 *b {concat glob} 74 aaaab {concat exact} 75 default {concat none} 76 } 77} glob 78test switch-3.4 {-exact vs. -glob vs. -regexp} { 79 switch aaaab {^a*b$} {concat regexp} *b {concat glob} \ 80 aaaab {concat exact} default {concat none} 81} exact 82test switch-3.5 {-exact vs. -glob vs. -regexp} { 83 switch -- -glob { 84 ^g.*b$ {concat regexp} 85 -* {concat glob} 86 -glob {concat exact} 87 default {concat none} 88 } 89} exact 90test switch-3.6 {-exact vs. -glob vs. -regexp} { 91 list [catch {switch -foo a b c} msg] $msg 92} {1 {bad option "-foo": must be -exact, -glob, -regexp, or --}} 93 94test switch-4.1 {error in executed command} { 95 list [catch {switch a a {error "Just a test"} default {format 1}} msg] \ 96 $msg $errorInfo 97} {1 {Just a test} {Just a test 98 while executing 99"error "Just a test"" 100 ("a" arm line 1) 101 invoked from within 102"switch a a {error "Just a test"} default {format 1}"}} 103test switch-4.2 {error: not enough args} { 104 list [catch {switch} msg] $msg 105} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}} 106test switch-4.3 {error: pattern with no body} { 107 list [catch {switch a b} msg] $msg 108} {1 {extra switch pattern with no body}} 109test switch-4.4 {error: pattern with no body} { 110 list [catch {switch a b {format 1} c} msg] $msg 111} {1 {extra switch pattern with no body}} 112test switch-4.5 {error in default command} { 113 list [catch {switch foo a {error switch1} b {error switch 3} \ 114 default {error switch2}} msg] $msg $errorInfo 115} {1 switch2 {switch2 116 while executing 117"error switch2" 118 ("default" arm line 1) 119 invoked from within 120"switch foo a {error switch1} b {error switch 3} default {error switch2}"}} 121 122test switch-5.1 {errors in -regexp matching} { 123 list [catch {switch -regexp aaaab { 124 *b {concat glob} 125 aaaab {concat exact} 126 default {concat none} 127 }} msg] $msg 128} {1 {couldn't compile regular expression pattern: quantifier operand invalid}} 129 130test switch-6.1 {backslashes in patterns} { 131 switch -exact {\a\$\.\[} { 132 \a\$\.\[ {concat first} 133 \a\\$\.\\[ {concat second} 134 \\a\\$\\.\\[ {concat third} 135 {\a\\$\.\\[} {concat fourth} 136 {\\a\\$\\.\\[} {concat fifth} 137 default {concat none} 138 } 139} third 140test switch-6.2 {backslashes in patterns} { 141 switch -exact {\a\$\.\[} { 142 \a\$\.\[ {concat first} 143 {\a\$\.\[} {concat second} 144 {{\a\$\.\[}} {concat third} 145 default {concat none} 146 } 147} second 148 149test switch-7.1 {"-" bodies} { 150 switch a { 151 a - 152 b - 153 c {concat 1} 154 default {concat 2} 155 } 156} 1 157test switch-7.2 {"-" bodies} { 158 list [catch { 159 switch a { 160 a - 161 b - 162 c - 163 } 164 } msg] $msg 165} {1 {no body specified for pattern "c"}} 166test switch-7.3 {"-" bodies} { 167 list [catch { 168 switch a { 169 a - 170 b -foo 171 c - 172 } 173 } msg] $msg 174} {1 {no body specified for pattern "c"}} 175 176test switch-8.1 {empty body} { 177 set msg {} 178 switch {2} { 179 1 {set msg 1} 180 2 {} 181 default {set msg 2} 182 } 183} {} 184 185test switch-9.1 {empty pattern/body list} { 186 list [catch {switch x} msg] $msg 187} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}} 188test switch-9.2 {empty pattern/body list} { 189 list [catch {switch -- x} msg] $msg 190} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}} 191test switch-9.3 {empty pattern/body list} { 192 list [catch {switch x {}} msg] $msg 193} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}} 194test switch-9.4 {empty pattern/body list} { 195 list [catch {switch -- x {}} msg] $msg 196} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}} 197test switch-9.5 {unpaired pattern} { 198 list [catch {switch x a {} b} msg] $msg 199} {1 {extra switch pattern with no body}} 200test switch-9.6 {unpaired pattern} { 201 list [catch {switch x {a {} b}} msg] $msg 202} {1 {extra switch pattern with no body}} 203test switch-9.7 {unpaired pattern} { 204 list [catch {switch x a {} # comment b} msg] $msg 205} {1 {extra switch pattern with no body}} 206test switch-9.8 {unpaired pattern} { 207 list [catch {switch x {a {} # comment b}} msg] $msg 208} {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}} 209test switch-9.9 {unpaired pattern} { 210 list [catch {switch x a {} x {} # comment b} msg] $msg 211} {1 {extra switch pattern with no body}} 212test switch-9.10 {unpaired pattern} { 213 list [catch {switch x {a {} x {} # comment b}} msg] $msg 214} {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}} 215 216# cleanup 217::tcltest::cleanupTests 218return 219