diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/init.test | 4 | ||||
| -rw-r--r-- | tests/ioCmd.test | 57 | ||||
| -rw-r--r-- | tests/string.test | 6 |
3 files changed, 39 insertions, 28 deletions
diff --git a/tests/init.test b/tests/init.test index 520a731..c5907d8 100644 --- a/tests/init.test +++ b/tests/init.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: init.test,v 1.16 2007/09/07 15:51:26 dgp Exp $ +# RCS: @(#) $Id: init.test,v 1.17 2007/11/20 20:43:13 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -207,7 +207,7 @@ test init-5.0 {return options passed through ::unknown} -setup { list $code $foo $bar $code2 $foo2 $bar2 } -cleanup { unset ::auto_index(::xxx) -} -result {2 xxx {-code 1 -level 1 -errorcode NONE} 2 xxx {-code 1 -level 1 -errorcode NONE}} +} -result {2 xxx {-errorcode NONE -code 1 -level 1} 2 xxx {-code 1 -level 1 -errorcode NONE}} cleanupTests } ;# End of [interp eval $testInterp] diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 9d39de9..baf7ae3 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioCmd.test,v 1.32 2007/11/19 14:22:26 dkf Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.33 2007/11/20 20:43:13 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -761,6 +761,10 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g proc note {item} {global res; lappend res $item; return} proc track {} {upvar args item; note $item; return} proc notes {items} {foreach i $items {note $i}} +# This forces the return options to be in the order that the test expects! +proc noteOpts opts {global res; lappend res [dict merge { + -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?! +} $opts]; return} # Helper command, canned result for 'initialize' method. # Gets the optional methods as arguments. Use return features @@ -858,13 +862,15 @@ test iocmd-22.8 {chan finalize, for close, custom code, close error} -match glob rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} -test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -body { +test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -setup { set res {} +} -body { proc foo {args} {track; oninit; return -level 5 -code 777 BANG} note [set c [chan create {r w} foo]] - note [catch {close $c} msg opt]; note $msg; note $opt + note [catch {close $c} msg opt]; note $msg; noteOpts $opt + return $res +} -cleanup { rename foo {} - set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} # --- === *** ########################### @@ -960,7 +966,7 @@ test iocmd-23.8 {chan read, level is squashed} -match glob -body { return -level 55 -code 777 BOOM! } set c [chan create {r w} foo] - note [catch {read $c 2} msg opt]; note $msg; note $opt + note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res @@ -1100,7 +1106,7 @@ test iocmd-24.13 {chan write, failed write, level is ignored} -match glob -body set c [chan create {r w} foo] note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt] note $msg - note $opt + noteOpts $opt close $c rename foo {} set res @@ -1218,7 +1224,7 @@ test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body { return -level 55 -code 777 BANG } set c [chan create {r w} foo] - note [catch {fconfigure $c} msg opt]; note $msg; note $opt + note [catch {fconfigure $c} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res @@ -1302,7 +1308,7 @@ test iocmd-26.7 {chan configure, set option, level is ignored} -match glob -body return -level 55 -code 444 BANG } set c [chan create {r w} foo] - note [catch {fconfigure $c -rc-foo bar} msg opt]; note $msg; note $opt + note [catch {fconfigure $c -rc-foo bar} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res @@ -1375,7 +1381,7 @@ test iocmd-27.6 {chan configure, get option, level is ignored} -match glob -body return -level 77 -code 333 BANG } set c [chan create {r w} foo] - note [catch {fconfigure $c -rc-foo} msg opt]; note $msg; note $opt + note [catch {fconfigure $c -rc-foo} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res @@ -1433,7 +1439,7 @@ test iocmd-28.6 {chan tell, level is ignored} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG} set c [chan create {r w} foo] - note [catch {tell $c} msg opt]; note $msg; note $opt + note [catch {tell $c} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res @@ -1514,7 +1520,7 @@ test iocmd-28.15 {chan seek, level is ignored} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG} set c [chan create {r w} foo] - note [catch {seek $c 0 start} msg opt]; note $msg; note $opt + note [catch {seek $c 0 start} msg opt]; note $msg; noteOpts $opt close $c rename foo {} set res @@ -1650,14 +1656,16 @@ test iocmd-29.9 {chan blocking, custom return is error} -match glob -body { rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} -test iocmd-29.10 {chan blocking, level is ignored} -match glob -body { +test iocmd-29.10 {chan blocking, level is ignored} -match glob -setup { set res {} +} -body { proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG} set c [chan create {r w} foo] - note [catch {fconfigure $c -blocking 0} msg opt]; note $msg; note $opt + note [catch {fconfigure $c -blocking 0} msg opt]; note $msg; noteOpts $opt catch {close $c} + return $res +} -cleanup { rename foo {} - set res } -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}} test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob -body { set res {} @@ -1840,6 +1848,9 @@ proc inthread {chan script args} { testthread send $tid { proc note {item} {global notes; lappend notes $item} proc notes {} {global notes; return $notes} + proc noteOpts opts {global notes; lappend notes [dict merge { + -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?! + } $opts]} } testthread send $tid [list proc s {} [list uplevel 1 $script]]; # (*) @@ -1960,7 +1971,7 @@ test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match proc foo {args} {track; oninit; return -level 5 -code 777 BANG} note [set c [chan create {r w} foo]] notes [inthread $c { - note [catch {close $c} msg opt]; note $msg; note $opt + note [catch {close $c} msg opt]; note $msg; noteOpts $opt notes } c] rename foo {} @@ -2087,7 +2098,7 @@ test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body { } set c [chan create {r w} foo] notes [inthread $c { - note [catch {read $c 2} msg opt]; note $msg; note $opt + note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt close $c notes } c] @@ -2273,7 +2284,7 @@ test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -bo notes [inthread $c { note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt] note $msg - note $opt + noteOpts $opt close $c notes } c] @@ -2436,7 +2447,7 @@ test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -bod notes [inthread $c { note [catch {fconfigure $c} msg opt] note $msg - note $opt + noteOpts $opt close $c notes } c] @@ -2551,7 +2562,7 @@ test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -b notes [inthread $c { note [catch {fconfigure $c -rc-foo bar} msg opt] note $msg - note $opt + noteOpts $opt close $c notes } c] @@ -2652,7 +2663,7 @@ test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -b notes [inthread $c { note [catch {fconfigure $c -rc-foo} msg opt] note $msg - note $opt + noteOpts $opt close $c notes } c] @@ -2740,7 +2751,7 @@ test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body { notes [inthread $c { note [catch {tell $c} msg opt] note $msg - note $opt + noteOpts $opt close $c notes } c] @@ -2866,7 +2877,7 @@ test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body { notes [inthread $c { note [catch {seek $c 0 start} msg opt] note $msg - note $opt + noteOpts $opt close $c notes } c] @@ -3070,7 +3081,7 @@ test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body { notes [inthread $c { note [catch {fconfigure $c -blocking 0} msg opt] note $msg - note $opt + noteOpts $opt catch {close $c} notes } c] diff --git a/tests/string.test b/tests/string.test index f6c4954..e421738 100644 --- a/tests/string.test +++ b/tests/string.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: string.test,v 1.66 2007/11/01 11:11:45 dkf Exp $ +# RCS: @(#) $Id: string.test,v 1.67 2007/11/20 20:43:13 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -821,10 +821,10 @@ test string-10.18 {string map, empty argument} { test string-10.19 {string map, empty arguments} { string map -nocase {{} abc f bar {} def} foo } baroo -test string-10.20 {string map, dictionaries can alter map ordering} { +test string-10.20 {string map, dictionaries don't alter map ordering} { set map {aa X a Y} list [string map [dict create aa X a Y] aaa] [string map $map aaa] [dict size $map] [string map $map aaa] -} {YYY XY 2 XY} +} {XY XY 2 XY} test string-10.21 {string map, ABR checks} { string map {longstring foob} long } long |