os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/case.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/case.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,103 @@
1.4 +# Commands covered: case
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.11 +# Copyright (c) 1994 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: case.test,v 1.5 2000/04/10 17:18:57 ericm Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +test case-1.1 {simple pattern} {
1.25 + case a in a {format 1} b {format 2} c {format 3} default {format 4}
1.26 +} 1
1.27 +test case-1.2 {simple pattern} {
1.28 + case b a {format 1} b {format 2} c {format 3} default {format 4}
1.29 +} 2
1.30 +test case-1.3 {simple pattern} {
1.31 + case x in a {format 1} b {format 2} c {format 3} default {format 4}
1.32 +} 4
1.33 +test case-1.4 {simple pattern} {
1.34 + case x a {format 1} b {format 2} c {format 3}
1.35 +} {}
1.36 +test case-1.5 {simple pattern matches many times} {
1.37 + case b a {format 1} b {format 2} b {format 3} b {format 4}
1.38 +} 2
1.39 +test case-1.6 {fancier pattern} {
1.40 + case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
1.41 +} 3
1.42 +test case-1.7 {list of patterns} {
1.43 + case abc in {a b c} {format 1} {def abc ghi} {format 2}
1.44 +} 2
1.45 +
1.46 +test case-2.1 {error in executed command} {
1.47 + list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
1.48 + $msg $errorInfo
1.49 +} {1 {Just a test} {Just a test
1.50 + while executing
1.51 +"error "Just a test""
1.52 + ("a" arm line 1)
1.53 + invoked from within
1.54 +"case a in a {error "Just a test"} default {format 1}"}}
1.55 +test case-2.2 {error: not enough args} {
1.56 + list [catch {case} msg] $msg
1.57 +} {1 {wrong # args: should be "case string ?in? patList body ... ?default body?"}}
1.58 +test case-2.3 {error: pattern with no body} {
1.59 + list [catch {case a b} msg] $msg
1.60 +} {1 {extra case pattern with no body}}
1.61 +test case-2.4 {error: pattern with no body} {
1.62 + list [catch {case a in b {format 1} c} msg] $msg
1.63 +} {1 {extra case pattern with no body}}
1.64 +test case-2.5 {error in default command} {
1.65 + list [catch {case foo in a {error case1} default {error case2} \
1.66 + b {error case 3}} msg] $msg $errorInfo
1.67 +} {1 case2 {case2
1.68 + while executing
1.69 +"error case2"
1.70 + ("default" arm line 1)
1.71 + invoked from within
1.72 +"case foo in a {error case1} default {error case2} b {error case 3}"}}
1.73 +
1.74 +test case-3.1 {single-argument form for pattern/command pairs} {
1.75 + case b in {
1.76 + a {format 1}
1.77 + b {format 2}
1.78 + default {format 6}
1.79 + }
1.80 +} {2}
1.81 +test case-3.2 {single-argument form for pattern/command pairs} {
1.82 + case b {
1.83 + a {format 1}
1.84 + b {format 2}
1.85 + default {format 6}
1.86 + }
1.87 +} {2}
1.88 +test case-3.3 {single-argument form for pattern/command pairs} {
1.89 + list [catch {case z in {a 2 b}} msg] $msg
1.90 +} {1 {extra case pattern with no body}}
1.91 +
1.92 +# cleanup
1.93 +::tcltest::cleanupTests
1.94 +return
1.95 +
1.96 +
1.97 +
1.98 +
1.99 +
1.100 +
1.101 +
1.102 +
1.103 +
1.104 +
1.105 +
1.106 +