From d939798dd89166dee8a80e460ca723c718099d64 Mon Sep 17 00:00:00 2001 From: nijtmans Date: Wed, 31 Mar 2010 10:29:22 +0000 Subject: [FRQ 2974744]: share exception codes (ObjType?): Revised test cases, making sure that abbreviated codes are checked resulting in an error, and checking for the exact error message. --- ChangeLog | 7 +++++++ tests/cmdMZ.test | 12 ++++++------ tests/error.test | 8 ++++---- tests/proc-old.test | 14 +++++++------- 4 files changed, 24 insertions(+), 17 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1a49b1d..73442ef 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2010-03-31 Jan Nijtmans + + * test/cmdMZ.test: [FRQ 2974744]: share exception codes (ObjType?): + * test/error.test: Revised test cases, making sure that abbreviated + * test/proc-old.test: codes are checked resulting in an error, and + checking for the exact error message. + 2010-03-30 Andreas Kupries * generic/tclIORChan.c (ReflectClose, ReflectInput, ReflectOutput, diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index c0f2738..0a86e42 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: cmdMZ.test,v 1.28 2009/11/16 18:00:11 dgp Exp $ +# RCS: @(#) $Id: cmdMZ.test,v 1.29 2010/03/31 10:29:22 nijtmans Exp $ if {[catch {package require tcltest 2.1}]} { puts stderr "Skipping tests in [info script]. tcltest 2.1 required." @@ -96,11 +96,11 @@ test cmdMZ-return-1.0 {return checks for bad option values} -body { return -options foo } -returnCodes error -match glob -result {bad -options value:*} test cmdMZ-return-1.1 {return checks for bad option values} -body { - return -code foo -} -returnCodes error -match glob -result {bad completion code*} + return -code err +} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} test cmdMZ-return-1.2 {return checks for bad option values} -body { return -code 0x100000000 -} -returnCodes error -match glob -result {bad completion code*} +} -returnCodes error -match glob -result {bad completion code "0x100000000": must be ok, error, return, break, continue*, or an integer} test cmdMZ-return-1.3 {return checks for bad option values} -body { return -level foo } -returnCodes error -match glob -result {bad -level value: *} @@ -161,8 +161,8 @@ test cmdMZ-return-2.12 {return option handling} -body { return -level 0 -code error -options {-code ok} } -returnCodes ok -result {} test cmdMZ-return-2.13 {return option handling} -body { - return -level 0 -code error -options {-code foo} -} -returnCodes error -match glob -result {bad completion code*} + return -level 0 -code error -options {-code err} +} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} test cmdMZ-return-2.14 {return option handling} -body { return -level 0 -code error -options {-code foo -options {-code break}} } -returnCodes break -result {} diff --git a/tests/error.test b/tests/error.test index 9e192ef..623595c 100644 --- a/tests/error.test +++ b/tests/error.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: error.test,v 1.28 2010/03/23 12:58:39 nijtmans Exp $ +# RCS: @(#) $Id: error.test,v 1.29 2010/03/31 10:29:22 nijtmans Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -882,11 +882,11 @@ rename addmsg {} # negative case try tests - bad "on" handler test error-20.1 {bad code name in on handler} -body { - try { list a b c } on foo {} {} -} -returnCodes error -match glob -result {bad completion code *} + try { list a b c } on err {} {} +} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} test error-20.2 {bad code value in on handler} -body { try { list a b c } on 34985723094872345 {} {} -} -returnCodes error -match glob -result {bad completion code *} +} -returnCodes error -match glob -result {bad completion code "34985723094872345": must be ok, error, return, break, continue*, or an integer} test error-21.1 {memory leaks in try: Bug 2910044} memory { leaktest { diff --git a/tests/proc-old.test b/tests/proc-old.test index 29a0607..6a95528 100644 --- a/tests/proc-old.test +++ b/tests/proc-old.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: proc-old.test,v 1.17 2008/09/25 19:26:39 dgp Exp $ +# RCS: @(#) $Id: proc-old.test,v 1.18 2010/03/31 10:29:22 nijtmans Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -408,12 +408,12 @@ test proc-old-7.5 {return with special completion code} { test proc-old-7.6 {return with special completion code} { list [catch {tproc -14} msg] $msg } {-14 abc} -test proc-old-7.7 {return with special completion code} { - list [catch {tproc gorp} msg] $msg -} {1 {bad completion code "gorp": must be ok, error, return, break, continue, or an integer}} -test proc-old-7.8 {return with special completion code} { - list [catch {tproc 10b} msg] $msg -} {1 {bad completion code "10b": must be ok, error, return, break, continue, or an integer}} +test proc-old-7.7 {return with special completion code} -body { + tproc err +} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} +test proc-old-7.8 {return with special completion code} -body { + tproc 10b +} -returnCodes error -match glob -result {bad completion code "10b": must be ok, error, return, break, continue*, or an integer} test proc-old-7.9 {return with special completion code} { proc tproc2 {} { tproc return -- cgit v0.12