sl@0: # Commands covered:  case
sl@0: #
sl@0: # This file contains a collection of tests for one or more of the Tcl
sl@0: # built-in commands.  Sourcing this file into Tcl runs the tests and
sl@0: # generates output for errors.  No output means no errors were found.
sl@0: #
sl@0: # Copyright (c) 1991-1993 The Regents of the University of California.
sl@0: # Copyright (c) 1994 Sun Microsystems, Inc.
sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0: #
sl@0: # See the file "license.terms" for information on usage and redistribution
sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0: #
sl@0: # RCS: @(#) $Id: case.test,v 1.5 2000/04/10 17:18:57 ericm Exp $
sl@0: 
sl@0: if {[lsearch [namespace children] ::tcltest] == -1} {
sl@0:     package require tcltest
sl@0:     namespace import -force ::tcltest::*
sl@0: }
sl@0: 
sl@0: test case-1.1 {simple pattern} {
sl@0:     case a in a {format 1} b {format 2} c {format 3} default {format 4}
sl@0: } 1
sl@0: test case-1.2 {simple pattern} {
sl@0:     case b a {format 1} b {format 2} c {format 3} default {format 4}
sl@0: } 2
sl@0: test case-1.3 {simple pattern} {
sl@0:     case x in a {format 1} b {format 2} c {format 3} default {format 4}
sl@0: } 4
sl@0: test case-1.4 {simple pattern} {
sl@0:     case x a {format 1} b {format 2} c {format 3}
sl@0: } {}
sl@0: test case-1.5 {simple pattern matches many times} {
sl@0:     case b a {format 1} b {format 2} b {format 3} b {format 4}
sl@0: } 2
sl@0: test case-1.6 {fancier pattern} {
sl@0:     case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
sl@0: } 3
sl@0: test case-1.7 {list of patterns} {
sl@0:     case abc in {a b c} {format 1} {def abc ghi} {format 2}
sl@0: } 2
sl@0: 
sl@0: test case-2.1 {error in executed command} {
sl@0:     list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
sl@0: 	    $msg $errorInfo
sl@0: } {1 {Just a test} {Just a test
sl@0:     while executing
sl@0: "error "Just a test""
sl@0:     ("a" arm line 1)
sl@0:     invoked from within
sl@0: "case a in a {error "Just a test"} default {format 1}"}}
sl@0: test case-2.2 {error: not enough args} {
sl@0:     list [catch {case} msg] $msg
sl@0: } {1 {wrong # args: should be "case string ?in? patList body ... ?default body?"}}
sl@0: test case-2.3 {error: pattern with no body} {
sl@0:     list [catch {case a b} msg] $msg
sl@0: } {1 {extra case pattern with no body}}
sl@0: test case-2.4 {error: pattern with no body} {
sl@0:     list [catch {case a in b {format 1} c} msg] $msg
sl@0: } {1 {extra case pattern with no body}}
sl@0: test case-2.5 {error in default command} {
sl@0:     list [catch {case foo in a {error case1} default {error case2} \
sl@0: 	    b {error case 3}} msg] $msg $errorInfo
sl@0: } {1 case2 {case2
sl@0:     while executing
sl@0: "error case2"
sl@0:     ("default" arm line 1)
sl@0:     invoked from within
sl@0: "case foo in a {error case1} default {error case2}  b {error case 3}"}}
sl@0: 
sl@0: test case-3.1 {single-argument form for pattern/command pairs} {
sl@0:     case b in {
sl@0: 	a {format 1}
sl@0: 	b {format 2}
sl@0: 	default {format 6}
sl@0:     }
sl@0: } {2}
sl@0: test case-3.2 {single-argument form for pattern/command pairs} {
sl@0:     case b {
sl@0: 	a {format 1}
sl@0: 	b {format 2}
sl@0: 	default {format 6}
sl@0:     }
sl@0: } {2}
sl@0: test case-3.3 {single-argument form for pattern/command pairs} {
sl@0:     list [catch {case z in {a 2 b}} msg] $msg
sl@0: } {1 {extra case pattern with no body}}
sl@0: 
sl@0: # cleanup
sl@0: ::tcltest::cleanupTests
sl@0: return
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: 
sl@0: