[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.

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  <nijtmans@users.sf.net>
+
+	* 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  <andreask@activestate.com>
 
 	* 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