diff options
Diffstat (limited to 'tests/rename.test')
| -rw-r--r-- | tests/rename.test | 80 |
1 files changed, 43 insertions, 37 deletions
diff --git a/tests/rename.test b/tests/rename.test index cd90b55..ebf5425 100644 --- a/tests/rename.test +++ b/tests/rename.test @@ -1,32 +1,35 @@ # 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. if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2 namespace import -force ::tcltest::* } -testConstraint testdel [llength [info commands testdel]] +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] -# 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. +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. 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} @@ -38,10 +41,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] @@ -54,24 +56,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} @@ -147,11 +152,9 @@ test rename-4.8 {Bug a16752c252} testdel { 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 @@ -163,24 +166,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: |