# Commands covered:  case

 #

 # 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) 1991-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: case.test,v 1.5 2000/04/10 17:18:57 ericm Exp $

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

     package require tcltest

     namespace import -force ::tcltest::*

 }

 test case-1.1 {simple pattern} {

     case a in a {format 1} b {format 2} c {format 3} default {format 4}

 } 1

 test case-1.2 {simple pattern} {

     case b a {format 1} b {format 2} c {format 3} default {format 4}

 } 2

 test case-1.3 {simple pattern} {

     case x in a {format 1} b {format 2} c {format 3} default {format 4}

 } 4

 test case-1.4 {simple pattern} {

     case x a {format 1} b {format 2} c {format 3}

 } {}

 test case-1.5 {simple pattern matches many times} {

     case b a {format 1} b {format 2} b {format 3} b {format 4}

 } 2

 test case-1.6 {fancier pattern} {

     case cx a {format 1} *c {format 2} *x {format 3} default {format 4}

 } 3

 test case-1.7 {list of patterns} {

     case abc in {a b c} {format 1} {def abc ghi} {format 2}

 } 2

 test case-2.1 {error in executed command} {

     list [catch {case a in 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

 "case a in a {error "Just a test"} default {format 1}"}}

 test case-2.2 {error: not enough args} {

     list [catch {case} msg] $msg

 } {1 {wrong # args: should be "case string ?in? patList body ... ?default body?"}}

 test case-2.3 {error: pattern with no body} {

     list [catch {case a b} msg] $msg

 } {1 {extra case pattern with no body}}

 test case-2.4 {error: pattern with no body} {

     list [catch {case a in b {format 1} c} msg] $msg

 } {1 {extra case pattern with no body}}

 test case-2.5 {error in default command} {

     list [catch {case foo in a {error case1} default {error case2} \

 	    b {error case 3}} msg] $msg $errorInfo

 } {1 case2 {case2

     while executing

 "error case2"

     ("default" arm line 1)

     invoked from within

 "case foo in a {error case1} default {error case2}  b {error case 3}"}}

 test case-3.1 {single-argument form for pattern/command pairs} {

     case b in {

 	a {format 1}

 	b {format 2}

 	default {format 6}

     }

 } {2}

 test case-3.2 {single-argument form for pattern/command pairs} {

     case b {

 	a {format 1}

 	b {format 2}

 	default {format 6}

     }

 } {2}

 test case-3.3 {single-argument form for pattern/command pairs} {

     list [catch {case z in {a 2 b}} msg] $msg

 } {1 {extra case pattern with no body}}

 # cleanup

 ::tcltest::cleanupTests

 return