1# Commands covered:  rename
2#
3# This file contains a collection of tests for one or more of the Tcl
4# built-in commands.  Sourcing this file into Tcl runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright (c) 1991-1993 The Regents of the University of California.
8# Copyright (c) 1994 Sun Microsystems, Inc.
9# Copyright (c) 1998-1999 by Scriptics Corporation.
10#
11# See the file "license.terms" for information on usage and redistribution
12# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13#
14# RCS: @(#) $Id: rename.test,v 1.10 2001/09/12 20:28:50 dgp Exp $
15
16if {[lsearch [namespace children] ::tcltest] == -1} {
17    package require tcltest
18    namespace import -force ::tcltest::*
19}
20
21# Must eliminate the "unknown" command while the test is running,
22# especially if the test is being run in a program with its
23# own special-purpose unknown command.
24
25catch {rename unknown unknown.old}
26
27catch {rename r2 {}}
28proc r1 {} {return "procedure r1"}
29rename r1 r2
30test rename-1.1 {simple renaming} {
31    r2
32} {procedure r1}
33test rename-1.2 {simple renaming} {
34    list [catch r1 msg] $msg
35} {1 {invalid command name "r1"}}
36rename r2 {}
37test rename-1.3 {simple renaming} {
38    list [catch r2 msg] $msg
39} {1 {invalid command name "r2"}}
40
41# The test below is tricky because it renames a built-in command.
42# It's possible that the test procedure uses this command, so must
43# restore the command before calling test again.
44
45rename list l.new
46set a [catch list msg1]
47set b [l.new a b c]
48rename l.new list
49set c [catch l.new msg2]
50set d [list 111 222]
51test rename-2.1 {renaming built-in command} {
52    list $a $msg1 $b $c $msg2 $d
53} {1 {invalid command name "list"} {a b c} 1 {invalid command name "l.new"} {111 222}}
54
55test rename-3.1 {error conditions} {
56    list [catch {rename r1} msg] $msg $errorCode
57} {1 {wrong # args: should be "rename oldName newName"} NONE}
58test rename-3.2 {error conditions} {
59    list [catch {rename r1 r2 r3} msg] $msg $errorCode
60} {1 {wrong # args: should be "rename oldName newName"} NONE}
61test rename-3.3 {error conditions} {
62    proc r1 {} {}
63    proc r2 {} {}
64    list [catch {rename r1 r2} msg] $msg
65} {1 {can't rename to "r2": command already exists}}
66test rename-3.4 {error conditions} {
67    catch {rename r1 {}}
68    catch {rename r2 {}}
69    list [catch {rename r1 r2} msg] $msg
70} {1 {can't rename "r1": command doesn't exist}}
71test rename-3.5 {error conditions} {
72    catch {rename _non_existent_command {}}
73    list [catch {rename _non_existent_command {}} msg] $msg
74} {1 {can't delete "_non_existent_command": command doesn't exist}}
75
76catch {rename unknown {}}
77catch {rename unknown.old unknown}
78catch {rename bar {}}
79
80if {[info command testdel] == "testdel"} {
81    test rename-4.1 {reentrancy issues with command deletion and renaming} {
82	set x {}
83	testdel {} foo {lappend x deleted; rename bar {}; lappend x [info command bar]}
84	rename foo bar
85	lappend x |
86	rename bar {}
87	set x
88    } {| deleted {}}
89    test rename-4.2 {reentrancy issues with command deletion and renaming} {
90	set x {}
91	testdel {} foo {lappend x deleted; rename foo bar}
92	rename foo {}
93	set x
94    } {deleted}
95    test rename-4.3 {reentrancy issues with command deletion and renaming} {
96	set x {}
97	testdel {} foo {lappend x deleted; testdel {} foo {lappend x deleted2}}
98	rename foo {}
99	lappend x |
100	rename foo {}
101	set x
102    } {deleted | deleted2}
103    test rename-4.4 {reentrancy issues with command deletion and renaming} {
104	set x {}
105	testdel {} foo {lappend x deleted; rename foo bar}
106	rename foo {}
107	lappend x | [info command bar]
108    } {deleted | {}}
109    test rename-4.5 {reentrancy issues with command deletion and renaming} {
110	set env(value) before
111	interp create foo
112	testdel foo cmd {set env(value) deleted}
113	interp delete foo
114	set env(value)
115    } {deleted}
116    test rename-4.6 {reentrancy issues with command deletion and renaming} {
117	proc kill args {
118	    interp delete foo
119	}
120	set env(value) before
121	interp create foo
122	foo alias kill kill
123	testdel foo cmd {set env(value) deleted; kill}
124	list [catch {foo eval {rename cmd {}}} msg] $msg $env(value)
125    } {0 {} deleted}
126    test rename-4.7 {reentrancy issues with command deletion and renaming} {
127	proc kill args {
128	    interp delete foo
129	}
130	set env(value) before
131	interp create foo
132	foo alias kill kill
133	testdel foo cmd {set env(value) deleted; kill}
134	list [catch {interp delete foo} msg] $msg $env(value)
135    } {0 {} deleted}
136    if {[info exists env(value)]} {
137	unset env(value)
138    }
139}
140
141# Save the unknown procedure which is modified by the following test.
142
143catch {rename unknown unknown.old}
144
145test rename-5.1 {repeated rename deletion and redefinition of same command} {
146    set SAVED_UNKNOWN "proc unknown "
147    append SAVED_UNKNOWN "\{[info args unknown.old]\} "
148    append SAVED_UNKNOWN "\{[info body unknown.old]\}"
149
150    for {set i 0} {$i < 10} {incr i} {
151        eval $SAVED_UNKNOWN
152        tcl_wordBreakBefore "" 0
153        rename tcl_wordBreakBefore {}
154        rename unknown {}
155    }
156} {}
157
158catch {rename unknown {}}
159catch {rename unknown.old unknown}
160
161
162test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } {
163    proc x {} {
164        set a 123
165        set b [incr a]
166    }
167    x
168    rename incr incr.old
169    proc incr {} {puts "new incr called!"}
170    catch {x} msg
171    set msg
172} {wrong # args: should be "incr"}
173
174if {[info commands incr.old] != {}} {
175    catch {rename incr {}}
176    catch {rename incr.old incr}
177}
178::tcltest::cleanupTests
179return
180