Subversion Repositories or1k

# 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.

#

# 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 2002-01-16 10:25:36 markom Exp $

if {[string compare test [info procs test]] == 1} then {source defs}

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 -exact -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: ?+* follows nothing}}

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 "a"}}

test switch-7.3 {"-" bodies} {

    list [catch {

        switch a {

            a -

            b -foo

            c -

        }

    } msg] $msg

} {1 {invalid command name "-foo"}}

test switch-8.1 {empty body} {

    set msg {}

    switch {2} {

        1 {set msg 1}

        2 {}

        default {set msg 2}

    }

} {}