os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/rename.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/rename.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,179 @@
1.4 +# Commands covered: rename
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.11 +# Copyright (c) 1994 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: rename.test,v 1.10 2001/09/12 20:28:50 dgp Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +# Must eliminate the "unknown" command while the test is running,
1.25 +# especially if the test is being run in a program with its
1.26 +# own special-purpose unknown command.
1.27 +
1.28 +catch {rename unknown unknown.old}
1.29 +
1.30 +catch {rename r2 {}}
1.31 +proc r1 {} {return "procedure r1"}
1.32 +rename r1 r2
1.33 +test rename-1.1 {simple renaming} {
1.34 + r2
1.35 +} {procedure r1}
1.36 +test rename-1.2 {simple renaming} {
1.37 + list [catch r1 msg] $msg
1.38 +} {1 {invalid command name "r1"}}
1.39 +rename r2 {}
1.40 +test rename-1.3 {simple renaming} {
1.41 + list [catch r2 msg] $msg
1.42 +} {1 {invalid command name "r2"}}
1.43 +
1.44 +# The test below is tricky because it renames a built-in command.
1.45 +# It's possible that the test procedure uses this command, so must
1.46 +# restore the command before calling test again.
1.47 +
1.48 +rename list l.new
1.49 +set a [catch list msg1]
1.50 +set b [l.new a b c]
1.51 +rename l.new list
1.52 +set c [catch l.new msg2]
1.53 +set d [list 111 222]
1.54 +test rename-2.1 {renaming built-in command} {
1.55 + list $a $msg1 $b $c $msg2 $d
1.56 +} {1 {invalid command name "list"} {a b c} 1 {invalid command name "l.new"} {111 222}}
1.57 +
1.58 +test rename-3.1 {error conditions} {
1.59 + list [catch {rename r1} msg] $msg $errorCode
1.60 +} {1 {wrong # args: should be "rename oldName newName"} NONE}
1.61 +test rename-3.2 {error conditions} {
1.62 + list [catch {rename r1 r2 r3} msg] $msg $errorCode
1.63 +} {1 {wrong # args: should be "rename oldName newName"} NONE}
1.64 +test rename-3.3 {error conditions} {
1.65 + proc r1 {} {}
1.66 + proc r2 {} {}
1.67 + list [catch {rename r1 r2} msg] $msg
1.68 +} {1 {can't rename to "r2": command already exists}}
1.69 +test rename-3.4 {error conditions} {
1.70 + catch {rename r1 {}}
1.71 + catch {rename r2 {}}
1.72 + list [catch {rename r1 r2} msg] $msg
1.73 +} {1 {can't rename "r1": command doesn't exist}}
1.74 +test rename-3.5 {error conditions} {
1.75 + catch {rename _non_existent_command {}}
1.76 + list [catch {rename _non_existent_command {}} msg] $msg
1.77 +} {1 {can't delete "_non_existent_command": command doesn't exist}}
1.78 +
1.79 +catch {rename unknown {}}
1.80 +catch {rename unknown.old unknown}
1.81 +catch {rename bar {}}
1.82 +
1.83 +if {[info command testdel] == "testdel"} {
1.84 + test rename-4.1 {reentrancy issues with command deletion and renaming} {
1.85 + set x {}
1.86 + testdel {} foo {lappend x deleted; rename bar {}; lappend x [info command bar]}
1.87 + rename foo bar
1.88 + lappend x |
1.89 + rename bar {}
1.90 + set x
1.91 + } {| deleted {}}
1.92 + test rename-4.2 {reentrancy issues with command deletion and renaming} {
1.93 + set x {}
1.94 + testdel {} foo {lappend x deleted; rename foo bar}
1.95 + rename foo {}
1.96 + set x
1.97 + } {deleted}
1.98 + test rename-4.3 {reentrancy issues with command deletion and renaming} {
1.99 + set x {}
1.100 + testdel {} foo {lappend x deleted; testdel {} foo {lappend x deleted2}}
1.101 + rename foo {}
1.102 + lappend x |
1.103 + rename foo {}
1.104 + set x
1.105 + } {deleted | deleted2}
1.106 + test rename-4.4 {reentrancy issues with command deletion and renaming} {
1.107 + set x {}
1.108 + testdel {} foo {lappend x deleted; rename foo bar}
1.109 + rename foo {}
1.110 + lappend x | [info command bar]
1.111 + } {deleted | {}}
1.112 + test rename-4.5 {reentrancy issues with command deletion and renaming} {
1.113 + set env(value) before
1.114 + interp create foo
1.115 + testdel foo cmd {set env(value) deleted}
1.116 + interp delete foo
1.117 + set env(value)
1.118 + } {deleted}
1.119 + test rename-4.6 {reentrancy issues with command deletion and renaming} {
1.120 + proc kill args {
1.121 + interp delete foo
1.122 + }
1.123 + set env(value) before
1.124 + interp create foo
1.125 + foo alias kill kill
1.126 + testdel foo cmd {set env(value) deleted; kill}
1.127 + list [catch {foo eval {rename cmd {}}} msg] $msg $env(value)
1.128 + } {0 {} deleted}
1.129 + test rename-4.7 {reentrancy issues with command deletion and renaming} {
1.130 + proc kill args {
1.131 + interp delete foo
1.132 + }
1.133 + set env(value) before
1.134 + interp create foo
1.135 + foo alias kill kill
1.136 + testdel foo cmd {set env(value) deleted; kill}
1.137 + list [catch {interp delete foo} msg] $msg $env(value)
1.138 + } {0 {} deleted}
1.139 + if {[info exists env(value)]} {
1.140 + unset env(value)
1.141 + }
1.142 +}
1.143 +
1.144 +# Save the unknown procedure which is modified by the following test.
1.145 +
1.146 +catch {rename unknown unknown.old}
1.147 +
1.148 +test rename-5.1 {repeated rename deletion and redefinition of same command} {
1.149 + set SAVED_UNKNOWN "proc unknown "
1.150 + append SAVED_UNKNOWN "\{[info args unknown.old]\} "
1.151 + append SAVED_UNKNOWN "\{[info body unknown.old]\}"
1.152 +
1.153 + for {set i 0} {$i < 10} {incr i} {
1.154 + eval $SAVED_UNKNOWN
1.155 + tcl_wordBreakBefore "" 0
1.156 + rename tcl_wordBreakBefore {}
1.157 + rename unknown {}
1.158 + }
1.159 +} {}
1.160 +
1.161 +catch {rename unknown {}}
1.162 +catch {rename unknown.old unknown}
1.163 +
1.164 +
1.165 +test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } {
1.166 + proc x {} {
1.167 + set a 123
1.168 + set b [incr a]
1.169 + }
1.170 + x
1.171 + rename incr incr.old
1.172 + proc incr {} {puts "new incr called!"}
1.173 + catch {x} msg
1.174 + set msg
1.175 +} {wrong # args: should be "incr"}
1.176 +
1.177 +if {[info commands incr.old] != {}} {
1.178 + catch {rename incr {}}
1.179 + catch {rename incr.old incr}
1.180 +}
1.181 +::tcltest::cleanupTests
1.182 +return