# Commands covered: switch # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # 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.1.1.1 2007/07/10 15:04:24 duncan Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } test switch-1.1 {simple patterns} { switch a a {format 1} b {format 2} c {format 3} default {format 4} } 1 test switch-1.2 {simple patterns} { switch b a {format 1} b {format 2} c {format 3} default {format 4} } 2 test switch-1.3 {simple patterns} { switch x a {format 1} b {format 2} c {format 3} default {format 4} } 4 test switch-1.4 {simple patterns} { switch x a {format 1} b {format 2} c {format 3} } {} test switch-1.5 {simple pattern matches many times} { switch b a {format 1} b {format 2} b {format 3} b {format 4} } 2 test switch-1.6 {simple patterns} { switch default a {format 1} default {format 2} c {format 3} default {format 4} } 2 test switch-1.7 {simple patterns} { switch x a {format 1} default {format 2} c {format 3} default {format 4} } 4 test switch-2.1 {single-argument form for pattern/command pairs} { switch b { a {format 1} b {format 2} default {format 6} } } {2} test switch-2.2 {single-argument form for pattern/command pairs} { list [catch {switch z {a 2 b}} msg] $msg } {1 {extra switch pattern with no body}} test switch-3.1 {-exact vs. -glob vs. -regexp} { switch -exact aaaab { ^a*b$ {concat regexp} *b {concat glob} aaaab {concat exact} default {concat none} } } exact test switch-3.2 {-exact vs. -glob vs. -regexp} { switch -regexp aaaab { ^a*b$ {concat regexp} *b {concat glob} aaaab {concat exact} default {concat none} } } regexp test switch-3.3 {-exact vs. -glob vs. -regexp} { switch -glob aaaab { ^a*b$ {concat regexp} *b {concat glob} aaaab {concat exact} default {concat none} } } glob test switch-3.4 {-exact vs. -glob vs. -regexp} { switch aaaab {^a*b$} {concat regexp} *b {concat glob} \ aaaab {concat exact} default {concat none} } exact test switch-3.5 {-exact vs. -glob vs. -regexp} { switch -- -glob { ^g.*b$ {concat regexp} -* {concat glob} -glob {concat exact} default {concat none} } } 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 --}} test switch-4.1 {error in executed command} { list [catch {switch a a {error "Just a test"} default {format 1}} msg] \ $msg $errorInfo } {1 {Just a test} {Just a test while executing "error "Just a test"" ("a" arm line 1) invoked from within "switch a a {error "Just a test"} default {format 1}"}} test switch-4.2 {error: not enough args} { list [catch {switch} msg] $msg } {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}} test switch-4.3 {error: pattern with no body} { list [catch {switch a b} msg] $msg } {1 {extra switch pattern with no body}} test switch-4.4 {error: pattern with no body} { list [catch {switch a b {format 1} c} msg] $msg } {1 {extra switch pattern with no body}} test switch-4.5 {error in default command} { list [catch {switch foo a {error switch1} b {error switch 3} \ default {error switch2}} msg] $msg $errorInfo } {1 switch2 {switch2 while executing "error switch2" ("default" arm line 1) invoked from within "switch foo a {error switch1} b {error switch 3} default {error switch2}"}} test switch-5.1 {errors in -regexp matching} { list [catch {switch -regexp aaaab { *b {concat glob} aaaab {concat exact} default {concat none} }} msg] $msg } {1 {couldn't compile regular expression pattern: quantifier operand invalid}} test switch-6.1 {backslashes in patterns} { switch -exact {\a\$\.\[} { \a\$\.\[ {concat first} \a\\$\.\\[ {concat second} \\a\\$\\.\\[ {concat third} {\a\\$\.\\[} {concat fourth} {\\a\\$\\.\\[} {concat fifth} default {concat none} } } third test switch-6.2 {backslashes in patterns} { switch -exact {\a\$\.\[} { \a\$\.\[ {concat first} {\a\$\.\[} {concat second} {{\a\$\.\[}} {concat third} default {concat none} } } second test switch-7.1 {"-" bodies} { switch a { a - b - c {concat 1} default {concat 2} } } 1 test switch-7.2 {"-" bodies} { list [catch { switch a { a - b - c - } } msg] $msg } {1 {no body specified for pattern "c"}} test switch-7.3 {"-" bodies} { list [catch { switch a { a - b -foo c - } } msg] $msg } {1 {no body specified for pattern "c"}} test switch-8.1 {empty body} { set msg {} switch {2} { 1 {set msg 1} 2 {} default {set msg 2} } } {} test switch-9.1 {empty pattern/body list} { list [catch {switch x} msg] $msg } {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}} test switch-9.2 {empty pattern/body list} { list [catch {switch -- x} msg] $msg } {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}} test switch-9.3 {empty pattern/body list} { list [catch {switch x {}} msg] $msg } {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}} test switch-9.4 {empty pattern/body list} { list [catch {switch -- x {}} msg] $msg } {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}} test switch-9.5 {unpaired pattern} { list [catch {switch x a {} b} msg] $msg } {1 {extra switch pattern with no body}} test switch-9.6 {unpaired pattern} { list [catch {switch x {a {} b}} msg] $msg } {1 {extra switch pattern with no body}} test switch-9.7 {unpaired pattern} { list [catch {switch x a {} # comment b} msg] $msg } {1 {extra switch pattern with no body}} test switch-9.8 {unpaired pattern} { list [catch {switch x {a {} # 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-9.9 {unpaired pattern} { list [catch {switch x a {} x {} # comment b} msg] $msg } {1 {extra switch pattern with no body}} 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}} # cleanup ::tcltest::cleanupTests return