sl@0: # Commands covered: rename sl@0: # sl@0: # This file contains a collection of tests for one or more of the Tcl sl@0: # built-in commands. Sourcing this file into Tcl runs the tests and sl@0: # generates output for errors. No output means no errors were found. sl@0: # sl@0: # Copyright (c) 1991-1993 The Regents of the University of California. sl@0: # Copyright (c) 1994 Sun Microsystems, Inc. sl@0: # Copyright (c) 1998-1999 by Scriptics Corporation. sl@0: # sl@0: # See the file "license.terms" for information on usage and redistribution sl@0: # of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: # sl@0: # RCS: @(#) $Id: rename.test,v 1.10 2001/09/12 20:28:50 dgp Exp $ sl@0: sl@0: if {[lsearch [namespace children] ::tcltest] == -1} { sl@0: package require tcltest sl@0: namespace import -force ::tcltest::* sl@0: } sl@0: sl@0: # Must eliminate the "unknown" command while the test is running, sl@0: # especially if the test is being run in a program with its sl@0: # own special-purpose unknown command. sl@0: sl@0: catch {rename unknown unknown.old} sl@0: sl@0: catch {rename r2 {}} sl@0: proc r1 {} {return "procedure r1"} sl@0: rename r1 r2 sl@0: test rename-1.1 {simple renaming} { sl@0: r2 sl@0: } {procedure r1} sl@0: test rename-1.2 {simple renaming} { sl@0: list [catch r1 msg] $msg sl@0: } {1 {invalid command name "r1"}} sl@0: rename r2 {} sl@0: test rename-1.3 {simple renaming} { sl@0: list [catch r2 msg] $msg sl@0: } {1 {invalid command name "r2"}} sl@0: sl@0: # The test below is tricky because it renames a built-in command. sl@0: # It's possible that the test procedure uses this command, so must sl@0: # restore the command before calling test again. sl@0: sl@0: rename list l.new sl@0: set a [catch list msg1] sl@0: set b [l.new a b c] sl@0: rename l.new list sl@0: set c [catch l.new msg2] sl@0: set d [list 111 222] sl@0: test rename-2.1 {renaming built-in command} { sl@0: list $a $msg1 $b $c $msg2 $d sl@0: } {1 {invalid command name "list"} {a b c} 1 {invalid command name "l.new"} {111 222}} sl@0: sl@0: test rename-3.1 {error conditions} { sl@0: list [catch {rename r1} msg] $msg $errorCode sl@0: } {1 {wrong # args: should be "rename oldName newName"} NONE} sl@0: test rename-3.2 {error conditions} { sl@0: list [catch {rename r1 r2 r3} msg] $msg $errorCode sl@0: } {1 {wrong # args: should be "rename oldName newName"} NONE} sl@0: test rename-3.3 {error conditions} { sl@0: proc r1 {} {} sl@0: proc r2 {} {} sl@0: list [catch {rename r1 r2} msg] $msg sl@0: } {1 {can't rename to "r2": command already exists}} sl@0: test rename-3.4 {error conditions} { sl@0: catch {rename r1 {}} sl@0: catch {rename r2 {}} sl@0: list [catch {rename r1 r2} msg] $msg sl@0: } {1 {can't rename "r1": command doesn't exist}} sl@0: test rename-3.5 {error conditions} { sl@0: catch {rename _non_existent_command {}} sl@0: list [catch {rename _non_existent_command {}} msg] $msg sl@0: } {1 {can't delete "_non_existent_command": command doesn't exist}} sl@0: sl@0: catch {rename unknown {}} sl@0: catch {rename unknown.old unknown} sl@0: catch {rename bar {}} sl@0: sl@0: if {[info command testdel] == "testdel"} { sl@0: test rename-4.1 {reentrancy issues with command deletion and renaming} { sl@0: set x {} sl@0: testdel {} foo {lappend x deleted; rename bar {}; lappend x [info command bar]} sl@0: rename foo bar sl@0: lappend x | sl@0: rename bar {} sl@0: set x sl@0: } {| deleted {}} sl@0: test rename-4.2 {reentrancy issues with command deletion and renaming} { sl@0: set x {} sl@0: testdel {} foo {lappend x deleted; rename foo bar} sl@0: rename foo {} sl@0: set x sl@0: } {deleted} sl@0: test rename-4.3 {reentrancy issues with command deletion and renaming} { sl@0: set x {} sl@0: testdel {} foo {lappend x deleted; testdel {} foo {lappend x deleted2}} sl@0: rename foo {} sl@0: lappend x | sl@0: rename foo {} sl@0: set x sl@0: } {deleted | deleted2} sl@0: test rename-4.4 {reentrancy issues with command deletion and renaming} { sl@0: set x {} sl@0: testdel {} foo {lappend x deleted; rename foo bar} sl@0: rename foo {} sl@0: lappend x | [info command bar] sl@0: } {deleted | {}} sl@0: test rename-4.5 {reentrancy issues with command deletion and renaming} { sl@0: set env(value) before sl@0: interp create foo sl@0: testdel foo cmd {set env(value) deleted} sl@0: interp delete foo sl@0: set env(value) sl@0: } {deleted} sl@0: test rename-4.6 {reentrancy issues with command deletion and renaming} { sl@0: proc kill args { sl@0: interp delete foo sl@0: } sl@0: set env(value) before sl@0: interp create foo sl@0: foo alias kill kill sl@0: testdel foo cmd {set env(value) deleted; kill} sl@0: list [catch {foo eval {rename cmd {}}} msg] $msg $env(value) sl@0: } {0 {} deleted} sl@0: test rename-4.7 {reentrancy issues with command deletion and renaming} { sl@0: proc kill args { sl@0: interp delete foo sl@0: } sl@0: set env(value) before sl@0: interp create foo sl@0: foo alias kill kill sl@0: testdel foo cmd {set env(value) deleted; kill} sl@0: list [catch {interp delete foo} msg] $msg $env(value) sl@0: } {0 {} deleted} sl@0: if {[info exists env(value)]} { sl@0: unset env(value) sl@0: } sl@0: } sl@0: sl@0: # Save the unknown procedure which is modified by the following test. sl@0: sl@0: catch {rename unknown unknown.old} sl@0: sl@0: test rename-5.1 {repeated rename deletion and redefinition of same command} { sl@0: set SAVED_UNKNOWN "proc unknown " sl@0: append SAVED_UNKNOWN "\{[info args unknown.old]\} " sl@0: append SAVED_UNKNOWN "\{[info body unknown.old]\}" sl@0: sl@0: for {set i 0} {$i < 10} {incr i} { sl@0: eval $SAVED_UNKNOWN sl@0: tcl_wordBreakBefore "" 0 sl@0: rename tcl_wordBreakBefore {} sl@0: rename unknown {} sl@0: } sl@0: } {} sl@0: sl@0: catch {rename unknown {}} sl@0: catch {rename unknown.old unknown} sl@0: sl@0: sl@0: test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } { sl@0: proc x {} { sl@0: set a 123 sl@0: set b [incr a] sl@0: } sl@0: x sl@0: rename incr incr.old sl@0: proc incr {} {puts "new incr called!"} sl@0: catch {x} msg sl@0: set msg sl@0: } {wrong # args: should be "incr"} sl@0: sl@0: if {[info commands incr.old] != {}} { sl@0: catch {rename incr {}} sl@0: catch {rename incr.old incr} sl@0: } sl@0: ::tcltest::cleanupTests sl@0: return