diff options
Diffstat (limited to 'tcl8.6/tests/switch.test')
| -rw-r--r-- | tcl8.6/tests/switch.test | 772 |
1 files changed, 0 insertions, 772 deletions
diff --git a/tcl8.6/tests/switch.test b/tcl8.6/tests/switch.test deleted file mode 100644 index 4d204bb..0000000 --- a/tcl8.6/tests/switch.test +++ /dev/null @@ -1,772 +0,0 @@ -# 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. -# 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 {"::tcltest" ni [namespace children]} { - package require tcltest 2 - namespace import -force ::tcltest::* -} - -test switch-1.1 {simple patterns} { - switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4} -} 1 -test switch-1.2 {simple patterns} { - switch b a {subst 1} b {subst 2} c {subst 3} default {subst 4} -} 2 -test switch-1.3 {simple patterns} { - switch x a {subst 1} b {subst 2} c {subst 3} default {subst 4} -} 4 -test switch-1.4 {simple patterns} { - switch x a {subst 1} b {subst 2} c {subst 3} -} {} -test switch-1.5 {simple pattern matches many times} { - switch b a {subst 1} b {subst 2} b {subst 3} b {subst 4} -} 2 -test switch-1.6 {simple patterns} { - switch default a {subst 1} default {subst 2} c {subst 3} default {subst 4} -} 2 -test switch-1.7 {simple patterns} { - switch x a {subst 1} default {subst 2} c {subst 3} default {subst 4} -} 4 -test switch-1.8 {simple patterns with -nocase} { - switch -nocase b a {subst 1} b {subst 2} c {subst 3} default {subst 4} -} 2 -test switch-1.9 {simple patterns with -nocase} { - switch -nocase B a {subst 1} b {subst 2} c {subst 3} default {subst 4} -} 2 -test switch-1.10 {simple patterns with -nocase} { - switch -nocase b a {subst 1} B {subst 2} c {subst 3} default {subst 4} -} 2 -test switch-1.11 {simple patterns with -nocase} { - switch -nocase x a {subst 1} default {subst 2} c {subst 3} default {subst 4} -} 4 - -test switch-2.1 {single-argument form for pattern/command pairs} { - switch b { - a {subst 1} - b {subst 2} - default {subst 6} - } -} {2} -test switch-2.2 {single-argument form for pattern/command pairs} -body { - switch z {a 2 b} -} -returnCodes error -result {extra switch pattern with no body} - -test switch-3.1 {-exact vs. -glob vs. -regexp} { - switch -exact aaaab { - ^a*b$ {subst regexp} - *b {subst glob} - aaaab {subst exact} - default {subst none} - } -} exact -test switch-3.2 {-exact vs. -glob vs. -regexp} { - switch -regexp aaaab { - ^a*b$ {subst regexp} - *b {subst glob} - aaaab {subst exact} - default {subst none} - } -} regexp -test switch-3.3 {-exact vs. -glob vs. -regexp} { - switch -glob aaaab { - ^a*b$ {subst regexp} - *b {subst glob} - aaaab {subst exact} - default {subst none} - } -} glob -test switch-3.4 {-exact vs. -glob vs. -regexp} { - switch aaaab {^a*b$} {subst regexp} *b {subst glob} \ - aaaab {subst exact} default {subst none} -} exact -test switch-3.5 {-exact vs. -glob vs. -regexp} { - switch -- -glob { - ^g.*b$ {subst regexp} - -* {subst glob} - -glob {subst exact} - default {subst none} - } -} exact -test switch-3.6 {-exact vs. -glob vs. -regexp} -body { - switch -foo a b c -} -returnCodes error -result {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --} -test switch-3.7 {-exact vs. -glob vs. -regexp with -nocase} { - switch -exact -nocase aaaab { - ^a*b$ {subst regexp} - *b {subst glob} - aaaab {subst exact} - default {subst none} - } -} exact -test switch-3.8 {-exact vs. -glob vs. -regexp with -nocase} { - switch -regexp -nocase aaaab { - ^a*b$ {subst regexp} - *b {subst glob} - aaaab {subst exact} - default {subst none} - } -} regexp -test switch-3.9 {-exact vs. -glob vs. -regexp with -nocase} { - switch -glob -nocase aaaab { - ^a*b$ {subst regexp} - *b {subst glob} - aaaab {subst exact} - default {subst none} - } -} glob -test switch-3.10 {-exact vs. -glob vs. -regexp with -nocase} { - switch -nocase aaaab {^a*b$} {subst regexp} *b {subst glob} \ - aaaab {subst exact} default {subst none} -} exact -test switch-3.11 {-exact vs. -glob vs. -regexp with -nocase} { - switch -nocase -- -glob { - ^g.*b$ {subst regexp} - -* {subst glob} - -glob {subst exact} - default {subst none} - } -} exact -test switch-3.12 {-exact vs. -glob vs. -regexp} { - switch -exa Foo Foo {set result OK} -} OK -test switch-3.13 {-exact vs. -glob vs. -regexp} { - switch -gl Foo Fo? {set result OK} -} OK -test switch-3.14 {-exact vs. -glob vs. -regexp} { - switch -re Foo Fo. {set result OK} -} OK -test switch-3.15 {-exact vs. -glob vs. -regexp} -body { - switch -exact -exact Foo Foo {set result OK} -} -returnCodes error -result {bad option "-exact": -exact option already found} -test switch-3.16 {-exact vs. -glob vs. -regexp} -body { - switch -exact -glob Foo Foo {set result OK} -} -returnCodes error -result {bad option "-glob": -exact option already found} -test switch-3.17 {-exact vs. -glob vs. -regexp} -body { - switch -glob -regexp Foo Foo {set result OK} -} -returnCodes error -result {bad option "-regexp": -glob option already found} -test switch-3.18 {-exact vs. -glob vs. -regexp} -body { - switch -regexp -glob Foo Foo {set result OK} -} -returnCodes error -result {bad option "-glob": -regexp option already found} - -test switch-4.1 {error in executed command} { - list [catch {switch a a {error "Just a test"} default {subst 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 {subst 1}"}} -test switch-4.2 {error: not enough args} -returnCodes error -body { - switch -} -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"} -test switch-4.3 {error: pattern with no body} -body { - switch a b -} -returnCodes error -result {extra switch pattern with no body} -test switch-4.4 {error: pattern with no body} -body { - switch a b {subst 1} c -} -returnCodes error -result {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} -returnCodes error -body { - switch -regexp aaaab { - *b {subst glob} - aaaab {subst exact} - default {subst none} - } -} -result {couldn't compile regular expression pattern: quantifier operand invalid} - -test switch-6.1 {backslashes in patterns} { - switch -exact {\a\$\.\[} { - \a\$\.\[ {subst first} - \a\\$\.\\[ {subst second} - \\a\\$\\.\\[ {subst third} - {\a\\$\.\\[} {subst fourth} - {\\a\\$\\.\\[} {subst fifth} - default {subst none} - } -} third -test switch-6.2 {backslashes in patterns} { - switch -exact {\a\$\.\[} { - \a\$\.\[ {subst first} - {\a\$\.\[} {subst second} - {{\a\$\.\[}} {subst third} - default {subst none} - } -} second - -test switch-7.1 {"-" bodies} { - switch a { - a - - b - - c {subst 1} - default {subst 2} - } -} 1 -test switch-7.2 {"-" bodies} -body { - switch a { - a - - b - - c - - } -} -returnCodes error -result {no body specified for pattern "c"} -test switch-7.3 {"-" bodies} -body { - switch a { - a - - b -foo - c - - } -} -returnCodes error -result {no body specified for pattern "c"} -test switch-7.4 {"-" bodies} -body { - switch a { - a - - b -foo - c {} - } -} -returnCodes error -result {invalid command name "-foo"} - -test switch-8.1 {empty body} { - set msg {} - switch {2} { - 1 {set msg 1} - 2 {} - default {set msg 2} - } -} {} -proc test_switch_body {} { - return "INVOKED" -} -test switch-8.2 {weird body text, variable} { - set cmd {test_switch_body} - switch Foo { - Foo $cmd - } -} {INVOKED} -test switch-8.3 {weird body text, variable} { - set cmd {test_switch_body} - switch Foo { - Foo {$cmd} - } -} {INVOKED} - -test switch-9.1 {empty pattern/body list} -returnCodes error -body { - switch x -} -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"} -test switch-9.2 {unpaired pattern} -returnCodes error -body { - switch -- x -} -result {extra switch pattern with no body} -test switch-9.3 {empty pattern/body list} -body { - switch x {} -} -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"} -test switch-9.4 {empty pattern/body list} -body { - switch -- x {} -} -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"} -test switch-9.5 {unpaired pattern} -body { - switch x a {} b -} -returnCodes error -result {extra switch pattern with no body} -test switch-9.6 {unpaired pattern} -body { - switch x {a {} b} -} -returnCodes error -result {extra switch pattern with no body} -test switch-9.7 {unpaired pattern} -body { - switch x a {} # comment b -} -returnCodes error -result {extra switch pattern with no body} -test switch-9.8 {unpaired pattern} -returnCodes error -body { - switch x {a {} # comment b} -} -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation} -test switch-9.9 {unpaired pattern} -body { - switch x a {} x {} # comment b -} -returnCodes error -result {extra switch pattern with no body} -test switch-9.10 {unpaired pattern} -returnCodes error -body { - switch x {a {} x {} # comment b} -} -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation} - -test switch-10.1 {compiled -exact switch} { - if 1 {switch -exact -- a {a {subst 1} b {subst 2}}} -} 1 -test switch-10.1a {compiled -exact switch} { - if 1 {switch -exact a {a {subst 1} b {subst 2}}} -} 1 -test switch-10.2 {compiled -exact switch} { - if 1 {switch -exact -- b {a {subst 1} b {subst 2}}} -} 2 -test switch-10.2a {compiled -exact switch} { - if 1 {switch -exact b {a {subst 1} b {subst 2}}} -} 2 -test switch-10.3 {compiled -exact switch} { - if 1 {switch -exact -- c {a {subst 1} b {subst 2}}} -} {} -test switch-10.3a {compiled -exact switch} { - if 1 {switch -exact c {a {subst 1} b {subst 2}}} -} {} -test switch-10.4 {compiled -exact switch} { - if 1 { - set x 0 - switch -exact -- c {a {subst 1} b {subst 2}} - } -} {} -test switch-10.5 {compiled -exact switch} { - if 1 {switch -exact -- a {a - aa {subst 1} b {subst 2}}} -} 1 -test switch-10.6 {compiled -exact switch} { - if 1 {switch -exact -- b {a { - set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 - set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 - set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 - set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 - set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 - set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 - set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 - set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1 - } b {subst 2}}} -} 2 - -# Command variants are: -# c* are compiled switches, i* are interpreted -# *-glob use glob matching, *-exact use exact matching -# *2* include a default clause (different results too.) -proc cswtest-glob s { - set x 0; set y 0 - foreach c [split $s {}] { - switch -glob $c { - a {incr x} - b {incr y} - } - } - set x [expr {$x*100}]; set y [expr {$y*100}] - foreach c [split $s {}] { - switch -glob -- $c a {incr x} b {incr y} - } - return $x,$y -} -proc iswtest-glob s { - set x 0; set y 0; set switch switch - foreach c [split $s {}] { - $switch -glob $c { - a {incr x} - b {incr y} - } - } - set x [expr {$x*100}]; set y [expr {$y*100}] - foreach c [split $s {}] { - $switch -glob -- $c a {incr x} b {incr y} - } - return $x,$y -} -proc cswtest-exact s { - set x 0; set y 0 - foreach c [split $s {}] { - switch -exact $c { - a {incr x} - b {incr y} - } - } - set x [expr {$x*100}]; set y [expr {$y*100}] - foreach c [split $s {}] { - switch -exact -- $c a {incr x} b {incr y} - } - return $x,$y -} -proc iswtest-exact s { - set x 0; set y 0; set switch switch - foreach c [split $s {}] { - $switch -exact $c { - a {incr x} - b {incr y} - } - } - set x [expr {$x*100}]; set y [expr {$y*100}] - foreach c [split $s {}] { - $switch -exact -- $c a {incr x} b {incr y} - } - return $x,$y -} -proc cswtest2-glob s { - set x 0; set y 0; set z 0 - foreach c [split $s {}] { - switch -glob $c { - a {incr x} - b {incr y} - default {incr z} - } - } - set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] - foreach c [split $s {}] { - switch -glob -- $c a {incr x} b {incr y} default {incr z} - } - return $x,$y,$z -} -proc iswtest2-glob s { - set x 0; set y 0; set z 0; set switch switch - foreach c [split $s {}] { - $switch -glob $c { - a {incr x} - b {incr y} - default {incr z} - } - } - set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] - foreach c [split $s {}] { - $switch -glob -- $c a {incr x} b {incr y} default {incr z} - } - return $x,$y,$z -} -proc cswtest2-exact s { - set x 0; set y 0; set z 0 - foreach c [split $s {}] { - switch -exact $c { - a {incr x} - b {incr y} - default {incr z} - } - } - set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] - foreach c [split $s {}] { - switch -exact -- $c a {incr x} b {incr y} default {incr z} - } - return $x,$y,$z -} -proc iswtest2-exact s { - set x 0; set y 0; set z 0; set switch switch - foreach c [split $s {}] { - $switch -exact $c { - a {incr x} - b {incr y} - default {incr z} - } - } - set x [expr {$x*100}]; set y [expr {$y*100}]; set z [expr {$z*100}] - foreach c [split $s {}] { - $switch -exact -- $c a {incr x} b {incr y} default {incr z} - } - return $x,$y,$z -} - -test switch-10.7 {comparison of compiled and interpreted behaviour of switch, exact matching} { - cswtest-exact abcb -} [iswtest-exact abcb] -test switch-10.8 {comparison of compiled and interpreted behaviour of switch, glob matching} { - cswtest-glob abcb -} [iswtest-glob abcb] -test switch-10.9 {comparison of compiled and interpreted behaviour of switch, exact matching with default} { - cswtest2-exact abcb -} [iswtest2-exact abcb] -test switch-10.10 {comparison of compiled and interpreted behaviour of switch, glob matching with default} { - cswtest2-glob abcb -} [iswtest2-glob abcb] -proc cswtest-default-exact {x} { - switch -- $x { - a* {return b} - aa {return c} - default {return d} - } -} -test switch-10.11 {default to exact matching when compiled} { - cswtest-default-exact a -} d -test switch-10.12 {default to exact matching when compiled} { - cswtest-default-exact aa -} c -test switch-10.13 {default to exact matching when compiled} { - cswtest-default-exact a* -} b -test switch-10.14 {default to exact matching when compiled} { - cswtest-default-exact a** -} d -rename cswtest-default-exact {} -rename cswtest-glob {} -rename iswtest-glob {} -rename cswtest2-glob {} -rename iswtest2-glob {} -rename cswtest-exact {} -rename iswtest-exact {} -rename cswtest2-exact {} -rename iswtest2-exact {} -# Bug 1891827 -test switch-10.15 {(not) compiled exact nocase regression} { - apply {{} { - switch -nocase -- A { a {return yes} default {return no} } - }} -} yes - -# Added due to TIP#75 -test switch-11.1 {regexp matching with -matchvar} { - switch -regexp -matchvar x -- abc {.(.). {set x}} -} {abc b} -test switch-11.2 {regexp matching with -matchvar} { - set x GOOD - switch -regexp -matchvar x -- abc {.(.).. {list $x z}} - set x -} GOOD -test switch-11.3 {regexp matching with -matchvar} { - switch -regexp -matchvar x -- "a b c" {.(.). {set x}} -} {{a b} { }} -test switch-11.4 {regexp matching with -matchvar} { - set x BAD - switch -regexp -matchvar x -- "a b c" { - bc {list $x YES} - default {list $x NO} - } -} {{} NO} -test switch-11.5 {-matchvar without -regexp} { - set x {} - list [catch {switch -glob -matchvar x -- abc . {set x}} msg] $x $msg -} {1 {} {-matchvar option requires -regexp option}} -test switch-11.6 {-matchvar unwritable} { - set x {} - list [catch {switch -regexp -matchvar x(x) -- abc . {set x}} msg] $x $msg -} {1 {} {can't set "x(x)": variable isn't array}} - -test switch-12.1 {regexp matching with -indexvar} { - switch -regexp -indexvar x -- abc {.(.). {set x}} -} {{0 2} {1 1}} -test switch-12.2 {regexp matching with -indexvar} { - set x GOOD - switch -regexp -indexvar x -- abc {.(.).. {list $x z}} - set x -} GOOD -test switch-12.3 {regexp matching with -indexvar} { - switch -regexp -indexvar x -- "a b c" {.(.). {set x}} -} {{0 2} {1 1}} -test switch-12.4 {regexp matching with -indexvar} { - set x BAD - switch -regexp -indexvar x -- "a b c" { - bc {list $x YES} - default {list $x NO} - } -} {{} NO} -test switch-12.5 {-indexvar without -regexp} { - set x {} - list [catch {switch -glob -indexvar x -- abc . {set x}} msg] $x $msg -} {1 {} {-indexvar option requires -regexp option}} -test switch-12.6 {-indexvar unwritable} { - set x {} - list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg -} {1 {} {can't set "x(x)": variable isn't array}} -test switch-12.7 {[Bug 3106532] -indexvar should be directly usable with [string range]} { - set str abcdef - switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]} -} abc -test switch-12.8 {-indexvar and matched empty strings} { - switch -regexp -indexvar x -- abcdef ^...(x?) {return $x} -} {{0 2} {3 2}} -test switch-12.9 {-indexvar and unmatched strings} { - switch -regexp -indexvar x -- abcdef ^...(x)? {return $x} -} {{0 2} {-1 -1}} - -test switch-13.1 {-indexvar -matchvar combinations} { - switch -regexp -indexvar x -matchvar y abc { - . {list $x $y} - } -} {{{0 0}} a} -test switch-13.2 {-indexvar -matchvar combinations} { - switch -regexp -indexvar x -matchvar y abc { - .$ {list $x $y} - } -} {{{2 2}} c} -test switch-13.3 {-indexvar -matchvar combinations} { - switch -regexp -indexvar x -matchvar y abc { - (.)(.)(.) {list $x $y} - } -} {{{0 2} {0 0} {1 1} {2 2}} {abc a b c}} -test switch-13.4 {-indexvar -matchvar combinations} { - set x - - set y - - switch -regexp -indexvar x -matchvar y abc { - (.)(.)(.). - - default {list $x $y} - } -} {{} {}} -test switch-13.5 {-indexvar -matchvar combinations} { - set x - - set y - - list [catch { - switch -regexp -indexvar x(x) -matchvar y abc {. {list $x $y}} - } msg] $x $y $msg -} {1 - - {can't set "x(x)": variable isn't array}} -test switch-13.6 {-indexvar -matchvar combinations} { - set x - - set y - - list [catch { - switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}} - } msg] $x $y $msg -} {1 {{0 0}} - {can't set "y(y)": variable isn't array}} - -test switch-14.1 {-regexp -- compilation [Bug 1854399]} { - switch -regexp -- 0 { - {[0-9]+} {return yes} - default {return no} - } - foo -} yes -test switch-14.2 {-regexp -- compilation [Bug 1854399]} { - proc foo {} { - switch -regexp -- 0 { - {[0-9]+} {return yes} - default {return no} - } - } - foo -} yes -test switch-14.3 {-regexp -- compilation [Bug 1854399]} { - proc foo {} { - switch -regexp -- 0 { - {\d+} {return yes} - default {return no} - } - } - foo -} yes -test switch-14.4 {-regexp -- compilation [Bug 1854399]} { - proc foo {} { - switch -regexp -- 0 { - {0} {return yes} - default {return no} - } - } - foo -} yes -test switch-14.5 {switch -regexp compilation} { - apply {{} { - switch -regexp -- 0 { - {0|1|2} {return yes} - default {return no} - } - }} -} yes -test switch-14.6 {switch -regexp compilation} { - apply {{} { - switch -regexp -- 0 { - {0|11|222} {return yes} - default {return no} - } - }} -} yes -test switch-14.7 {switch -regexp compilation} { - apply {{} { - switch -regexp -- 0 { - {[012]} {return yes} - default {return no} - } - }} -} yes -test switch-14.8 {switch -regexp compilation} { - apply {{} { - switch -regexp -- x { - {0|1|2} {return yes} - default {return no} - } - }} -} no -test switch-14.9 {switch -regexp compilation} { - apply {{} { - switch -regexp -- x { - {0|11|222} {return yes} - default {return no} - } - }} -} no -test switch-14.10 {switch -regexp compilation} { - apply {{} { - switch -regexp -- x { - {[012]} {return yes} - default {return no} - } - }} -} no -test switch-14.11 {switch -regexp compilation} { - apply {{} { - switch -regexp -- x { - {0|1|2} {return yes} - .+ {return yes2} - default {return no} - } - }} -} yes2 -test switch-14.12 {switch -regexp compilation} { - apply {{} { - switch -regexp -- x { - {0|11|222} {return yes} - .+ {return yes2} - default {return no} - } - }} -} yes2 -test switch-14.13 {switch -regexp compilation} { - apply {{} { - switch -regexp -- x { - {[012]} {return yes} - .+ {return yes2} - default {return no} - } - }} -} yes2 -test switch-14.14 {switch -regexp compilation} { - apply {{} { - switch -regexp -- {} { - {0|1|2} {return yes} - .+ {return yes2} - default {return no} - } - }} -} no -test switch-14.15 {switch -regexp compilation} { - apply {{} { - switch -regexp -- {} { - {0|11|222} {return yes} - .+ {return yes2} - default {return no} - } - }} -} no -test switch-14.16 {switch -regexp compilation} { - apply {{} { - switch -regexp -- {} { - {[012]} {return yes} - .+ {return yes2} - default {return no} - } - }} -} no - -test switch-15.1 {coroutine safety of non-bytecoded switch} {*}{ - -body { - proc coro {} { - switch -glob a { - a {yield ok1} - } - return ok2 - } - list [coroutine c coro] [c] - } - -result {ok1 ok2} - -cleanup { - rename coro {} - } -} - -# cleanup -catch {rename foo {}} -::tcltest::cleanupTests -return - -# Local Variables: -# mode: tcl -# End: |