Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/switch.test@bde4ae8d615e

     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 $

    16 if {[lsearch [namespace children] ::tcltest] == -1} {

    17     package require tcltest

    18     namespace import -force ::tcltest::*

    19 }

    21 test switch-1.1 {simple patterns} {

    22     switch a a {format 1} b {format 2} c {format 3} default {format 4}

    23 } 1

    24 test switch-1.2 {simple patterns} {

    25     switch b a {format 1} b {format 2} c {format 3} default {format 4}

    26 } 2

    27 test switch-1.3 {simple patterns} {

    28     switch x a {format 1} b {format 2} c {format 3} default {format 4}

    29 } 4

    30 test switch-1.4 {simple patterns} {

    31     switch x a {format 1} b {format 2} c {format 3}

    32 } {}

    33 test 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

    36 test switch-1.6 {simple patterns} {

    37     switch default a {format 1} default {format 2} c {format 3} default {format 4}

    38 } 2

    39 test switch-1.7 {simple patterns} {

    40     switch x a {format 1} default {format 2} c {format 3} default {format 4}

    41 } 4

    43 test 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}

    50 test 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}}

    54 test 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

    62 test 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

    70 test 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

    78 test 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

    82 test 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

    90 test 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 --}}

    94 test 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}"}}

   103 test 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?"}}

   106 test switch-4.3 {error: pattern with no body} {

   107     list [catch {switch a b} msg] $msg

   108 } {1 {extra switch pattern with no body}}

   109 test 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}}

   112 test 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}"}}

   122 test 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}}

   130 test 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

   140 test 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

   149 test switch-7.1 {"-" bodies} {

   150     switch a {

   151 	a -

   152 	b -

   153 	c {concat 1}

   154 	default {concat 2}

   155     }

   156 } 1

   157 test 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"}}

   166 test 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"}}

   176 test 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 } {}

   185 test 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?"}}

   188 test 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?"}}

   191 test 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?}"}}

   194 test 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?}"}}

   197 test switch-9.5 {unpaired pattern} {

   198     list [catch {switch x a {} b} msg] $msg

   199 } {1 {extra switch pattern with no body}}

   200 test switch-9.6 {unpaired pattern} {

   201     list [catch {switch x {a {} b}} msg] $msg

   202 } {1 {extra switch pattern with no body}}

   203 test switch-9.7 {unpaired pattern} {

   204     list [catch {switch x a {} # comment b} msg] $msg

   205 } {1 {extra switch pattern with no body}}

   206 test 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}}

   209 test switch-9.9 {unpaired pattern} {

   210     list [catch {switch x a {} x {} # comment b} msg] $msg

   211 } {1 {extra switch pattern with no body}}

   212 test 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}}

   216 # cleanup

   217 ::tcltest::cleanupTests

   218 return

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--