diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2018-01-02 21:03:49 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2018-01-02 21:03:49 (GMT) |
commit | 914501b5b992e7b6c7e0a4c958712a8ba9cab41c (patch) | |
tree | edbc059b9557d5fdb79e5a5c47889bc54708da53 /tcl8.6/tests/case.test | |
parent | f88c190a01bc7f57e79dfaf91a3c0c48c2031549 (diff) | |
download | blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.zip blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.tar.gz blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.tar.bz2 |
upgrade to tcl/tk 8.6.8
Diffstat (limited to 'tcl8.6/tests/case.test')
-rw-r--r-- | tcl8.6/tests/case.test | 89 |
1 files changed, 89 insertions, 0 deletions
diff --git a/tcl8.6/tests/case.test b/tcl8.6/tests/case.test new file mode 100644 index 0000000..6d63cea --- /dev/null +++ b/tcl8.6/tests/case.test @@ -0,0 +1,89 @@ +# 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. + +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? ?pattern 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 |