Generate errorcodes for more cases.

1 files changed, 41 insertions, 38 deletions

diff --git a/tests/rename.test b/tests/rename.test
index 45d6847..3a3a47f 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -1,34 +1,34 @@
 # Commands covered:  rename
 #
-# 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.
+# 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.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: rename.test,v 1.12 2004/05/19 20:15:32 dkf Exp $
+# RCS: @(#) $Id: rename.test,v 1.13 2009/01/08 16:41:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
 testConstraint testdel [llength [info commands testdel]]
 
-# Must eliminate the "unknown" command while the test is running,
-# especially if the test is being run in a program with its
-# own special-purpose unknown command.
-
+# Must eliminate the "unknown" command while the test is running, especially
+# if the test is being run in a program with its own special-purpose unknown
+# command.
 catch {rename unknown unknown.old}
-
+
 catch {rename r2 {}}
 proc r1 {} {return "procedure r1"}
 rename r1 r2
+
 test rename-1.1 {simple renaming} {
     r2
 } {procedure r1}
@@ -40,10 +40,9 @@ test rename-1.3 {simple renaming} {
     list [catch r2 msg] $msg
 } {1 {invalid command name "r2"}}
 
-# The test below is tricky because it renames a built-in command.
-# It's possible that the test procedure uses this command, so must
-# restore the command before calling test again.
-
+# The test below is tricky because it renames a built-in command. It's
+# possible that the test procedure uses this command, so must restore the
+# command before calling test again.
 rename list l.new
 set a [catch list msg1]
 set b [l.new a b c]
@@ -56,24 +55,27 @@ test rename-2.1 {renaming built-in command} {
 
 test rename-3.1 {error conditions} {
     list [catch {rename r1} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
+} {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}}
 test rename-3.2 {error conditions} {
     list [catch {rename r1 r2 r3} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
-test rename-3.3 {error conditions} {
+} {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}}
+test rename-3.3 {error conditions} -setup {
     proc r1 {} {}
     proc r2 {} {}
-    list [catch {rename r1 r2} msg] $msg
-} {1 {can't rename to "r2": command already exists}}
-test rename-3.4 {error conditions} {
+} -returnCodes error -body {
+    rename r1 r2
+} -result {can't rename to "r2": command already exists}
+test rename-3.4 {error conditions} -setup {
     catch {rename r1 {}}
     catch {rename r2 {}}
-    list [catch {rename r1 r2} msg] $msg
-} {1 {can't rename "r1": command doesn't exist}}
-test rename-3.5 {error conditions} {
+} -returnCodes error -body {
+    rename r1 r2
+} -result {can't rename "r1": command doesn't exist}
+test rename-3.5 {error conditions} -setup {
     catch {rename _non_existent_command {}}
-    list [catch {rename _non_existent_command {}} msg] $msg
-} {1 {can't delete "_non_existent_command": command doesn't exist}}
+} -returnCodes error -body {
+    rename _non_existent_command {}
+} -result {can't delete "_non_existent_command": command doesn't exist}
 
 catch {rename unknown {}}
 catch {rename unknown.old unknown}
@@ -142,11 +144,9 @@ if {[info exists env(value)]} {
 
 catch {rename unknown unknown.old}
 
+set SAVED_UNKNOWN "proc unknown "
+append SAVED_UNKNOWN [list [info args unknown.old] [info body unknown.old]]
 test rename-5.1 {repeated rename deletion and redefinition of same command} {
-    set SAVED_UNKNOWN "proc unknown "
-    append SAVED_UNKNOWN "\{[info args unknown.old]\} "
-    append SAVED_UNKNOWN "\{[info body unknown.old]\}"
-
     for {set i 0} {$i < 10} {incr i} {
         eval $SAVED_UNKNOWN
         tcl_wordBreakBefore "" 0
@@ -158,24 +158,27 @@ test rename-5.1 {repeated rename deletion and redefinition of same command} {
 catch {rename unknown {}}
 catch {rename unknown.old unknown}
 
-
-test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } {
-     proc x {} {
+test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed} -body {
+    proc x {} {
         set a 123
         set b [incr a]
     }
     x
     rename incr incr.old
     proc incr {} {puts "new incr called!"}
-    catch {x} msg
+    x
+} -cleanup {
     rename incr {}
     rename incr.old incr
-    set msg
-} {wrong # args: should be "incr"}
-
+} -returnCodes error -result {wrong # args: should be "incr"}
+
 if {[info commands incr.old] != {}} {
     catch {rename incr {}}
     catch {rename incr.old incr}
 }
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End: